"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/primitive.t" between
PDL-2.079.tar.gz and PDL-2.080.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.079):primitive.t  (PDL-2.080)
skipping to change at line 911 skipping to change at line 911
my $ret = vsearch( $vals, $xs, my $indx1 = PDL->null() ); my $ret = vsearch( $vals, $xs, my $indx1 = PDL->null() );
is( $ret, undef, "no return from explicit output ndarray" ); is( $ret, undef, "no return from explicit output ndarray" );
ok ( all ( $indx0 == $indx1 ), ok ( all ( $indx0 == $indx1 ),
'explicit ndarray == implicit ndarray' ); 'explicit ndarray == implicit ndarray' );
} }
} }
my $vdim = 4;
my $v1 = zeroes($vdim);
my $v2 = pdl($v1);
$v2->set(-1,1);
ok $v1->cmpvec($v2)<0, "cmpvec:1d:<";
ok $v2->cmpvec($v1)>0, "cmpvec:1d:>";
is $v1->cmpvec($v1)->sclr, 0, "cmpvec:1d:==";
##-- 4..5: qsortvec, qsortveci
my $p2d = pdl([[1,2],[3,4],[1,3],[1,2],[3,3]]);
ok all(approx($p2d->qsortvec, pdl(long,[[1,2],[1,2],[1,3],[3,3],[3,4]]))), "qsor
tvec";
ok all(approx($p2d->dice_axis(1,$p2d->qsortveci), $p2d->qsortvec)), "qsortveci";
my $which = pdl(long,[[0,0],[0,0],[0,1],[0,1],[1,0],[1,0],[1,1],[1,1]]);
my $find = $which->slice(",0:-1:2");
ok all(approx($find->vsearchvec($which), pdl(long,[0,2,4,6]))), "vsearchvec():ma
tch";
ok all(pdl([-1,-1])->vsearchvec($which)==0), "vsearchvec():<<";
ok all(pdl([2,2])->vsearchvec($which)==$which->dim(1)-1), "vsearchvec():>>";
my $vtype = long;
my $universe = pdl($vtype,[ [0,0],[0,1],[1,0],[1,1] ]);
$v1 = $universe->dice_axis(1,pdl([0,1,2]));
$v2 = $universe->dice_axis(1,pdl([1,2,3]));
($c,my $nc) = $v1->unionvec($v2);
ok all(approx($c, pdl($vtype, [ [0,0],[0,1],[1,0],[1,1],[0,0],[0,0] ]))), "union
vec:list:c";
is $nc, $universe->dim(1), "unionvec:list:nc";
my $cc = $v1->unionvec($v2);
ok all(approx($cc, $universe)), "unionvec:scalar";
($c,$nc) = $v1->intersectvec($v2);
ok all(approx($c, pdl($vtype, [ [0,1],[1,0],[0,0] ]))), "intersectvec:list:c";
is $nc->sclr, 2, "intersectvec:list:nc";
$cc = $v1->intersectvec($v2);
ok all(approx($cc, $universe->slice(",1:2"))), "intersectvec:scalar";
($c,$nc) = $v1->setdiffvec($v2);
ok all(approx($c, pdl($vtype, [ [0,0], [0,0],[0,0] ]))), "setdiffvec:list:c";
is $nc, 1, "setdiffvec:list:nc";
$cc = $v1->setdiffvec($v2);
ok all(approx($cc, pdl($vtype, [[0,0]]))), "setdiffvec:scalar";
my $all = sequence(20);
my $amask = ($all % 2)==0;
my $bmask = ($all % 3)==0;
my $a = $all->where($amask);
my $b = $all->where($bmask);
ok all(approx(scalar($a->union_sorted($b)), $all->where($amask | $bmask))), "uni
on_sorted";
ok all(approx(scalar($a->intersect_sorted($b)), $all->where($amask & $bmask))),
"intersect_sorted";
ok all(approx(scalar($a->setdiff_sorted($b)), $all->where($amask & $bmask->not))
), "setdiff_sorted";
##--------------------------------------------------------------
## dim-checks and implicit broadcast dimensions
## + see https://github.com/moocow-the-bovine/PDL-VectorValued/issues/4
sub test_broadcast_dimensions {
##-- unionvec
my $empty = zeroes(3,0);
my $uw = pdl([[-3,-2,-1],[1,2,3]]);
my $wx = pdl([[1,2,3],[4,5,6]]);
my $xy = pdl([[4,5,6],[7,8,9]]);
# unionvec: basic
ok all(approx(scalar($uw->unionvec($wx)), pdl([[-3,-2,-1],[1,2,3],[4,5,6]]))),
"unionvec - broadcast dims - uw+wx";
ok all(approx(scalar($uw->unionvec($xy)), pdl([[-3,-2,-1],[1,2,3],[4,5,6],[7,8
,9]]))), "unionvec - broadcast dims - uw+xy";
ok all(approx(scalar($empty->unionvec($wx)), $wx)), "unionvec - broadcast dims
- 0+wx";
ok all(approx(scalar($wx->unionvec($empty)), $wx)), "unionvec - broadcast dims
- wx+0";
ok all(approx(scalar($empty->unionvec($empty)), $empty)), "unionvec - broadcas
t dims - 0+0";
# unionvec: broadcasting
my $k = 2;
my $kempty = $empty->slice(",,*$k");
my $kuw = $uw->slice(",,*$k");
my $kwx = $wx->slice(",,*$k");
my $kxy = $xy->slice(",,*$k");
ok all(approx(scalar($kuw->unionvec($wx)), pdl([[-3,-2,-1],[1,2,3],[4,5,6]])->
slice(",,*$k"))), "unionvec - broadcast dims - uw(*k)+wx";
ok all(approx(scalar($kuw->unionvec($xy)), pdl([[-3,-2,-1],[1,2,3],[4,5,6],[7,
8,9]])->slice(",,*$k"))), "unionvec - broadcast dims - uw(*k)+xy";
ok all(approx(scalar($kempty->unionvec($wx)), $kwx)), "unionvec - broadcast di
ms - 0(*k)+wx";
ok all(approx(scalar($kwx->unionvec($empty)), $kwx)), "unionvec - broadcast di
ms - wx(*k)+0";
ok all(approx(scalar($kempty->unionvec($empty)), $kempty)), "unionvec - broadc
ast dims - 0(*k)+0";
##-- intersectvec
my $needle0 = pdl([[-3,-2,-1]]);
my $needle1 = pdl([[1,2,3]]);
my $needles = pdl([[-3,-2,-1],[1,2,3]]);
my $haystack = pdl([[1,2,3],[4,5,6],[7,8,9],[10,11,12]]);
# intersectvec: basic
ok all(approx(scalar($needle0->intersectvec($haystack)), $empty)), "intersectv
ec - broadcast dims - needle0&haystack";
ok all(approx(scalar($needle1->intersectvec($haystack)), $needle1)), "intersec
tvec - broadcast dims - needle1&haystack";
ok all(approx(scalar($needles->intersectvec($haystack)), $needle1)), "intersec
tvec - broadcast dims - needles&haystack";
ok all(approx(scalar($haystack->intersectvec($haystack)), $haystack)), "inters
ectvec - broadcast dims - haystack&haystack";
ok all(approx(scalar($haystack->intersectvec($empty)), $empty)), "intersectvec
- broadcast dims - haystack&empty";
ok all(approx(scalar($empty->intersectvec($haystack)), $empty)), "intersectvec
- broadcast dims - empty&haystack";
# intersectvec: broadcasting
my $kneedle0 = $needle0->slice(",,*$k");
my $kneedle1 = $needle1->slice(",,*$k");
my $kneedles = pdl([[[-3,-2,-1]],[[1,2,3]]]);
my $khaystack = $haystack->slice(",,*$k");
ok all(approx(scalar($kneedle0->intersectvec($haystack)), $kempty)), "intersec
tvec - broadcast dims - needle0(*k)&haystack";
ok all(approx(scalar($kneedle1->intersectvec($haystack)), $kneedle1)), "inters
ectvec - broadcast dims - needle1(*k)&haystack";
ok all(approx(
scalar($kneedles->intersectvec($haystack)),
pdl([[[0,0,0]],[[1,2,3]]]))), "intersectvec - broadcast dims - needles(*k
)&haystack";
ok all(approx(scalar($khaystack->intersectvec($haystack)), $khaystack)), "inte
rsectvec - broadcast dims - haystack(*k)&haystack";
ok all(approx(scalar($khaystack->intersectvec($empty)), $kempty)), "intersectv
ec - broadcast dims - haystack(*k)&empty";
ok all(approx(scalar($kempty->intersectvec($haystack)), $kempty)), "intersectv
ec - broadcast dims - empty(*k)&haystack";
##-- setdiffvec
# setdiffvec: basic
ok all(approx(scalar($haystack->setdiffvec($needle0)), $haystack)), "setdiffve
c - broadcast dims - haystack-needle0";
ok all(approx(scalar($haystack->setdiffvec($needle1)), $haystack->slice(",1:-1
"))), "setdiffvec - broadcast dims - haystack-needle1";
ok all(approx(scalar($haystack->setdiffvec($needles)), $haystack->slice(",1:-1
"))), "setdiffvec - broadcast dims - haystack-needles";
ok all(approx(scalar($haystack->setdiffvec($haystack)), $empty)), "setdiffvec
- broadcast dims - haystack-haystack";
ok all(approx(scalar($haystack->setdiffvec($empty)), $haystack)), "setdiffvec
- broadcast dims - haystack-empty";
ok all(approx(scalar($empty->setdiffvec($haystack)), $empty)), "setdiffvec - b
roadcast dims - empty-haystack";
# setdiffvec: broadcasting
ok all(approx(scalar($khaystack->setdiffvec($needle0)), $khaystack)), "setdiff
vec - broadcast dims - haystack(*k)-needle0";
ok all(approx(scalar($khaystack->setdiffvec($needle1)), $khaystack->slice(",1:
-1,"))), "setdiffvec - broadcast dims - haystack(*k)-needle1";
ok all(approx(scalar($khaystack->setdiffvec($needles)), $khaystack->slice(",1:
-1,"))), "setdiffvec - broadcast dims - haystack(*k)-needles";
ok all(approx(scalar($khaystack->setdiffvec($haystack)), $kempty)), "setdiffve
c - broadcast dims - haystack(*k)-haystack";
ok all(approx(scalar($khaystack->setdiffvec($empty)), $khaystack)), "setdiffve
c - broadcast dims - haystack(*k)-empty";
ok all(approx(scalar($kempty->setdiffvec($haystack)), $kempty)), "setdiffvec -
broadcast dims - empty(*k)-haystack";
}
test_broadcast_dimensions();
## intersectvec tests as suggested by ETJ/mowhawk2
## + see https://github.com/moocow-the-bovine/PDL-VectorValued/issues/4
sub test_intersect_implicit_dims {
# intersectvec: from ETJ/mowhawk2 a la https://stackoverflow.com/a/71446817/38
57002
my $toto = pdl([1,2,3], [4,5,6]);
my $titi = pdl(1,2,3);
my $notin = pdl(7,8,9);
my ($c);
ok all(approx($c=intersectvec($titi,$toto), [[1,2,3]])), 'intersectvec - impli
cit dims - titi&toto';
ok all(approx($c=intersectvec($notin,$toto), zeroes(3,0))), 'intersectvec - im
plicit dims - notin&toto';
ok all(approx($c=intersectvec($titi->dummy(1), $toto), [[1,2,3]])), 'intersect
vec - implicit dims - titi(*1)&toto';
ok all(approx($c=intersectvec($notin->dummy(1), $toto), zeroes(3,0))), 'inters
ectvec - implicit dims - notin(*1)&toto';
my $needle0_in = pdl([1,2,3]); # 3
my $needle0_notin = pdl([9,9,9]); # 3
my $needle_in = $needle0_in->dummy(1); # 3x1: [[1 2 3]]
my $needle_notin = $needle0_notin->dummy(1); # 3x1: [[-3 -2 -1]]
my $needles = pdl([[1,2,3],[9,9,9]]); # 3x2: $needle0_in->cat($needle0_notin)
my $haystack = pdl([[1,2,3],[4,5,6]]); # 3x2
sub intersect_ok {
my ($label, $a,$b, $c_want,$nc_want,$c_sclr_want) = @_;
my ($c, $nc) = intersectvec($a,$b);
my $c_sclr = intersectvec($a,$b);
ok all(approx($c, $c_want)), "$label - result";
ok all(approx($nc, $nc_want)), "$label - counts";
ok all(approx($c_sclr, $c_sclr_want)), "$label - scalar";
}
intersect_ok('intersectvec - implicit dims - needle0_in&haystack',
$needle0_in, $haystack,
[[1,2,3]], 1, [[1,2,3]]
);
intersect_ok('intersectvec - implicit dims - needle_in&haystack',
$needle_in, $haystack,
[[1,2,3]], 1, [[1,2,3]]
);
intersect_ok('intersectvec - implicit dims - needle0_notin&haystack',
$needle0_notin, $haystack,
[[0,0,0]], 0, zeroes(3,0)
);
intersect_ok('intersectvec - implicit dims - needle_notin&haystack',
$needle_notin, $haystack,
[[0,0,0]], 0, zeroes(3,0)
);
intersect_ok('intersectvec - implicit dims - needles&haystack',
$needles, $haystack,
[[1,2,3],[0,0,0]], 1, [[1,2,3]]
);
# now we want to know whether each needle is "in" one by one, not really
# a normal intersect, so we insert a dummy in haystack in order to broadcast
# the "nc" needs to come back as a 4x2
my $needles8 = pdl( [[[1,2,3],[4,5,6],[8,8,8],[8,8,8]],
[[4,5,6],[9,9,9],[1,2,3],[9,9,9]]]); # 3x4x2
# need to manipulate above into suitable inputs for intersect to get right out
put
# + dummy dim here also ensures singleton query-vector-sets are (trivially) so
rted
my $needles8x = $needles8->slice(",*1,,"); # 3x*x4x2 # dummy of size 1 inserte
d in dim 1
# haystack: no changes needed; don't need same number of dims, broadcast engin
e will add dummy/1s at top
my $haystack8 = $haystack;
my $c_want8 = [
[[[1,2,3]],[[4,5,6]],[[0,0,0]],[[0,0,0]]],
[[[4,5,6]],[[0,0,0]],[[1,2,3]],[[0,0,0]]],
];
my $nc_want8 = [[1,1,0,0],
[1,0,1,0]];
intersect_ok('intersectvec - implicit dims - needles8x&haystack8',
$needles8x, $haystack8,
$c_want8, $nc_want8, $c_want8
);
}
test_intersect_implicit_dims();
## dim-checks and implicit broadcast dimensions
## + analogous to https://github.com/moocow-the-bovine/PDL-VectorValued/issues/
4
sub test_v_broadcast_dimensions {
# data: basic
my $empty = zeroes(0);
my $v1_2 = pdl([1,2]);
my $v3_4 = pdl([3,4]);
my $v1_4 = $v1_2->cat($v3_4)->flat;
# data: broadcasting
my $k = 2;
my $kempty = $empty->slice(",*$k");
my $kv1_2 = $v1_2->slice(",*$k");
my $kv3_4 = $v3_4->slice(",*$k");
my $kv1_4 = $v1_4->slice(",*$k");
#-- union_sorted
ok all(approx(scalar($v1_2->union_sorted($v3_4)), $v1_4)), "union_sorted - bro
adcast dims - 12+34";
ok all(approx(scalar($v3_4->union_sorted($v1_4)), $v1_4)), "union_sorted - bro
adcast dims - 34+1234";
ok all(approx(scalar($empty->union_sorted($v1_4)), $v1_4)), "union_sorted - br
oadcast dims - 0+1234";
ok all(approx(scalar($v1_4->union_sorted($empty)), $v1_4)), "union_sorted - br
oadcast dims - 1234+0";
ok all(approx(scalar($empty->union_sorted($empty)), $empty)), "union_sorted -
broadcast dims - 0+0";
#
ok all(approx(scalar($kv1_2->union_sorted($v3_4)), $kv1_4)), "union_sorted - b
roadcast dims - 12(*k)+34";
ok all(approx(scalar($kv3_4->union_sorted($v1_4)), $kv1_4)), "union_sorted - b
roadcast dims - 34(*k)+1234";
ok all(approx(scalar($kempty->union_sorted($v1_4)), $kv1_4)), "union_sorted -
broadcast dims - 0(*k)+1234";
ok all(approx(scalar($kv1_4->union_sorted($empty)), $kv1_4)), "union_sorted -
broadcast dims - 1234(*k)+0";
ok all(approx(scalar($kempty->union_sorted($empty)), $kempty)), "union_sorted
- broadcast dims - 0(*k)+0";
#-- intersect_sorted
ok all(approx(scalar($v1_2->intersect_sorted($v3_4)), $empty)), "intersect_sor
ted - broadcast dims - 12&34";
ok all(approx(scalar($v3_4->intersect_sorted($v1_4)), $v3_4)), "intersect_sort
ed - broadcast dims - 34&1234";
ok all(approx(scalar($empty->intersect_sorted($v1_4)), $empty)), "intersect_so
rted - broadcast dims - 0&1234";
ok all(approx(scalar($v1_4->intersect_sorted($empty)), $empty)), "intersect_so
rted - broadcast dims - 1234&0";
ok all(approx(scalar($empty->intersect_sorted($empty)), $empty)), "intersect_s
orted - broadcast dims - 0&0";
#
ok all(approx(scalar($kv1_2->intersect_sorted($v3_4)), $kempty)), "intersect_s
orted - broadcast dims - 12(*k)&34";
ok all(approx(scalar($kv3_4->intersect_sorted($v1_4)), $kv3_4)), "intersect_so
rted - broadcast dims - 34(*k)&1234";
ok all(approx(scalar($kempty->intersect_sorted($v1_4)), $kempty)), "intersect_
sorted - broadcast dims - 0(*k)&1234";
ok all(approx(scalar($kv1_4->intersect_sorted($empty)), $kempty)), "intersect_
sorted - broadcast dims - 1234(*k)&0";
ok all(approx(scalar($kempty->intersect_sorted($empty)), $kempty)), "intersect
_sorted - broadcast dims - 0(*k)&0";
#-- setdiff_sorted
ok all(approx(scalar($v1_2->setdiff_sorted($v3_4)), $v1_2)), "setdiff_sorted -
broadcast dims - 12-34";
ok all(approx(scalar($v3_4->setdiff_sorted($v1_4)), $empty)), "setdiff_sorted
- broadcast dims - 34-1234";
ok all(approx(scalar($v1_4->setdiff_sorted($empty)), $v1_4)), "setdiff_sorted
- broadcast dims - 1234-0";
ok all(approx(scalar($empty->setdiff_sorted($v1_4)), $empty)), "setdiff_sorted
- broadcast dims - 0-1234";
ok all(approx(scalar($empty->setdiff_sorted($empty)), $empty)), "setdiff_sorte
d - broadcast dims - 0-0";
#
ok all(approx(scalar($kv1_2->setdiff_sorted($v3_4)), $kv1_2)), "setdiff_sorted
- broadcast dims - 12(*k)-34";
ok all(approx(scalar($kv3_4->setdiff_sorted($v1_4)), $kempty)), "setdiff_sorte
d - broadcast dims - 34(*k)-1234";
ok all(approx(scalar($kv1_4->setdiff_sorted($empty)), $kv1_4)), "setdiff_sorte
d - broadcast dims - 1234(*k)-0";
ok all(approx(scalar($kempty->setdiff_sorted($v1_4)), $kempty)), "setdiff_sort
ed - broadcast dims - 0(*k)-1234";
ok all(approx(scalar($kempty->setdiff_sorted($empty)), $kempty)), "setdiff_sor
ted - broadcast dims - 0(*k)-0";
}
test_v_broadcast_dimensions();
done_testing; done_testing;
 End of changes. 1 change blocks. 
0 lines changed or deleted 350 lines changed or added

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