(Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).
| primitive.t (PDL-2.081) | : | primitive.t (PDL-2.082) |
|---|
| | |
| skipping to change at line 16 | | skipping to change at line 16 |
|---|
| use PDL::Types; | | use PDL::Types; |
| | |
| sub tapprox { | | sub tapprox { |
| my($x,$y) = @_; | | my($x,$y) = @_; |
| $_ = pdl($_) for $x, $y; | | $_ = pdl($_) for $x, $y; |
| if(join(',',$x->dims) ne join(',',$y->dims)) { | | if(join(',',$x->dims) ne join(',',$y->dims)) { |
| diag "APPROX: $x $y\n"; | | diag "APPROX: $x $y\n"; |
| diag "UNEQDIM\n"; | | diag "UNEQDIM\n"; |
| return 0; | | return 0; |
| } | | } |
|
| | return 1 if $x->isempty and $y->isempty; |
| my $d = max( abs($x-$y) ); | | my $d = max( abs($x-$y) ); |
| if($d >= 0.01) { | | if($d >= 0.01) { |
| diag "got=$x expected=$y\n"; | | diag "got=$x expected=$y\n"; |
| } | | } |
| $d < 0.01; | | $d < 0.01; |
| } | | } |
| | |
| ok tapprox(pdl(1,2,3)->cmpvec(pdl(3,2,1)), -1), 'cmpvec less'; | | ok tapprox(pdl(1,2,3)->cmpvec(pdl(3,2,1)), -1), 'cmpvec less'; |
| ok tapprox(pdl(3,2,1)->cmpvec(pdl(1,2,3)), 1), 'cmpvec more'; | | ok tapprox(pdl(3,2,1)->cmpvec(pdl(1,2,3)), 1), 'cmpvec more'; |
| ok tapprox(pdl(3,2,1)->cmpvec(pdl(3,2,1)), 0), 'cmpvec same'; | | ok tapprox(pdl(3,2,1)->cmpvec(pdl(3,2,1)), 0), 'cmpvec same'; |
| | |
| skipping to change at line 214 | | skipping to change at line 215 |
|---|
| ############################## | | ############################## |
| # Test bad handling in selector | | # Test bad handling in selector |
| $y = xvals(3); | | $y = xvals(3); |
| ok(tapprox($y->which,PDL->pdl(1,2)), "which"); | | ok(tapprox($y->which,PDL->pdl(1,2)), "which"); |
| setbadat $y, 1; | | setbadat $y, 1; |
| ok(tapprox($y->which,PDL->pdl([2])), "which w BAD"); | | ok(tapprox($y->which,PDL->pdl([2])), "which w BAD"); |
| setbadat $y, 0; | | setbadat $y, 0; |
| setbadat $y, 2; | | setbadat $y, 2; |
| is($y->which->nelem,0, "which nelem w BAD"); | | is($y->which->nelem,0, "which nelem w BAD"); |
| | |
|
| | { |
| | ok tapprox(sequence(4)->uniq, sequence(4)), 'sequence(4)->uniq'; |
| | ok tapprox(ones(4)->uniq, ones(1)), 'ones(4)->uniq'; |
| | ok tapprox(empty()->uniq, empty()), 'empty()->uniq'; |
| | ok tapprox(pdl([[1]])->uniq, ones(1)), '2-deep uniq flattens'; # Data::Frame rel |
| | ies |
| | } |
| | |
| ############################ | | ############################ |
| # Test intersect & setops | | # Test intersect & setops |
| my $temp = sequence(10); | | my $temp = sequence(10); |
| $x = which(($temp % 2) == 0); | | $x = which(($temp % 2) == 0); |
| $y = which(($temp % 3) == 0); | | $y = which(($temp % 3) == 0); |
| $c = setops($x, 'AND', $y); | | $c = setops($x, 'AND', $y); |
| ok(tapprox($c, pdl([0, 6])), "setops AND"); | | ok(tapprox($c, pdl([0, 6])), "setops AND"); |
| ok(tapprox(intersect($x,$y),pdl([0,6])), "intersect same as setops AND"); | | ok(tapprox(intersect($x,$y),pdl([0,6])), "intersect same as setops AND"); |
| $c = setops($x,'OR',$y); | | $c = setops($x,'OR',$y); |
| ok(tapprox($c, pdl([0,2,3,4,6,8,9])), "setops OR"); | | ok(tapprox($c, pdl([0,2,3,4,6,8,9])), "setops OR"); |
| $c = setops($x,'XOR',$y); | | $c = setops($x,'XOR',$y); |
| ok(tapprox($c, pdl([2,3,4,8,9])), "setops XOR"); | | ok(tapprox($c, pdl([2,3,4,8,9])), "setops XOR"); |
| #Test intersect again | | #Test intersect again |
| my $intersect_test=intersect(pdl(1,-5,4,0), pdl(0,3,-5,2)); | | my $intersect_test=intersect(pdl(1,-5,4,0), pdl(0,3,-5,2)); |
| ok (all($intersect_test==pdl(-5,0)), 'Intersect test values'); | | ok (all($intersect_test==pdl(-5,0)), 'Intersect test values'); |
|
| | { |
| | # based on cases supplied by @jo-37 |
| | my @cases = ( |
| | [ pdl(1), empty(), empty() ], |
| | [ ones(1), empty(), empty() ], |
| | [ ones(4), empty(), empty() ], |
| | [ sequence(4), empty(), empty() ], |
| | [ pdl(1), ones(2), ones(1) ], |
| | [ ones(1), ones(2), ones(1) ], |
| | [ ones(4), ones(2), ones(1) ], |
| | [ sequence(4), ones(2), ones(1) ], |
| | ); |
| | ok tapprox(setops($_->[0], 'AND', $_->[1]), $_->[2]), "$_->[0] AND $_->[1]" for |
| | @cases; |
| | } |
| | |
| ############################## | | ############################## |
| # Test uniqind | | # Test uniqind |
| $x = pdl([0,1,2,2,0,1]); | | $x = pdl([0,1,2,2,0,1]); |
| $y = $x->uniqind; | | $y = $x->uniqind; |
| eval { $c = all($y==pdl([0,1,3])) }; | | eval { $c = all($y==pdl([0,1,3])) }; |
| is $@, ''; | | is $@, ''; |
| ok $c, "uniqind" or diag "got: $y"; | | ok $c, "uniqind" or diag "got: $y"; |
| is $y->ndims, 1, "uniqind"; | | is $y->ndims, 1, "uniqind"; |
| | |
| | | |
| End of changes. 3 change blocks. |
|---|
| 0 lines changed or deleted | | 24 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 