Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Add better rle output size handling and documentation (SF feat req 80).
This adds a wrapper around the pp_def'd rle code so that rle() output
is no bigger than it needs to be. This removes the necessity of
manually truncating the output in the common 1D use case. Also
adds (hopefully) improved documemtation for rle, and a few new tests.
  • Loading branch information
d-lamb committed Sep 28, 2016
1 parent 4163a82 commit 19b3a39
Show file tree
Hide file tree
Showing 2 changed files with 46 additions and 5 deletions.
34 changes: 31 additions & 3 deletions Basic/Slices/slices.pd
Expand Up @@ -1254,6 +1254,16 @@ EOD
pp_def(
'rle',
Pars=>'c(n); indx [o]a(n); [o]b(n);',
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;
Expand All @@ -1280,13 +1290,31 @@ pp_def(
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
Expand Down
17 changes: 15 additions & 2 deletions t/slice.t
Expand Up @@ -4,7 +4,7 @@
use strict;
use Test::More;

plan tests => 92;
plan tests => 95;
;
use PDL::LiteF;

Expand Down Expand Up @@ -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");
Expand Down

0 comments on commit 19b3a39

Please sign in to comment.