"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/bad.t" between
PDL-2.078.tar.gz and PDL-2.079.tar.gz

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

bad.t  (PDL-2.078):bad.t  (PDL-2.079)
skipping to change at line 14 skipping to change at line 14
use PDL::LiteF; use PDL::LiteF;
use PDL::Math; use PDL::Math;
use PDL::Types qw(types); use PDL::Types qw(types);
use Test::Warn; use Test::Warn;
# although approx() caches the tolerance value, we # although approx() caches the tolerance value, we
# use it in every call just to document things # use it in every call just to document things
# #
use constant ABSTOL => 1.0e-4; use constant ABSTOL => 1.0e-4;
{
my $a_bad = pdl double, '[1 BAD 3]';
my $b_double = zeroes double, 3;
$a_bad->assgn($b_double);
ok $b_double->badflag, 'b_double badflag set';
is $b_double.'', '[1 BAD 3]', 'b_double got badval';
my $b_float = zeroes float, 3;
$a_bad->assgn($b_float);
ok $b_float->badflag, 'b_float badflag set';
is $b_float.'', '[1 BAD 3]', 'b_float got badval';
}
# check default behaviour (ie no bad data) # check default behaviour (ie no bad data)
# - probably overkill # - probably overkill
# #
my $x = pdl(1,2,3); my $x = pdl(1,2,3);
is( $x->badflag(), 0, "no badflag" ); is( $x->badflag(), 0, "no badflag" );
my $y = pdl(4,5,6); my $y = pdl(4,5,6);
my $c = $x + $y; my $c = $x + $y;
is( $c->badflag(), 0, "badflag not set in a copy" ); is( $c->badflag(), 0, "badflag not set in a copy" );
is( $c->sum(), 21, "sum() works on non bad-flag ndarrays" ); is( $c->sum(), 21, "sum() works on non bad-flag ndarrays" );
skipping to change at line 200 skipping to change at line 212
"[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]", "[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]",
"isbad() worked" ); "isbad() worked" );
$x = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) ); $x = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
$y = $x->setbadif( $x < 20 ); $y = $x->setbadif( $x < 20 );
$x->inplace->copybad( $y ); $x->inplace->copybad( $y );
is( PDL::Core::string( $x->isbad ), is( PDL::Core::string( $x->isbad ),
"[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]", "[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]",
" and inplace" ); " and inplace" );
$x = zeroes(20,30);
$y = $x->slice('0:10,0:10');
$c = $y->slice(',(2)');
ok !$c->badflag, 'no badflag on slice-child of good';
$x->badflag(1);
ok $c->badflag, 'badflag on same slice-child of good set to bad';
$c->badflag(0);
ok !$x->badflag, 'badflag now off for slice-parent of bad slice-child set to goo
d';
$x = pdl '1 BAD';
ok any($x > 0), 'any with some badvals just omits them';
ok all($x > 0), 'all with some badvals just omits them';
## $x->inplace->setbadif( $x % 2 ) does NOT work because ## $x->inplace->setbadif( $x % 2 ) does NOT work because
## ($x % 2) is performed inplace - ie the flag is set for ## ($x % 2) is performed inplace - ie the flag is set for
## that function ## that function
# #
##$x = sequence(3,3); ##$x = sequence(3,3);
##$x->inplace->setbadif( $x % 2 ); ##$x->inplace->setbadif( $x % 2 );
###$x = $x->setbadif( $x % 2 ); # for when not bothered about inpla ce ###$x = $x->setbadif( $x % 2 ); # for when not bothered about inpla ce
##ok( PDL::Core::string( $x->clump(-1) ), ##ok( PDL::Core::string( $x->clump(-1) ),
## "[0 BAD 2 BAD 4 BAD 6 BAD 8]" ); # ## "[0 BAD 2 BAD 4 BAD 6 BAD 8]" ); #
## look at propagation of bad flag using inplace routines... ## look at propagation of bad flag using inplace routines...
$x = sequence( byte, 2, 3 ); $x = sequence( byte, 2, 3 );
$x = $x->setbadif( $x == 3 ); $x = $x->setbadif( $x == 3 );
$y = $x->slice("(1),:"); $y = $x->slice("(1),:");
$x->inplace->setbadtoval(3); $x->inplace->setbadtoval(3);
is( $y->badflag, 0, "badflag cleared using inplace setbadtoval()" ); is( $x->badflag, 0, "direct pdl badflag cleared using inplace setbadtoval()" );
is( $y->badflag, 0, "child pdl badflag cleared using inplace setbadtoval()" );
$x = sequence( byte, 2, 3 ); $x = sequence( byte, 2, 3 );
$y = $x->slice("(1),:"); $y = $x->slice("(1),:");
my $mask = sequence( byte, 2, 3 ); my $mask = sequence( byte, 2, 3 );
$mask = $mask->setbadif( ($mask % 3) == 2 ); $mask = $mask->setbadif( ($mask % 3) == 2 );
$x->inplace->copybad( $mask ); $x->inplace->copybad( $mask );
is( $y->badflag, 1, "badflag propagated using inplace copybad()" ); is( $y->badflag, 1, "badflag propagated using inplace copybad()" );
# test some of the qsort functions # test some of the qsort functions
$x = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) ); $x = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
skipping to change at line 346 skipping to change at line 372
$x->inplace->badmask(0); $x->inplace->badmask(0);
is( PDL::Core::string($x), "[0 1 0 3 4]", "inplace badmask()" ); is( PDL::Core::string($x), "[0 1 0 3 4]", "inplace badmask()" );
# setvaltobad # setvaltobad
$x = sequence(10) % 4; $x = sequence(10) % 4;
$x->inplace->setvaltobad( 1 ); $x->inplace->setvaltobad( 1 );
like( PDL::Core::string( $x->clump(-1) ), like( PDL::Core::string( $x->clump(-1) ),
qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setvaltobad()" ); qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setvaltobad()" );
$x->inplace->setbadtonan; $x->inplace->setbadtonan;
like( PDL::Core::string( $x->clump(-1) ), like PDL::Core::string( $x->clump(-1) ),
qr/^\[-?0 nan 2 3 -?0 nan 2 3 -?0 nan]$/i, "inplace setbadtonan()" ); qr/^\[-?0 \S*nan 2 3 -?0 \S*nan 2 3 -?0 \S*nan]$/i, "inplace setbadtonan()";
# check setvaltobad for non-double ndarrays # check setvaltobad for non-double ndarrays
my $fa = pdl( float, 1..4) / 3; my $fa = pdl( float, 1..4) / 3;
my $da = pdl( double, 1..4) / 3; my $da = pdl( double, 1..4) / 3;
ok( all($fa->setvaltobad(2/3)->isbad == $da->setvaltobad(2/3)->isbad), "setvalto bad for float ndarray"); ok( all($fa->setvaltobad(2/3)->isbad == $da->setvaltobad(2/3)->isbad), "setvalto bad for float ndarray");
my $inf2b = sequence(3); my $inf2b = sequence(3);
$inf2b->set(1, 'Inf'); $inf2b->set(1, 'Inf');
$inf2b->set(2, 'NaN'); $inf2b->set(2, 'NaN');
$inf2b->inplace->setinftobad; $inf2b->inplace->setinftobad;
like( PDL::Core::string( $inf2b->clump(-1) ), like( PDL::Core::string( $inf2b->clump(-1) ),
qr{^\[-?0 BAD nan]$}i, "inplace setinftobad()" ); qr{^\[-?0 BAD \S*nan]$}i, "inplace setinftobad()" );
my $x_copy = $x->copy; my $x_copy = $x->copy;
$x_copy->set(1, 'Inf'); $x_copy->set(1, 'Inf');
$x_copy->inplace->setnonfinitetobad; $x_copy->inplace->setnonfinitetobad;
like( PDL::Core::string( $x_copy->clump(-1) ), like( PDL::Core::string( $x_copy->clump(-1) ),
qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setnonfinitetobad()" ); qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setnonfinitetobad()" );
# simple test for setnantobad # simple test for setnantobad
# - could have a 1D FITS image containing # - could have a 1D FITS image containing
# NaN's and then a simple version of rfits # NaN's and then a simple version of rfits
skipping to change at line 544 skipping to change at line 570
subtest "stats() badvalue behavior" => sub { subtest "stats() badvalue behavior" => sub {
my $stats_data = [ my $stats_data = [
{ {
name => "stats() should not set the badflag for output wi th only one badvalue", name => "stats() should not set the badflag for output wi th only one badvalue",
func => \&stats, func => \&stats,
input => do { pdl [1, 2, 3] }, input => do { pdl [1, 2, 3] },
badvalue => 2, badvalue => 2,
string => "[1 BAD 3]", string => "[1 BAD 3]",
mean => "2", mean => "2",
badflag => 0 badflag => 1,
}, },
{ {
name => "stats() should set the badflag for output with a ll badvalues and mean should be BAD" , name => "stats() should set the badflag for output with a ll badvalues and mean should be BAD" ,
func => \&stats, func => \&stats,
input => do { pdl [1, 1, 1] }, input => do { pdl [1, 1, 1] },
badvalue => 1, badvalue => 1,
string => "[BAD BAD BAD]", string => "[BAD BAD BAD]",
mean => "BAD", mean => "BAD",
badflag => 1, badflag => 1,
}, },
skipping to change at line 589 skipping to change at line 615
[ [
[BAD 2 2] [BAD 2 2]
[ 2 BAD 2] [ 2 BAD 2]
[ 2 2 BAD] [ 2 2 BAD]
] ]
EOF EOF
}, },
badvalue => 1, badvalue => 1,
mean => "[2 2 2]", mean => "[2 2 2]",
badflag => 0, badflag => 1,
} }
]; ];
for my $case (@$stats_data) { for my $case (@$stats_data) {
subtest $case->{name} => sub { subtest $case->{name} => sub {
my $p = $case->{input}; my $p = $case->{input};
$p->badflag(1); $p->badflag(1);
$p->badvalue($case->{badvalue}); $p->badvalue($case->{badvalue});
note "\$p = $p"; note "\$p = $p";
is( "$p", $case->{string}, "stringifies properly"); is( "$p", $case->{string}, "stringifies properly");
my $m = $case->{func}->($p); my $m = $case->{func}->($p);
note "\$m = $m"; note "\$m = $m";
is( "$m", $case->{mean}, "Mean of \$p" ); is( "$m", $case->{mean}, "Mean of \$p" );
is( $m->badflag, $case->{badflag}, "Mean does @{[ (' not ')x!!( ! $case->{badflag} ) ]} have badflag set"); is( $m->badflag, $case->{badflag}, "Mean does @{[ ('not ' )x!!( ! $case->{badflag} ) ]}have badflag set");
}; };
} }
}; };
subtest "Comparison between a vector and scalar" => sub { subtest "Comparison between a vector and scalar" => sub {
my $p = pdl [1, 2, 3, 4]; my $p = pdl [1, 2, 3, 4];
$p->badflag(1); $p->badflag(1);
$p->badvalue(2); $p->badvalue(2);
 End of changes. 8 change blocks. 
7 lines changed or deleted 34 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)