1#!perl 2 3use strict; 4use warnings; 5 6use Test::More; 7 8use lib 't/lib'; 9use Math::Matrix::Real; 10 11plan tests => 21; 12 13note("one non-empty operand"); 14 15{ 16 my $x = Math::Matrix::Real -> new([[1, 2, 3], 17 [4, 5, 6]]); 18 my $sub = sub { $_[0] * 3 }; 19 my $y = $x -> sapply($sub); 20 21 is(ref($y), 'Math::Matrix::Real', '$y is a Math::Matrix::Real'); 22 is_deeply([ @$y ], [[ 3, 6, 9], 23 [12, 15, 18]], '$y has the right values'); 24 25 # Verify that modifying $y does not modify $x. 26 27 my ($nrowx, $ncolx) = $x -> size(); 28 for my $i (0 .. $nrowx - 1) { 29 for my $j (0 .. $ncolx - 1) { 30 $y -> [$i][$j] += 100; 31 } 32 } 33 34 is_deeply([ @$x ], [[1, 2, 3], 35 [4, 5, 6]], '$x is unmodified'); 36} 37 38note("two non-empty operands with the same size"); 39 40{ 41 my $x = Math::Matrix::Real -> new([[1, 2, 3]]); 42 my $y = Math::Matrix::Real -> new([[4, 5, 6]]); 43 my $sub = sub { $_[0] * $_[1] }; 44 my $z = $x -> sapply($sub, $y); 45 46 is(ref($z), 'Math::Matrix::Real', '$z is a Math::Matrix::Real'); 47 is_deeply([ @$z ], [[4, 10, 18]], '$z has the right values'); 48 49 # Verify that modifying $z does not modify $x or $y. 50 51 my ($nrowz, $ncolz) = $z -> size(); 52 for my $i (0 .. $nrowz - 1) { 53 for my $j (0 .. $ncolz - 1) { 54 $z -> [$i][$j] += 100; 55 } 56 } 57 58 is_deeply([ @$x ], [[1, 2, 3]], '$x is unmodified'); 59 is_deeply([ @$y ], [[4, 5, 6]], '$y is unmodified'); 60} 61 62note("three non-empty operands with the same size"); 63 64{ 65 my $x = Math::Matrix::Real -> new([[1, 2, 3]]); 66 my $y = Math::Matrix::Real -> new([[4, 5, 6]]); 67 my $z = Math::Matrix::Real -> new([[7, 8, 9]]); 68 my $sub = sub { $_[0] * $_[1] + $_[2] }; 69 my $w = $x -> sapply($sub, $y, $z); 70 71 is(ref($w), 'Math::Matrix::Real', '$w is a Math::Matrix::Real'); 72 is_deeply([ @$w ], [[11, 18, 27]], '$w has the right values'); 73 74 # Verify that modifying $w does not modify $x, $y, or $z. 75 76 my ($nroww, $ncolw) = $w -> size(); 77 for my $i (0 .. $nroww - 1) { 78 for my $j (0 .. $ncolw - 1) { 79 $w -> [$i][$j] += 100; 80 } 81 } 82 83 is_deeply([ @$x ], [[1, 2, 3]], '$x is unmodified'); 84 is_deeply([ @$y ], [[4, 5, 6]], '$y is unmodified'); 85 is_deeply([ @$z ], [[7, 8, 9]], '$z is unmodified'); 86} 87 88note("two non-empty operands with different size"); 89 90{ 91 my $x = Math::Matrix::Real -> new([[1, 2, 3]]); 92 my $y = Math::Matrix::Real -> new([[4], [5], [6]]); 93 my $sub = sub { $_[0] * $_[1] }; 94 my $z = $x -> sapply($sub, $y); 95 96 is(ref($z), 'Math::Matrix::Real', '$z is a Math::Matrix::Real'); 97 is_deeply([ @$z ], [[4, 8, 12], 98 [5, 10, 15], 99 [6, 12, 18]], '$z has the right values'); 100 101 # Verify that modifying $z does not modify $x or $y. 102 103 my ($nrowz, $ncolz) = $z -> size(); 104 for my $i (0 .. $nrowz - 1) { 105 for my $j (0 .. $ncolz - 1) { 106 $z -> [$i][$j] += 100; 107 } 108 } 109 110 is_deeply([ @$x ], [[1, 2, 3]], '$x is unmodified'); 111 is_deeply([ @$y ], [[4], [5], [6]], '$y is unmodified'); 112} 113 114note("one empty operand"); 115 116{ 117 my $x = Math::Matrix::Real -> new([]); 118 my $sub = sub { $_[0] * 3 }; 119 my $y = $x -> sapply($sub); 120 121 is(ref($y), 'Math::Matrix::Real', '$y is a Math::Matrix::Real'); 122 is_deeply([ @$x ], [], '$x is unmodified'); 123} 124 125note("two empty operands"); 126 127{ 128 my $x = Math::Matrix::Real -> new([]); 129 my $y = Math::Matrix::Real -> new([]); 130 my $sub = sub { $_[0] * $_[1] }; 131 my $z = $x -> sapply($sub); 132 133 is(ref($z), 'Math::Matrix::Real', '$z is a Math::Matrix::Real'); 134 is_deeply([ @$y ], [], '$y has the right values'); 135 is_deeply([ @$x ], [], '$x is unmodified'); 136} 137