Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 197 lines (165 sloc) 5.823 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
use File::Spec;
use lib File::Spec->catfile("..","lib");
use Math::MatrixReal;
do 'funcs.pl';

print "1..21\n";
print "ok 1\n";
my $verbose = grep @ARGV, '--verbose';

# below we are basically checking the
# various ways that the new_from_* methods
# are supposed to work--with strings, array refs,
# or Math::MatrixReal vectors. They are also
# supposed to work for mixtures of those things,
# so we are checking that too.

my $matrix2 = Math::MatrixReal->new_from_cols([[11,21], [12,22]]);
print &check_matrix($matrix2) ? "ok 2\n" : "not ok 2\n";

my $col1 = $matrix2->column(1);
my $col2 = $matrix2->column(2);

my $matrix3 = $matrix2->new_from_columns( [$col1, $col2]);

print &check_matrix($matrix3) ? "ok 3\n" : "not ok 3\n";

my $string1 = "[ 11 ]\n[ 21 ]\n[ 31 ]\n";
my $string2 = "[ 12 ]\n[ 22 ]\n[ 32 ]\n";
my $string3 = "[ 13 ]\n[ 23 ]\n[ 33 ]\n";

my $matrix4 = Math::MatrixReal->new_from_cols( [$string1, $string2, $string3] );
print &check_matrix($matrix4) ? "ok 4\n" : "not ok 4\n";

my $col52 = $matrix4->column(2);
my $matrix5 = Math::MatrixReal->new_from_cols( [$string1, $col52, [13,23,33]]);
print &check_matrix($matrix5) ? "ok 5\n" : "not ok 5\n";

my $matrix6 = Math::MatrixReal->new_from_rows( [[11,12,13], [21,22,23], [31,32,33]]);
print &check_matrix($matrix6) ? "ok 6\n" : "not ok 6\n";

my $matrix7 = Math::MatrixReal->new_from_rows( ["[ 11 12 13 ]\n", "[ 21 22 23 ]\n", "[ 31 32 33 ]\n"]);
print &check_matrix($matrix7) ? "ok 7\n" : "not ok 7\n";

my ($row81, $row82, $row83) = ($matrix4->row(1), $matrix4->row(2), $matrix4->row(3));
my $matrix8 = Math::MatrixReal->new_from_rows( [$row81, $row82, $row83] );
print &check_matrix($matrix8) ? "ok 8\n" : "not ok 8\n";

my $matrix9 = Math::MatrixReal->new_from_rows( ["[ 11 12 13 ]\n", $row82, $matrix8->row(3)] );
print &check_matrix($matrix9) ? "ok 9\n" : "not ok 9\n";

# testing for pre-0.05 problem where if ref( $vec )
# didn't start with Math::MatrixReal
# new_from_* wouldn't recognize it
package Foo;

use base qw/Math::MatrixReal/;

package main;

my $foo_string = "[ 11 12 13 ]\n";
my $foo_matrix = Foo->new_from_string($foo_string);

my $matrix10 = Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, $matrix8->row(3)] );

print &check_matrix($matrix10) ? "ok 10\n" : "not ok 10\n";

# make sure it dies with our error message if you pass in a
# hash ref
eval{ Math::MatrixReal->new_from_cols( [{ foo=> 'bar'}] ) };
if ($@ =~ /things that inherit from Math::MatrixReal/) {
    warn $@ if $verbose;
    print "ok 11\n";
}
else {
    print "not ok 11\n";
}

# make sure it dies correctly on passing of a solo hash ref
eval{ Math::MatrixReal->new_from_cols( { foo=> 'bar'} ) };
warn $@ if $@ && $verbose;
if ($@ =~ /array of columns/) {
    print "ok 12\n";
}
else {
    print "not ok 12\n";
}

# same as above but for *rows version
eval{ Math::MatrixReal->new_from_rows( { foo=> 'bar'} ) };
warn $@ if $@ && $verbose;
if ($@ =~ /array of rows/) {
    print "ok 13\n";
}
else {
    print "not ok 13\n";
}

# handing *rows a column should die
eval { Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, $matrix8->column(3)] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /new_from_rows.* don't accept column vectors/) {
    print "ok 14\n";
}
else {
    print "not ok 14\n";
}

# opposite of previous test, making sure error messages
# print appropriately
eval { Math::MatrixReal->new_from_cols( [$foo_matrix, $row82, ] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /new_from_col(umn)?s.* don't accept row vectors/) {
    print "ok 15\n";
}
else {
    print "not ok 15\n";
}

# mixed dimensions are supposed to die
eval { Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, [ 1 ]] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /all of the rows passed in must have the same dimension/ ) {
    print "ok 16\n";
}
else {
    print "not ok 16\n";
}

# same as above but error message should say 'colunmns'
eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], [ 1, 2], ] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /all of the columns passed in must have the same dimension/ ) {
    print "ok 17\n";
}
else {
    print "not ok 17\n";
}

# empty array ref passed in generates a weird message from MatrixReal,
# I'm putting something less mysterious there
eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], [], ] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /no elements/ ) {
    print "ok 18\n";
}
else {
    print "not ok 18\n";
}

# making sure we get the MatrixReal error passed through
eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], '', ] ) };
warn $@ if $@ && $verbose;
if ($@ =~ /empty input string/ ) {
    print "ok 19\n";
}
else {
    print "not ok 19\n";
}

$matrix1 = Math::MatrixReal->new_from_string(<<"MATRIX");
[ 1 2 3 ]
[ 4 5 6 ]
[ 7 8 9 ]
MATRIX
$matrix2 = Math::MatrixReal->new_from_rows( [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8 ,9 ] ] );
 similar($matrix1,$matrix2) ? print "ok 20\n" : print "not ok 20\n";
##################################
$matrix3 = Math::MatrixReal->new_from_cols( [ [ 1, 4, 7], [ 2, 5, 8], [3, 6, 9] ] );
similar($matrix1,$matrix3) ? print "ok 21\n" : print "not ok 21\n";


# ok, the matrix we're making in every case is like
# this (or possibly a different-sized/shaped version):
#
# 11 12 13
# 21 22 23
# 31 32 33
#
# so, all we have to do to check them is
# to make sure that 10 times the row plus
# the column of each given element is equal
# to the value of the element (they're
# floats, though, so check using tolerance)
#

sub check_matrix {
    my $matrix = shift;
    my ($rows, $cols) = $matrix->dim;
    my $success = 1;
    foreach my $row (1..$rows) {
        foreach my $col (1..$cols) {
            my $element = $matrix->element($row,$col) ;
            $success = 0 unless ( abs ( $element - (10*$row + $col) ) < .00001 ) ;
        }
    }
    return $success;
}
Something went wrong with that request. Please try again.