Merge 2151584 into 4163a82

Basic/Slices/slices.pd

@@ -1253,40 +1253,70 @@ EOD
 
 pp_def(
         'rle',
-        Pars=>'c(n); indx [o]a(n); [o]b(n);',
+        Pars=>'c(n); indx [o]a(m); [o]b(m);',
+#this RedoDimsCode sets $SIZE(m)==$SIZE(n), but the slice in the PMCode below makes m<=n.
+        RedoDimsCode=>'$SIZE(m)=$PDL(c)->dims[0];',
+        PMCode=><<'EOC',
+sub PDL::rle {
+  my $c = shift;
+  my ($a,$b) = @_==2 ? @_ : (null,null);
+  &PDL::_rle_int($c,$a,$b);
+  my $max_ind = ($c->ndims<2) ? ($a!=0)->sumover-1 :
+                                ($a!=0)->clump(1..$a->ndims-1)->sumover->max-1;
+  return ($a->slice("0:$max_ind"),$b->slice("0:$max_ind"));
+}
+EOC
         Code=>'
           PDL_Indx j=0,sn=$SIZE(n);
           $GENERIC(c) cv, clv;
           clv = $c(n=>0);
-          $b(n=>0) = clv;
-          $a(n=>0) = 0;
+          $b(m=>0) = clv;
+          $a(m=>0) = 0;
           loop (n) %{
             cv = $c();
             if (cv == clv) {
-              $a(n=>j)++;
+              $a(m=>j)++;
             } else {
               j++;
-              $b(n=>j) = clv = cv;
-              $a(n=>j) = 1;
+              $b(m=>j) = clv = cv;
+              $a(m=>j) = 1;
             }
           %}
-          for (j++;j<sn;j++) {
-            $a(n=>j) = 0;
-            $b(n=>j) = 0;
+          for (j++;j<$SIZE(m);j++) {
+            $a(m=>j) = 0;
+            $b(m=>j) = 0;
           }
         ',
         Doc => <<'EOD'
 =for ref
 
 Run-length encode a vector
 
-Given vector C<$c>, generate a vector C<$a> with the number of each element,
-and a vector C<$b> of the unique values.  Only the elements up to the
-first instance of C<0> in C<$a> should be considered.
+Given vector C<$c>, generate a vector C<$a> with the number of each
+element, and a vector C<$b> of the unique values.  New in PDL 2.017,
+only the elements up to the first instance of C<0> in C<$a> are
+returned, which makes the common use case of a 1-dimensional C<$c> simpler.
+For threaded operation, C<$a> and C<$b> will be large enough
+to hold the largest row of C<$a>, and only the elements up to the
+first instance of C<0> in each row of C<$a> should be considered.
 
 =for example
 
+ $c = floor(4*random(10));
  rle($c,$a=null,$b=null);
+ #or
+ ($a,$b) = rle($c);
+
+ #for $c of shape [10, 4]:
+ $c = floor(4*random(10,4));
+ ($a,$b) = rle($c);
+
+ #to see the results of each row one at a time:
+ foreach (0..$c->dim(1)-1){
+  my ($as,$bs) = ($a(:,($_)),$b(:,($_)));
+  my ($ta,$tb) = where($as,$bs,$as!=0); #only the non-zero elements of $a
+  print $c(:,($_)) . " rle==> " , ($ta,$tb) , "\trld==> " . rld($ta,$tb) . "\n";
+ }
 
 =cut
 

t/slice.t

@@ -4,7 +4,7 @@
 use strict;
 use Test::More;
 
-plan tests => 92;
+plan tests => 95;
     ;
 use PDL::LiteF;
 
@@ -215,7 +215,20 @@ $a = pdl [1,1,1,3,3,4,4,1,1,2];
 $b = null;
 $c = null;
 rle($a,$b,$c);
-ok(tapprox($a, rld($b,$c)));
+ok(tapprox($a, rld($b,$c)),"rle with null input");
+
+undef $b; undef $c;
+($b,$c) = rle($a);
+ok(tapprox($a, rld($b,$c)),"rle with return vals");
+
+my $a2d = $a->cat($a->rotate(1),$a->rotate(2),$a->rotate(3),$a->rotate(4));
+rle($a2d,$b=null,$c=null);
+ok(tapprox($a2d,rld($b,$c)),"rle 2d with null input");
+
+undef $b; undef $c;
+($b,$c) = rle($a2d);
+ok(tapprox($a2d, rld($b,$c)),"rle 2d with return vals");
+
 
 $b = $a->mslice(0.5);
 ok(tapprox($b, 1), "mslice 1");