"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/primitive.t" between
PDL-2.075.tar.gz and PDL-2.076.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

primitive.t  (PDL-2.075)	:	primitive.t  (PDL-2.076)
use strict;		use strict;
use warnings;		use warnings;
use Test::More;		use Test::More;
		use Test::Exception;
use PDL::LiteF;		use PDL::LiteF;
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;
skipping to change at line 287		skipping to change at line 288
my $ones = ones(5,5);		my $ones = ones(5,5);
@statsRes = $im->stats($ones);		@statsRes = $im->stats($ones);
ok(tapprox($statsRes[0],5.36), "stats: trivial weights mean" );		ok(tapprox($statsRes[0],5.36), "stats: trivial weights mean" );
ok(tapprox($statsRes[1],4.554), "stats: trivial weights prms" );		ok(tapprox($statsRes[1],4.554), "stats: trivial weights prms" );
ok(tapprox($statsRes[2],3), "stats: trivial weights median" );		ok(tapprox($statsRes[2],3), "stats: trivial weights median" );
ok(tapprox($statsRes[3],1), "stats: trivial weights min" );		ok(tapprox($statsRes[3],1), "stats: trivial weights min" );
ok(tapprox($statsRes[4],13), "stats: trivial weights max" );		ok(tapprox($statsRes[4],13), "stats: trivial weights max" );
ok(tapprox($statsRes[6],4.462), "stats: trivial weights rms");		ok(tapprox($statsRes[6],4.462), "stats: trivial weights rms");
# complex matmult		# complex matmult
my $cm1 = cdouble(1, czip(1, 1), 1);		my $cm1 = pdl('1 1+i 1');
my $cm2 = cdouble(2, 3, i());		my $cm2 = pdl('2 3 i')->transpose;
my $got = $cm1 x $cm2->dummy(0);		my $got = $cm1 x $cm2;
ok all(approx $got, czip(5, 4)), 'complex matmult' or diag $got;		ok all(approx $got, pdl('5+4i')), 'complex matmult' or diag $got;
		throws_ok { scalar $cm1->transpose x $cm2 } qr/mismatch/, 'good error on mismatc
		h matmult';
		{
		my $pa = pdl [[ 1, 2, 3, 0],
		[ 1, -1, 2, 7],
		[ 1, 0, 0, 1]];
		my $pb = pdl [[1, 1],
		[0, 2],
		[0, 2],
		[1, 1]];
		my $pc = pdl [[ 1, 11],
		[ 8, 10],
		[ 2, 2]];
		my $res = $pa x $pb;
		ok(all approx($pc,$res)) or diag "got: $res";
		$res = null;
		matmult($pa, $pb, $res);
		ok(all(approx $pc,$res), 'res=null') or diag "got: $res";
		my $pa_sliced = $pa->dummy(0, 3)->dummy(-1, 3)->make_physical->slice('(1),,,(1)'
		);
		$res = $pa_sliced x $pb;
		ok(all approx($pc,$res)) or diag "got: $res";
		$res = zeroes(2, 3);
		matmult($pa, $pb, $res);
		ok(all(approx $pc,$res), 'res=zeroes') or diag "got: $res";
		$res = ones(2, 3);
		matmult($pa, $pb, $res);
		ok(all(approx $pc,$res), 'res=ones') or diag "got: $res";
		my $eq = float [[1,1,1,1]]; # a 4,1-matrix ( 1 1 1 1 )
		# Check collapse: output should be a 1x2...
		ok(all approx($eq x $pb , pdl([[2,6]]) )); # ([4x1] x [2x4] -> [1x2])
		# Check dimensional exception: mismatched dims should throw an error
		dies_ok {
		my $pz = $pb x $eq; # [2x4] x [4x1] --> error (2 != 1)
		};
		{
		# Check automatic scalar multiplication
		my $pz;
		lives_ok { $pz = $pb x 2; };
		ok( all approx($pz,$pb * 2));
		}
		{
		my $pz;
		lives_ok { $pz = pdl(3) x $pb; };
		ok( all approx($pz,$pb * 3));
		}
		}
# which ND test		# which ND test
my $a1 = PDL->sequence(10,10,3,4);		my $a1 = PDL->sequence(10,10,3,4);
($x, $y, $z, my $w) = whichND($a1 == 203)->mv(0,-1)->dog;		($x, $y, $z, my $w) = whichND($a1 == 203)->mv(0,-1)->dog;
ok($a1->at($x->list,$y->list,$z->list,$w->list) == 203, "whichND" );		ok($a1->at($x->list,$y->list,$z->list,$w->list) == 203, "whichND" );
$a1 = pdl(1,2,3,4);		$a1 = pdl(1,2,3,4);
my $b1 = append($a1,2);		my $b1 = append($a1,2);
ok(int(sum($b1))==12, "append");		ok(int(sum($b1))==12, "append");
End of changes. 2 change blocks.
4 lines changed or deleted		53 lines changed or added

---