Make cat return a piddle of the highest input type, not the first.

Previously the first element of a list provided to 'cat' was used to set the type of the output piddle. Now it uses the "highest" type if passed a mixed-type list. Also added some tests for this new behavior, and improved the documentation for cat, append, and glue to better highlight the differences between then.
PDLPorters · Oct 2, 2017 · 1c009bc · 1c009bc
1 parent b3a5db5
commit 1c009bc
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 26 deletions.
diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm
@@ -3155,7 +3155,7 @@ sub PDL::sclr {
 concatenate piddles to N+1 dimensional piddle
 
 Takes a list of N piddles of same shape as argument,
-returns a single piddle of dimension N+1
+returns a single piddle of dimension N+1.
 
 =for example
 
@@ -3185,8 +3185,15 @@ docs will also say this:
 
 The output piddle is set bad if any input piddles have their bad flag set.
 
-Similar functions include L<append|PDL::Primitive/append> and
-L<glue|PDL::Primitive/glue>.
+Similar functions include L<append|PDL::Primitive/append>, which
+appends only two piddles along their first dimension, and
+L<glue|PDL::Primitive/glue>, which can append more than two piddles
+along an arbitary dimension.
+
+Also consider the generic constructor L<pdl|pdl>, which can handle
+piddles of different sizes (with zero-padding), and will return a
+piddle of type 'double' by default, but may be considerably faster (up
+to 10x) than cat.
 
 =cut
 
@@ -3196,7 +3203,7 @@ sub PDL::cat {
 	$@ = '';
 	eval {
 		$res = $_[0]->initialize;
-		$res->set_datatype($_[0]->get_datatype);
+		$res->set_datatype((sort {$b<=>$a} map{$_->get_datatype} @_)[0] );
 
 		my @resdims = $_[0]->dims;
 		for my $i(0..$#_){

diff --git a/Basic/Primitive/primitive.pd b/Basic/Primitive/primitive.pd
@@ -1950,20 +1950,23 @@ pp_def('append',
 
 =for ref
 
-append two or more piddles by concatenating along their first dimensions
+append two piddles by concatenating along their first dimensions
 
 =for example
 
  $a = ones(2,4,7);
  $b = sequence 5;
  $c = $a->append($b);  # size of $c is now (7,4,7) (a jumbo-piddle ;)
 
-C<append> appends two piddles along their first dims. Rest of the dimensions
-must be compatible in the threading sense. Resulting size of first dim is
-the sum of the sizes of the first dims of the two argument piddles -
-ie C<n + m>.
+C<append> appends two piddles along their first dimensions. The rest of the
+dimensions must be compatible in the threading sense. The resulting
+size of the first dimension is the sum of the sizes of the first dimensions
+of the two argument piddles - i.e. C<n + m>.
 
-Similar functions include L<glue|/glue> (below) and L<cat|PDL::Core/cat>.
+Similar functions include L<glue|/glue> (below), which can append more
+than two piddles along an arbitary dimension, and
+L<cat|PDL::Core/cat>, which can append more than two piddles that all
+have the same sized dimensions.
 
 =cut
 
@@ -2003,7 +2006,10 @@ C<glue> is implemented in pdl, using a combination of L<xchg|PDL::Slices/xchg> a
 L<append|append>.  It should probably be updated (one day) to a pure PP
 function.
 
-Similar functions include L<append|/append> (above) and L<cat|PDL::Core/cat>.
+Similar functions include L<append|/append> (above), which appends
+only two piddles along their first dimension, and
+L<cat|PDL::Core/cat>, which can append more than two piddles that all
+have the same sized dimensions.
 
 =cut
 

diff --git a/t/core.t b/t/core.t
@@ -7,13 +7,13 @@ use strict;
 use Test::More;
 
 BEGIN {
-    # if we've got this far in the tests then 
+    # if we've got this far in the tests then
     # we can probably assume PDL::LiteF works!
     #
     eval {
         require PDL::LiteF;
     } or BAIL_OUT("PDL::LiteF failed: $@");
-    plan tests => 70;
+    plan tests => 75;
     PDL::LiteF->import;
 }
 $| = 1;
@@ -114,13 +114,13 @@ $b = pdl( long, $a );
 $c = pdl( long, [ 2, 0, 3, 4 ] )->reshape(2,2);
 ok all( $b == $c ), "undef converted to 0 (long)";
 
-do { 
+do {
     local($PDL::undefval) = -999;
     $a = [ [ 2, undef ], [3, 4 ] ];
     $b = pdl( $a );
     $c = pdl( [ 2, -999, 3, 4 ] )->reshape(2,2);
     ok all( $b == $c ), "undef converted to -999 (dbl)";
-    
+
     $b = pdl( long, $a );
     $c = pdl( long, [ 2, -999, 3, 4 ] )->reshape(2,2);
     ok all( $b == $c ), "undef converted to -999 (long)";
@@ -138,16 +138,16 @@ TODO: {
 
    # pdl of mixed-dim pdls: pad within a dimension
    $a = pdl( zeroes(5), ones(3) );
-   ok all($a == pdl([0,0,0,0,0],[1,1,1,0,0])),"Piddlifying two piddles catenates them and pads to length" or diag("a=$a\n");
+   ok all($a == pdl([0,0,0,0,0],[1,1,1,0,0])),"Piddlifying two piddles concatenates them and pads to length" or diag("a=$a\n");
 }
-   
+
 # pdl of mixed-dim pdls: pad a whole dimension
 $a = pdl( [[9,9],[8,8]], xvals(3)+1 );
-ok all($a == pdl([[[9,9],[8,8],[0,0]] , [[1,0],[2,0],[3,0]] ])),"can catenate mixed-dim piddles" or diag("a=$a\n");
+ok all($a == pdl([[[9,9],[8,8],[0,0]] , [[1,0],[2,0],[3,0]] ])),"can concatenate mixed-dim piddles" or diag("a=$a\n");
 
 # pdl of mixed-dim pdls: a hairier case
 $c = pdl [1], pdl[2,3,4], pdl[5];
-ok all($c == pdl([[[1,0,0],[0,0,0]],[[2,3,4],[5,0,0]]])),"Can catenate mixed-dim piddles: hairy case" or diag("c=$c\n");
+ok all($c == pdl([[[1,0,0],[0,0,0]],[[2,3,4],[5,0,0]]])),"Can concatenate mixed-dim piddles: hairy case" or diag("c=$c\n");
 
 # same thing, with undefval set differently
 do {
@@ -161,19 +161,19 @@ eval {$a = zeroes(2,0,1);};
 ok(!$@,"zeroes accepts empty PDL specification");
 
 eval { $b = pdl($a,sequence(2,0,1)); };
-ok((!$@ and all(pdl($b->dims) == pdl(2,0,1,2))), "catenating two empties gives an empty");
+ok((!$@ and all(pdl($b->dims) == pdl(2,0,1,2))), "concatenating two empties gives an empty");
 
 eval { $b = pdl($a,sequence(2,1,1)); };
-ok((!$@ and all(pdl($b->dims) == pdl(2,1,1,2))), "catenating an empty and a nonempty treats the empty as a filler");
+ok((!$@ and all(pdl($b->dims) == pdl(2,1,1,2))), "concatenating an empty and a nonempty treats the empty as a filler");
 
 eval { $b = pdl($a,5) };
-ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "catenating an empty and a scalar on the right works");
-ok( all($b==pdl([[[0,0]]],[[[5,0]]])), "catenating an empty and a scalar on the right gives the right answer");
+ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "concatenating an empty and a scalar on the right works");
+ok( all($b==pdl([[[0,0]]],[[[5,0]]])), "concatenating an empty and a scalar on the right gives the right answer");
 
 eval { $b = pdl(5,$a) };
-ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "catenating an empty and a scalar on the left works");
-ok( all($b==pdl([[[5,0]]],[[[0,0]]])), "catenating an empty and a scalar on the left gives the right answer");
-    
+ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "concatenating an empty and a scalar on the left works");
+ok( all($b==pdl([[[5,0]]],[[[0,0]]])), "concatenating an empty and a scalar on the left gives the right answer");
+
 # end
 
 # cat problems
@@ -212,6 +212,16 @@ ok( ($a->ndims==2 and $a->dim(0)==2 and $a->dim(1)==2), 'weird cat case has the
 ok( all( $a == pdl([1,1],[2,3]) ), "cat does the right thing with catting a 0-pdl and 2-pdl together");
 $@='';
 
+my $by=xvals(byte,5)+253;
+my $so=xvals(short,5)+32766;
+my $lo=xvals(long,5)+32766;
+my $fl=float(xvals(5)+0.2);
+my @list = ($lo,$so,$fl,$by);
+my $c2 = cat(@list);
+is($c2->type,'float','concatentating different datatypes returns the highest type');
+my $i=0;
+map{ ok(all($_==$list[$i]),"cat/dog symmetry for values ($i)"); $i++; }$c2->dog;
+
 # new_or_inplace
 $a = sequence(byte,5);