"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Slices/slices.pd" 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).

slices.pd  (PDL-2.079):slices.pd  (PDL-2.080)
skipping to change at line 72 skipping to change at line 72
=cut =cut
use strict; use strict;
use warnings; use warnings;
use PDL::Core ':Internal'; use PDL::Core ':Internal';
use Scalar::Util 'blessed'; use Scalar::Util 'blessed';
EOD EOD
=head1
FUNCTIONS
=cut
# $::PP_VERBOSE=1; # $::PP_VERBOSE=1;
pp_addhdr(<<'EOH'); pp_addhdr(<<'EOH');
#ifdef _MSC_VER #ifdef _MSC_VER
#define strtoll _strtoi64 #define strtoll _strtoi64
#endif #endif
EOH EOH
skipping to change at line 350 skipping to change at line 346
=for ref =for ref
Engine for L</range> Engine for L</range>
=for example =for example
Same calling convention as L</range>, but you must supply all Same calling convention as L</range>, but you must supply all
parameters. C<rangeb> is marginally faster as it makes a direct PP call, parameters. C<rangeb> is marginally faster as it makes a direct PP call,
avoiding the perl argument-parsing step. avoiding the perl argument-parsing step.
=cut
=head2 range =head2 range
=for ref =for ref
Extract selected chunks from a source ndarray, with boundary conditions Extract selected chunks from a source ndarray, with boundary conditions
=for example =for example
$out = $source->range($index,[$size,[$boundary]]) $out = $source->range($index,[$size,[$boundary]])
skipping to change at line 685 skipping to change at line 679
/*** /***
* Fill in the boundary condition array * Fill in the boundary condition array
*/ */
{ {
char *bstr; char *bstr;
STRLEN blen; STRLEN blen;
bstr = SvPV(boundary_sv,blen); bstr = SvPV(boundary_sv,blen);
if(blen == 0) { if(blen == 0) {
/* If no boundary is specified then every dim gets forbidden */ /* If no boundary is specified then every dim gets forbidden */
int i; PDL_Indx i;
for (i=0;i<$COMP(rdim);i++) for (i=0;i<$COMP(rdim);i++)
$COMP(boundary[i]) = 0; $COMP(boundary[i]) = 0;
} else { } else {
int i; PDL_Indx i;
for(i=0;i<$COMP(rdim);i++) { for(i=0;i<$COMP(rdim);i++) {
switch(bstr[i < blen ? i : blen-1 ]) { switch(bstr[i < blen ? i : blen-1 ]) {
case '0': case 'f': case 'F': /* forbid */ case '0': case 'f': case 'F': /* forbid */
$COMP(boundary[i]) = 0; $COMP(boundary[i]) = 0;
break; break;
case '1': case 't': case 'T': /* truncate */ case '1': case 't': case 'T': /* truncate */
$COMP(boundary[i]) = 1; $COMP(boundary[i]) = 1;
break; break;
case '2': case 'e': case 'E': /* extend */ case '2': case 'e': case 'E': /* extend */
$COMP(boundary[i]) = 2; $COMP(boundary[i]) = 2;
skipping to change at line 836 skipping to change at line 830
for(k=0; k<$COMP(itdim) && (++(iter[k]))>=($COMP(itdims)[k]) ;k++) for(k=0; k<$COMP(itdim) && (++(iter[k]))>=($COMP(itdims)[k]) ;k++)
iter[k] = 0; iter[k] = 0;
} while(k<$COMP(itdim)); } while(k<$COMP(itdim));
if ($COMP(ind_pdl_destroy)) if ($COMP(ind_pdl_destroy))
PDL->destroy(ind_pdl); /* finished with our copy */ PDL->destroy(ind_pdl); /* finished with our copy */
if ($COMP(size_pdl_destroy)) if ($COMP(size_pdl_destroy))
PDL->destroy(size_pdl); /* finished with our copy */ PDL->destroy(size_pdl); /* finished with our copy */
EOD-MakeComp EOD-MakeComp
RedoDims => <<'EOD-RedoDims' , RedoDims => <<'EOD-RedoDims' ,
PDL_Indx stdim = $PARENT(ndims) - $COMP(rdim); PDL_Indx stdim = $PDL(PARENT)->ndims - $COMP(rdim);
PDL_Indx dim,inc; PDL_Indx dim,inc;
PDL_Indx i,rdvalid; PDL_Indx i,rdvalid;
// Speed bump for ludicrous cases // Speed bump for ludicrous cases
if( $COMP(rdim) > $PARENT(ndims)+5 && $COMP(nsizes) != $COMP(rdim)) { if( $COMP(rdim) > $PDL(PARENT)->ndims+5 && $COMP(nsizes) != $COMP(rdim)) {
$CROAK( $CROAK(
"Ludicrous number of extra dims in range index; leaving child null.\n" "Ludicrous number of extra dims in range index; leaving child null.\n"
" (%"IND_FLAG" implicit dims is > 5; index has %"IND_FLAG" dims; source h as %"IND_FLAG" dim%s.)\n" " (%"IND_FLAG" implicit dims is > 5; index has %"IND_FLAG" dims; source h as %"IND_FLAG" dim%s.)\n"
" This often means that your index PDL is incorrect.\n" " This often means that your index PDL is incorrect.\n"
" To avoid this message, allocate dummy dims in\n" " To avoid this message, allocate dummy dims in\n"
" the source or use %"IND_FLAG" dims in range's size field.\n", " the source or use %"IND_FLAG" dims in range's size field.\n",
$COMP(rdim)-$PARENT(ndims),$COMP(rdim),$PARENT(ndims), $COMP(rdim)-$PDL(PARENT)->ndims,$COMP(rdim),$PDL(PARENT)->ndims,
$PARENT(ndims)>1?"s":"",$COMP(rdim) $PDL(PARENT)->ndims>1?"s":"",$COMP(rdim)
); );
} }
if(stdim < 0) if(stdim < 0)
stdim = 0; stdim = 0;
/* Set dimensionality of child */ /* Set dimensionality of child */
$CHILD(ndims) = $COMP(itdim) + $COMP(ntsize) + stdim; $PDL(CHILD)->ndims = $COMP(itdim) + $COMP(ntsize) + stdim;
$SETNDIMS($COMP(itdim)+$COMP(ntsize)+stdim); $SETNDIMS($COMP(itdim)+$COMP(ntsize)+stdim);
inc = 1; inc = 1;
/* Copy size dimensions to child, crunching as we go. */ /* Copy size dimensions to child, crunching as we go. */
dim = $COMP(itdim); dim = $COMP(itdim);
for(i=rdvalid=0;i<$COMP(rdim);i++) { for(i=rdvalid=0;i<$COMP(rdim);i++) {
if($COMP(sizes[i])) { if($COMP(sizes[i])) {
rdvalid++; rdvalid++;
$CHILD(dimincs[dim]) = inc; $PDL(CHILD)->dimincs[dim] = inc;
inc *= ($CHILD(dims[dim++]) = $COMP(sizes[i])); /* assignment */ inc *= ($PDL(CHILD)->dims[dim++] = $COMP(sizes[i])); /* assignment */
} }
} }
/* Copy index broadcast dimensions to child */ /* Copy index broadcast dimensions to child */
for(dim=0; dim<$COMP(itdim); dim++) { for(dim=0; dim<$COMP(itdim); dim++) {
$CHILD(dimincs[dim]) = inc; $PDL(CHILD)->dimincs[dim] = inc;
inc *= ($CHILD(dims[dim]) = $COMP(itdims[dim])); /* assignment */ inc *= ($PDL(CHILD)->dims[dim] = $COMP(itdims[dim])); /* assignment */
} }
/* Copy source broadcast dimensions to child */ /* Copy source broadcast dimensions to child */
dim = $COMP(itdim) + rdvalid; dim = $COMP(itdim) + rdvalid;
for(i=0;i<stdim;i++) { for(i=0;i<stdim;i++) {
$CHILD(dimincs[dim]) = inc; $PDL(CHILD)->dimincs[dim] = inc;
inc *= ($CHILD(dims[dim++]) = $PARENT(dims[i+$COMP(rdim)])); /* assignment * inc *= ($PDL(CHILD)->dims[dim++] = $PDL(PARENT)->dims[i+$COMP(rdim)]); /* as
/ signment */
} }
/* Cover bizarre case where the source PDL is empty - in that case, change */ /* Cover bizarre case where the source PDL is empty - in that case, change */
/* all non-barfing boundary conditions to truncation, since we have no data */ /* all non-barfing boundary conditions to truncation, since we have no data */
/* to reflect, extend, or mirror. */ /* to reflect, extend, or mirror. */
if($PARENT(dims[0]) == 0) { if($PDL(PARENT)->dims[0] == 0) {
for(dim=0; dim<$COMP(rdim); dim++) { for(dim=0; dim<$COMP(rdim); dim++) {
if($COMP(boundary[dim])) if($COMP(boundary[dim]))
$COMP(boundary[dim]) = 1; // force truncation $COMP(boundary[dim]) = 1; // force truncation
} }
} }
$CHILD(datatype) = $PARENT(datatype); $PDL(CHILD)->datatype = $PDL(PARENT)->datatype;
$SETDIMS(); $SETDIMS();
EOD-RedoDims EOD-RedoDims
EquivCPOffsCode => <<'EOD-EquivCPOffsCode', EquivCPOffsCode => <<'EOD-EquivCPOffsCode',
PDL_Indx *ip; /* vector iterator */ PDL_Indx *ip; /* vector iterator */
PDL_Indx *sp; /* size vector including stdims */ PDL_Indx *sp; /* size vector including stdims */
PDL_Indx *coords; /* current coordinates */ PDL_Indx *coords; /* current coordinates */
PDL_Indx k; /* index */ PDL_Indx k; /* index */
PDL_Indx item; /* index broadcast iterator */ PDL_Indx item; /* index broadcast iterator */
skipping to change at line 1048 skipping to change at line 1042
/* Increment the in-range iterator */ /* Increment the in-range iterator */
for(k = 0; for(k = 0;
k < $COMP(rdim) && (++(iter2[k]) >= $COMP(sizes[k])); k < $COMP(rdim) && (++(iter2[k]) >= $COMP(sizes[k]));
k++) k++)
iter2[k] = 0; iter2[k] = 0;
} while(k < $COMP(rdim)); /* end of main iteration */ } while(k < $COMP(rdim)); /* end of main iteration */
} /* end of item do loop */ } /* end of item do loop */
EOD-EquivCPOffsCode EOD-EquivCPOffsCode
); );
=head2 rld
=cut
pp_def( pp_def(
'rld', 'rld',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Pars=>'indx a(n); b(n); [o]c(m);', Pars=>'indx a(n); b(n); [o]c(m);',
PMCode =><<'EOD', PMCode =><<'EOD',
sub PDL::rld { sub PDL::rld {
my ($x,$y) = @_; my ($x,$y) = @_;
my ($c); my ($c);
if ($#_ == 2) { if ($#_ == 2) {
$c = $_[2]; $c = $_[2];
skipping to change at line 1100 skipping to change at line 1091
=for example =for example
rld($x,$y,$c=null); rld($x,$y,$c=null);
=cut =cut
EOD EOD
); );
=head2 rle
=cut
pp_def( pp_def(
'rle', 'rle',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Pars=>'c(n); indx [o]a(m); [o]b(m);', Pars=>'c(n); indx [o]a(m); [o]b(m);',
RedoDimsCode=>'$SIZE(m)=$SIZE(n);', RedoDimsCode=>'$SIZE(m)=$SIZE(n);',
PMCode=><<'EOC', PMCode=><<'EOC',
sub PDL::rle { sub PDL::rle {
my $c = shift; my $c = shift;
my ($x,$y) = @_==2 ? @_ : (null,null); my ($x,$y) = @_==2 ? @_ : (null,null);
PDL::_rle_int($c,$x,$y); PDL::_rle_int($c,$x,$y);
skipping to change at line 1182 skipping to change at line 1170
($x, $x1) = (allaxisvals(($dmax) x $ndice)+1)->sumover->flat->qsort->rle; ($x, $x1) = (allaxisvals(($dmax) x $ndice)+1)->sumover->flat->qsort->rle;
$y = $x->cumusumover; $y = $x->cumusumover;
$yprob1x = $y->slice('-1:0')->double / $y->slice('(-1)'); $yprob1x = $y->slice('-1:0')->double / $y->slice('(-1)');
$z = cat($x1, 1 / $yprob1x**$nrolls)->transpose; $z = cat($x1, 1 / $yprob1x**$nrolls)->transpose;
=cut =cut
EOD EOD
); );
pp_def('rlevec',
Pars => "c(M,N); indx [o]a(N); [o]b(M,N)",
Code =><<'EOC',
PDL_Indx cn,bn=0, sn=$SIZE(N), matches;
loop (M) %{ $b(N=>0)=$c(N=>0); %}
$a(N=>0) = 1;
for (cn=1; cn<sn; cn++) {
matches=1;
loop (M) %{
if ($c(N=>cn) != $b(N=>bn)) {
matches=0;
break;
}
%}
if (matches) {
$a(N=>bn)++;
} else {
bn++;
loop (M) %{ $b(N=>bn) = $c(N=>cn); %}
$a(N=>bn) = 1;
}
}
for (bn++; bn<sn; bn++) {
$a(N=>bn) = 0;
loop (M) %{ $b(N=>bn) = 0; %}
}
EOC
Doc =><<'EOD',
=for ref
Run-length encode a set of vectors.
Higher-order rle(), for use with qsortvec().
Given set of vectors $c, generate a vector $a with the number of occurrences of
each element
(where an "element" is a vector of length $M ocurring in $c),
and a set of vectors $b containing the unique values.
As for rle(), only the elements up to the first instance of 0 in $a should be co
nsidered.
Can be used together with clump() to run-length encode "values" of arbitrary dim
ensions.
Can be used together with rotate(), cat(), append(), and qsortvec() to count N-g
rams
over a 1d PDL.
See also: L</rle>, L<PDL::Ufunc/qsortvec>, L<PDL::Primitive/uniqvec>
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD
);
pp_def('rldvec',
Pars => 'indx a(N); b(M,N); [o]c(M,N)',
PMCode=><<'EOC',
sub PDL::rldvec {
my ($a,$b,$c) = @_;
if (!defined($c)) {
# XXX Need to improve emulation of threading in auto-generating c
my ($rowlen) = $b->dim(0);
my ($size) = $a->sumover->max;
my (@dims) = $a->dims;
shift(@dims);
$c = $b->zeroes($b->type,$rowlen,$size,@dims);
}
&PDL::_rldvec_int($a,$b,$c);
return $c;
}
EOC
Code =><<'EOC',
PDL_Indx i,nrows,bn,cn=0, sn=$SIZE(N);
for (bn=0; bn<sn; bn++) {
nrows = $a(N=>bn);
for (i=0; i<nrows; i++) {
loop (M) %{ $c(N=>cn) = $b(N=>bn); %}
cn++;
}
}
EOC
Doc =><<'EOD'
=for ref
Run-length decode a set of vectors, akin to a higher-order rld().
Given a vector $a() of the number of occurrences of each row, and a set $c()
of row-vectors each of length $M, run-length decode to $c().
Can be used together with clump() to run-length decode "values" of arbitrary dim
ensions.
See also: L</rld>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD
);
pp_def('rleseq',
Pars => "c(N); indx [o]a(N); [o]b(N)",
Code=><<'EOC',
PDL_Indx j=0, sizeN=$SIZE(N);
$GENERIC(c) coff;
coff = $c(N=>0);
$b(N=>0) = coff;
$a(N=>0) = 0;
loop (N) %{
if ($c() == coff+$a(N=>j)) {
$a(N=>j)++;
} else {
j++;
$b(N=>j) = coff = $c();
$a(N=>j) = 1;
}
%}
for (j++; j<sizeN; j++) {
$a(N=>j) = 0;
$b(N=>j) = 0;
}
EOC
Doc =><<'EOD',
=for ref
Run-length encode a vector of subsequences.
Given a vector of $c() of concatenated variable-length, variable-offset subseque
nces,
generate a vector $a containing the length of each subsequence
and a vector $b containing the subsequence offsets.
As for rle(), only the elements up to the first instance of 0 in $a should be co
nsidered.
See also L</rle>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD
);
pp_def('rldseq',
Pars => 'indx a(N); b(N); [o]c(M)',
PMCode=><<'EOC',
sub PDL::rldseq {
my ($a,$b,$c) = @_;
if (!defined($c)) {
my $size = $a->sumover->max;
my (@dims) = $a->dims;
shift(@dims);
$c = $b->zeroes($b->type,$size,@dims);
}
&PDL::_rldseq_int($a,$b,$c);
return $c;
}
EOC
Code =><<'EOC',
size_t mi=0;
loop (N) %{
size_t len = $a(), li;
for (li=0; li < len; ++li, ++mi) {
$c(M=>mi) = $b() + li;
}
%}
EOC
Doc =><<'EOD'
=for ref
Run-length decode a subsequence vector.
Given a vector $a() of sequence lengths
and a vector $b() of corresponding offsets,
decode concatenation of subsequences to $c(),
as for:
$c = null;
$c = $c->append($b($_)+sequence($a->type,$a($_))) foreach (0..($N-1));
See also: L</rld>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD
);
pp_add_exported('','rleND rldND');
pp_addpm(<<'EOF');
=head2 rleND
=for sig
Signature: (data(@vdims,N); int [o]counts(N); [o]elts(@vdims,N))
=for ref
Run-length encode a set of (sorted) n-dimensional values.
Generalization of rle() and vv_rlevec():
given set of values $data, generate a vector $counts with the number of occurren
ces of each element
(where an "element" is a matrix of dimensions @vdims ocurring as a sequential ru
n over the
final dimension in $data), and a set of vectors $elts containing the elements wh
ich begin a run.
Really just a wrapper for clump() and rlevec().
See also: L</rle>, L</rlevec>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
=cut
*PDL::rleND = \&rleND;
sub rleND {
my $data = shift;
my @vdimsN = $data->dims;
##-- construct output pdls
my $counts = $#_ >= 0 ? $_[0] : zeroes(long, $vdimsN[$#vdimsN]);
my $elts = $#_ >= 1 ? $_[1] : zeroes($data->type, @vdimsN);
##-- guts: call rlevec()
rlevec($data->clump($#vdimsN), $counts, $elts->clump($#vdimsN));
return ($counts,$elts);
}
=head2 rldND
=for sig
Signature: (int counts(N); elts(@vdims,N); [o]data(@vdims,N);)
=for ref
Run-length decode a set of (sorted) n-dimensional values.
Generalization of rld() and rldvec():
given a vector $counts() of the number of occurrences of each @vdims-dimensioned
element,
and a set $elts() of @vdims-dimensioned elements, run-length decode to $data().
Really just a wrapper for clump() and rldvec().
See also: L</rld>, L</rldvec>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
=cut
*PDL::rldND = \&rldND;
sub rldND {
my ($counts,$elts) = (shift,shift);
my @vdimsN = $elts->dims;
##-- construct output pdl
my ($data);
if ($#_ >= 0) { $data = $_[0]; }
else {
my $size = $counts->sumover->max; ##-- get maximum size for Nth-dimensi
on for small encodings
my @countdims = $counts->dims;
shift(@countdims);
$data = zeroes($elts->type, @vdimsN, @countdims);
}
##-- guts: call rldvec()
rldvec($counts, $elts->clump($#vdimsN), $data->clump($#vdimsN));
return $data;
}
EOF
# the perl wrapper clump is now defined in Core.pm # the perl wrapper clump is now defined in Core.pm
# this is just the low level interface # this is just the low level interface
pp_def( pp_def(
'_clump_int', '_clump_int',
OtherPars => 'int n', OtherPars => 'PDL_Indx n',
P2Child => 1, P2Child => 1,
RedoDims => 'int i; PDL_Indx d1; RedoDims => 'PDL_Indx i, d1;
/* truncate overly long clumps to just clump existing dimensions */ /* truncate overly long clumps to just clump existing dimensions */
if($COMP(n) > $PARENT(ndims)) if($COMP(n) > $PDL(PARENT)->ndims)
$COMP(n) = $PARENT(ndims); $COMP(n) = $PDL(PARENT)->ndims;
if($COMP(n) < -1) if($COMP(n) < -1)
$COMP(n) = $PARENT(ndims) + $COMP(n) + 1; $COMP(n) = $PDL(PARENT)->ndims + $COMP(n) + 1;
PDL_Indx nrem = ($COMP(n) == -1 ? $PARENT(broadcastids[0]) : $C PDL_Indx nrem = ($COMP(n) == -1 ? $PDL(PARENT)->broadcastids[0]
OMP(n)); : $COMP(n));
$SETNDIMS($PARENT(ndims) - nrem + 1); $SETNDIMS($PDL(PARENT)->ndims - nrem + 1);
d1=1; d1=1;
for(i=0; i<nrem; i++) { for(i=0; i<nrem; i++) {
d1 *= $PARENT(dims[i]); d1 *= $PDL(PARENT)->dims[i];
} }
$CHILD(dims[0]) = d1; $PDL(CHILD)->dims[0] = d1;
for(; i<$PARENT(ndims); i++) { for(; i<$PDL(PARENT)->ndims; i++) {
$CHILD(dims[i-nrem+1]) = $PARENT(dims[i]); $PDL(CHILD)->dims[i-nrem+1] = $PDL(PARENT)->dims[i];
} }
$SETDIMS(); $SETDIMS();
$SETDELTABROADCASTIDS(1-nrem); $SETDELTABROADCASTIDS(1-nrem);
', ',
EquivCPOffsCode => ' EquivCPOffsCode => '
PDL_Indx i; PDL_Indx i;
for(i=0; i<$PDL(CHILD)->nvals; i++) { for(i=0; i<$PDL(CHILD)->nvals; i++) {
$EQUIVCPOFFS(i,i); $EQUIVCPOFFS(i,i);
} }
', ',
TwoWay => 1, TwoWay => 1,
Doc => 'internal', Doc => 'internal',
); );
=head2 xchg
=cut
pp_def( pp_def(
'xchg', 'xchg',
OtherPars => 'PDL_Indx n1; PDL_Indx n2;', OtherPars => 'PDL_Indx n1; PDL_Indx n2;',
TwoWay => 1, TwoWay => 1,
P2Child => 1, P2Child => 1,
AffinePriv => 1, AffinePriv => 1,
EquivDimCheck => 'if ($COMP(n1) <0) EquivDimCheck => 'if ($COMP(n1) <0)
$COMP(n1) += $PARENT(broadcastids[0]); $COMP(n1) += $PDL(PARENT)->broadcastids[0];
if ($COMP(n2) <0) if ($COMP(n2) <0)
$COMP(n2) += $PARENT(broadcastids[0]); $COMP(n2) += $PDL(PARENT)->broadcastids[0];
if (PDLMIN($COMP(n1),$COMP(n2)) <0 || if (PDLMIN($COMP(n1),$COMP(n2)) <0 ||
PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0])) PDLMAX($COMP(n1),$COMP(n2)) >= $PDL(PARENT)->broadcastids[0])
$CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"", $CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"",
$COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));', $COMP(n1),$COMP(n2),$PDL(PARENT)->broadcastids[0]);',
EquivPDimExpr => '(($CDIM == $COMP(n1)) ? $COMP(n2) : ($CDIM == $COMP(n2 )) ? $COMP(n1) : $CDIM)', EquivPDimExpr => '(($CDIM == $COMP(n1)) ? $COMP(n2) : ($CDIM == $COMP(n2 )) ? $COMP(n1) : $CDIM)',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
exchange two dimensions exchange two dimensions
Negative dimension indices count from the end. Negative dimension indices count from the end.
The command The command
skipping to change at line 1384 skipping to change at line 1620
} }
# Checking that they are all present and also not duplicated is done by broadcast() [I think] # Checking that they are all present and also not duplicated is done by broadcast() [I think]
# a quicker way to do the reorder # a quicker way to do the reorder
return $pdl->broadcast(@newDimOrder)->unbroadcast(0); return $pdl->broadcast(@newDimOrder)->unbroadcast(0);
} }
EOD EOD
=head2 mv
=cut
pp_addhdr(<<'EOF'); pp_addhdr(<<'EOF');
#define EQUIVDIM(dima,dimb,cdim,inc) \ #define EQUIVDIM(dima,dimb,cdim,inc) \
((cdim < PDLMIN(dima,dimb) || cdim > PDLMAX(dima,dimb)) ? \ ((cdim < PDLMIN(dima,dimb) || cdim > PDLMAX(dima,dimb)) ? \
cdim : ((cdim == dimb) ? dima : cdim + inc)) cdim : ((cdim == dimb) ? dima : cdim + inc))
EOF EOF
pp_def( pp_def(
'mv', 'mv',
OtherPars => 'PDL_Indx n1; PDL_Indx n2;', OtherPars => 'PDL_Indx n1; PDL_Indx n2;',
TwoWay => 1, TwoWay => 1,
P2Child => 1, P2Child => 1,
AffinePriv => 1, AffinePriv => 1,
EquivDimCheck => 'if ($COMP(n1) <0) EquivDimCheck => 'if ($COMP(n1) <0)
$COMP(n1) += $PARENT(broadcastids[0]); $COMP(n1) += $PDL(PARENT)->broadcastids[0];
if ($COMP(n2) <0) if ($COMP(n2) <0)
$COMP(n2) += $PARENT(broadcastids[0]); $COMP(n2) += $PDL(PARENT)->broadcastids[0];
if (PDLMIN($COMP(n1),$COMP(n2)) <0 || if (PDLMIN($COMP(n1),$COMP(n2)) <0 ||
PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0])) PDLMAX($COMP(n1),$COMP(n2)) >= $PDL(PARENT)->broadcastids[0])
$CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"", $CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"",
$COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));', $COMP(n1),$COMP(n2),$PDL(PARENT)->broadcastids[0]);',
EquivPDimExpr => '( EquivPDimExpr => '(
$COMP(n1) == $COMP(n2) ? $CDIM : $COMP(n1) == $COMP(n2) ? $CDIM :
$COMP(n1) < $COMP(n2) ? EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,1) : $COMP(n1) < $COMP(n2) ? EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,1) :
EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,-1) EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,-1)
)', )',
Doc => << 'EOD', Doc => << 'EOD',
=for ref =for ref
move a dimension to another position move a dimension to another position
skipping to change at line 1496 skipping to change at line 1729
TwoWay => 1, TwoWay => 1,
AffinePriv => 1, AffinePriv => 1,
OtherPars => 'PDL_Indx whichdims[]', OtherPars => 'PDL_Indx whichdims[]',
MakeComp => pp_line_numbers(__LINE__-1, ' MakeComp => pp_line_numbers(__LINE__-1, '
if ($COMP(whichdims_count) < 1) if ($COMP(whichdims_count) < 1)
$CROAK("must have at least 1 dimension"); $CROAK("must have at least 1 dimension");
qsort($COMP(whichdims), $COMP(whichdims_count), sizeof(PDL_Indx) , qsort($COMP(whichdims), $COMP(whichdims_count), sizeof(PDL_Indx) ,
cmp_pdll); cmp_pdll);
'), '),
RedoDims => pp_line_numbers(__LINE__-1, ' RedoDims => pp_line_numbers(__LINE__-1, '
int nthp,nthc,nthd; int cd = $COMP(whichdims[0]); PDL_Indx nthp,nthc,nthd, cd = $COMP(whichdims[0]);
$SETNDIMS($PARENT(ndims)-$COMP(whichdims_count)+1); $SETNDIMS($PDL(PARENT)->ndims-$COMP(whichdims_count)+1);
$DOPRIVALLOC(); $DOPRIVALLOC();
$PRIV(offs) = 0; $PRIV(offs) = 0;
if ($COMP(whichdims)[$COMP(whichdims_count)-1] >= $PARENT(ndims) || if ($COMP(whichdims)[$COMP(whichdims_count)-1] >= $PDL(PARENT)-> ndims ||
$COMP(whichdims)[0] < 0) $COMP(whichdims)[0] < 0)
$CROAK("dim out of range"); $CROAK("dim out of range");
nthd=0; nthc=0; nthd=0; nthc=0;
for(nthp=0; nthp<$PARENT(ndims); nthp++) for(nthp=0; nthp<$PDL(PARENT)->ndims; nthp++)
if (nthd < $COMP(whichdims_count) && if (nthd < $COMP(whichdims_count) &&
nthp == $COMP(whichdims)[nthd]) { nthp == $COMP(whichdims)[nthd]) {
if (!nthd) { if (!nthd) {
$CHILD(dims)[cd] = $PARENT(dims)[cd]; $PDL(CHILD)->dims[cd] = $PDL(PARENT)->di ms[cd];
nthc++; nthc++;
$PRIV(incs)[cd] = 0; $PRIV(incs)[cd] = 0;
} }
if (nthd && $COMP(whichdims)[nthd] == if (nthd && $COMP(whichdims)[nthd] ==
$COMP(whichdims)[nthd-1]) $COMP(whichdims)[nthd-1])
$CROAK("dims must be unique"); $CROAK("dims must be unique");
nthd++; /* advance pointer into whichdims */ nthd++; /* advance pointer into whichdims */
if($CHILD(dims)[cd] != if($PDL(CHILD)->dims[cd] !=
$PARENT(dims)[nthp]) { $PDL(PARENT)->dims[nthp]) {
$CROAK("Different dims %"IND_FLAG" and % "IND_FLAG"", $CROAK("Different dims %"IND_FLAG" and % "IND_FLAG"",
$CHILD(dims)[cd], $PDL(CHILD)->dims[cd],
$PARENT(dims)[nthp]); $PDL(PARENT)->dims[nthp]);
} }
$PRIV(incs)[cd] += $PARENT(dimincs)[nthp]; $PRIV(incs)[cd] += $PDL(PARENT)->dimincs[nthp];
} else { } else {
$PRIV(incs)[nthc] = $PARENT(dimincs)[nthp]; $PRIV(incs)[nthc] = $PDL(PARENT)->dimincs[nthp];
$CHILD(dims)[nthc] = $PARENT(dims)[nthp]; $PDL(CHILD)->dims[nthc] = $PDL(PARENT)->dims[nth
p];
nthc++; nthc++;
} }
$SETDIMS(); $SETDIMS();
'), '),
PMCode => << 'EOD', PMCode => << 'EOD',
sub PDL::diagonal { shift->_diagonal_int(my $o=PDL->null, \@_); $o } sub PDL::diagonal { shift->_diagonal_int(my $o=PDL->null, \@_); $o }
EOD EOD
Doc => << 'EOD', Doc => << 'EOD',
=for ref =for ref
skipping to change at line 1581 skipping to change at line 1814
[ [
[1 0 0] [1 0 0]
[0 1 0] [0 1 0]
[0 0 1] [0 0 1]
] ]
] ]
=cut =cut
EOD EOD
); );
=head2 lags
=cut
pp_def( pp_def(
'lags', 'lags',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
Returns an ndarray of lags to parent. Returns an ndarray of lags to parent.
Usage: Usage:
=for usage =for usage
skipping to change at line 1627 skipping to change at line 1857
in the usual way (-1 = last dim). in the usual way (-1 = last dim).
=cut =cut
EOD EOD
P2Child => 1, P2Child => 1,
TwoWay => 1, TwoWay => 1,
AffinePriv => 1, AffinePriv => 1,
OtherPars => join('', map "PDL_Indx $_;", qw(nthdim step n)), OtherPars => join('', map "PDL_Indx $_;", qw(nthdim step n)),
RedoDims => ' RedoDims => '
PDL_Indx i; PDL_Indx i;
if ($COMP(nthdim) < 0) /* the usual conventions */ if ($COMP(nthdim) < 0) /* the usual conventions */
$COMP(nthdim) += $PARENT(ndims); $COMP(nthdim) += $PDL(PARENT)->ndims;
if ($COMP(nthdim) < 0 || $COMP(nthdim) >= $PARENT(ndims)) if ($COMP(nthdim) < 0 || $COMP(nthdim) >= $PDL(PARENT)->ndims)
$CROAK("dim out of range"); $CROAK("dim out of range");
if ($COMP(n) < 1) if ($COMP(n) < 1)
$CROAK("number of lags must be positive"); $CROAK("number of lags must be positive");
if ($COMP(step) < 1) if ($COMP(step) < 1)
$CROAK("step must be positive"); $CROAK("step must be positive");
$PRIV(offs) = 0; $PRIV(offs) = 0;
$SETNDIMS($PARENT(ndims)+1); $SETNDIMS($PDL(PARENT)->ndims+1);
$DOPRIVALLOC(); $DOPRIVALLOC();
for(i=0; i<$COMP(nthdim); i++) { for(i=0; i<$COMP(nthdim); i++) {
$CHILD(dims)[i] = $PARENT(dims)[i]; $PDL(CHILD)->dims[i] = $PDL(PARENT)->dims[i];
$PRIV(incs)[i] = $PARENT(dimincs)[i]; $PRIV(incs)[i] = $PDL(PARENT)->dimincs[i];
} }
$CHILD(dims)[i] = $PARENT(dims)[i] - $COMP(step) * ($COMP(n)-1); $PDL(CHILD)->dims[i] = $PDL(PARENT)->dims[i] - $COMP(step) * ($C
if ($CHILD(dims)[i] < 1) OMP(n)-1);
if ($PDL(CHILD)->dims[i] < 1)
$CROAK("product of step size and number of lags too large"); $CROAK("product of step size and number of lags too large");
$CHILD(dims)[i+1] = $COMP(n); $PDL(CHILD)->dims[i+1] = $COMP(n);
$PRIV(incs)[i] = ($PARENT(dimincs)[i]); $PRIV(incs)[i] = ($PDL(PARENT)->dimincs[i]);
$PRIV(incs)[i+1] = - $PARENT(dimincs)[i] * $COMP(step); $PRIV(incs)[i+1] = - $PDL(PARENT)->dimincs[i] * $COMP(step);
$PRIV(offs) += ($CHILD(dims)[i+1] - 1) * (-$PRIV(incs)[i+1]); $PRIV(offs) += ($PDL(CHILD)->dims[i+1] - 1) * (-$PRIV(incs)[i+1]
);
i++; i++;
for(; i<$PARENT(ndims); i++) { for(; i<$PDL(PARENT)->ndims; i++) {
$CHILD(dims)[i+1] = $PARENT(dims)[i]; $PDL(CHILD)->dims[i+1] = $PDL(PARENT)->dims[i];
$PRIV(incs)[i+1] = $PARENT(dimincs)[i]; $PRIV(incs)[i+1] = $PDL(PARENT)->dimincs[i];
} }
$SETDIMS(); $SETDIMS();
' '
); );
=head2 splitdim
=cut
pp_def( pp_def(
'splitdim', 'splitdim',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
Splits a dimension in the parent ndarray (opposite of L<clump|PDL::Core/clump>). Splits a dimension in the parent ndarray (opposite of L<clump|PDL::Core/clump>).
As of 2.076, throws exception if non-divisible C<nsp> given, and can As of 2.076, throws exception if non-divisible C<nsp> given, and can
give negative C<nthdim> which then counts backwards. give negative C<nthdim> which then counts backwards.
=for example =for example
skipping to change at line 1691 skipping to change at line 1918
EOD EOD
P2Child => 1, P2Child => 1,
TwoWay => 1, TwoWay => 1,
OtherPars => join('', map "PDL_Indx $_;", qw(nthdim nsp)), OtherPars => join('', map "PDL_Indx $_;", qw(nthdim nsp)),
AffinePriv => 1, AffinePriv => 1,
RedoDims => ' RedoDims => '
PDL_Indx i = $COMP(nthdim); PDL_Indx i = $COMP(nthdim);
PDL_Indx nsp = $COMP(nsp); PDL_Indx nsp = $COMP(nsp);
if(nsp == 0) {$CROAK("Cannot split to 0\n");} if(nsp == 0) {$CROAK("Cannot split to 0\n");}
if (i < 0) if (i < 0)
i = $COMP(nthdim) += $PARENT(ndims); i = $COMP(nthdim) += $PDL(PARENT)->ndims;
if (i < 0 || i >= $PARENT(ndims)) if (i < 0 || i >= $PDL(PARENT)->ndims)
$CROAK("nthdim %"IND_FLAG" after adjusting for negative must not be negative or greater or equal to number of dims %"IND_FLAG"\n", $CROAK("nthdim %"IND_FLAG" after adjusting for negative must not be negative or greater or equal to number of dims %"IND_FLAG"\n",
i, $PARENT(ndims)); i, $PDL(PARENT)->ndims);
if (nsp > $PARENT(dims[i])) if (nsp > $PDL(PARENT)->dims[i])
$CROAK("nsp %"IND_FLAG" cannot be greater than dim %"IND _FLAG"\n", $CROAK("nsp %"IND_FLAG" cannot be greater than dim %"IND _FLAG"\n",
nsp, $PARENT(dims[i])); nsp, $PDL(PARENT)->dims[i]);
if (($PARENT(dims)[i] % nsp) != 0) if (($PDL(PARENT)->dims[i] % nsp) != 0)
$CROAK("nsp %"IND_FLAG" non-divisible into dim %"IND_FLA G"\n", $CROAK("nsp %"IND_FLAG" non-divisible into dim %"IND_FLA G"\n",
nsp, $PARENT(dims[i])); nsp, $PDL(PARENT)->dims[i]);
$PRIV(offs) = 0; $PRIV(offs) = 0;
$SETNDIMS($PARENT(ndims)+1); $SETNDIMS($PDL(PARENT)->ndims+1);
$DOPRIVALLOC(); $DOPRIVALLOC();
for(i=0; i<$COMP(nthdim); i++) { for(i=0; i<$COMP(nthdim); i++) {
$CHILD(dims)[i] = $PARENT(dims)[i]; $PDL(CHILD)->dims[i] = $PDL(PARENT)->dims[i];
$PRIV(incs)[i] = $PARENT(dimincs)[i]; $PRIV(incs)[i] = $PDL(PARENT)->dimincs[i];
} }
$CHILD(dims)[i] = $COMP(nsp); $PDL(CHILD)->dims[i] = $COMP(nsp);
$CHILD(dims)[i+1] = $PARENT(dims)[i] / $COMP(nsp); $PDL(CHILD)->dims[i+1] = $PDL(PARENT)->dims[i] / $COMP(nsp);
$PRIV(incs)[i] = $PARENT(dimincs)[i]; $PRIV(incs)[i] = $PDL(PARENT)->dimincs[i];
$PRIV(incs)[i+1] = $PARENT(dimincs)[i] * $COMP(nsp); $PRIV(incs)[i+1] = $PDL(PARENT)->dimincs[i] * $COMP(nsp);
i++; i++;
for(; i<$PARENT(ndims); i++) { for(; i<$PDL(PARENT)->ndims; i++) {
$CHILD(dims)[i+1] = $PARENT(dims)[i]; $PDL(CHILD)->dims[i+1] = $PDL(PARENT)->dims[i];
$PRIV(incs)[i+1] = $PARENT(dimincs)[i]; $PRIV(incs)[i+1] = $PDL(PARENT)->dimincs[i];
} }
$SETDIMS(); $SETDIMS();
', ',
); );
my $rotate_code = ' my $rotate_code = '
PDL_Indx i,j; PDL_Indx i,j;
PDL_Indx n_size = $SIZE(n); PDL_Indx n_size = $SIZE(n);
if (n_size == 0) if (n_size == 0)
$CROAK("can not shift zero size ndarray (n_size is zero)"); $CROAK("can not shift zero size ndarray (n_size is zero)");
skipping to change at line 1792 skipping to change at line 2019
$CROAK("duplicate arg %"IND_FLAG" %"IND_FLAG" %" IND_FLAG"", $CROAK("duplicate arg %"IND_FLAG" %"IND_FLAG" %" IND_FLAG"",
i,j,$COMP(whichdims[i])); i,j,$COMP(whichdims[i]));
} }
if($COMP(whichdims)[i] != -1) { if($COMP(whichdims)[i] != -1) {
$COMP(nrealwhichdims) ++; $COMP(nrealwhichdims) ++;
} }
} }
', ',
RedoDims => ' RedoDims => '
PDL_Indx nthc,i,j,flag; PDL_Indx nthc,i,j,flag;
$SETNDIMS($PARENT(ndims)); $SETNDIMS($PDL(PARENT)->ndims);
$DOPRIVALLOC(); $DOPRIVALLOC();
$PRIV(offs) = 0; $PRIV(offs) = 0;
nthc=0; nthc=0;
for(i=0; i<$PARENT(ndims); i++) { for(i=0; i<$PDL(PARENT)->ndims; i++) {
flag=0; flag=0;
if($PARENT(nbroadcastids) > $COMP(id) && $COMP(id) >= 0 if($PDL(PARENT)->nbroadcastids > $COMP(id) && $COMP(id)
&& >= 0 &&
i == $PARENT(broadcastids[$COMP(id)])) { i == $PDL(PARENT)->broadcastids[$COMP(id])) {
nthc += $COMP(whichdims_count); nthc += $COMP(whichdims_count);
} }
for(j=0; j<$COMP(whichdims_count); j++) { for(j=0; j<$COMP(whichdims_count); j++) {
if($COMP(whichdims[j] == i)) {flag=1; break;} if($COMP(whichdims[j] == i)) {flag=1; break;}
} }
if(flag) { if(flag) {
continue; continue;
} }
$CHILD(dims[nthc]) = $PARENT(dims[i]); $PDL(CHILD)->dims[nthc] = $PDL(PARENT)->dims[i];
$PRIV(incs[nthc]) = $PARENT(dimincs[i]); $PRIV(incs[nthc]) = $PDL(PARENT)->dimincs[i];
nthc++; nthc++;
} }
for(i=0; i<$COMP(whichdims_count); i++) { for(i=0; i<$COMP(whichdims_count); i++) {
int cdim,pdim; PDL_Indx cdim,pdim;
cdim = i + cdim = i +
($PARENT(nbroadcastids) > $COMP(id) && $COMP(id) >= 0? ($PDL(PARENT)->nbroadcastids > $COMP(id) && $COMP(id) >
$PARENT(broadcastids[$COMP(id)]) : $PARENT(ndims)) = 0?
$PDL(PARENT)->broadcastids[$COMP(id)] : $PDL(PARENT)->
ndims)
- $COMP(nrealwhichdims); - $COMP(nrealwhichdims);
pdim = $COMP(whichdims[i]); pdim = $COMP(whichdims[i]);
if(pdim == -1) { if(pdim == -1) {
$CHILD(dims[cdim]) = 1; $PDL(CHILD)->dims[cdim] = 1;
$PRIV(incs[cdim]) = 0; $PRIV(incs[cdim]) = 0;
} else { } else {
$CHILD(dims[cdim]) = $PARENT(dims[pdim]); $PDL(CHILD)->dims[cdim] = $PDL(PARENT)->dims[pdi
$PRIV(incs[cdim]) = $PARENT(dimincs[pdim]); m];
$PRIV(incs[cdim]) = $PDL(PARENT)->dimincs[pdim];
} }
} }
$SETDIMS(); $SETDIMS();
PDL_RETERROR(PDL_err, PDL->reallocbroadcastids($CHILD_PTR(), PDL_RETERROR(PDL_err, PDL->reallocbroadcastids($PDL(CHILD),
PDLMAX($COMP(id)+1, $PARENT(nbroadcastids)))); PDLMAX($COMP(id)+1, $PDL(PARENT)->nbroadcastids)
for(i=0; i<$CHILD(nbroadcastids)-1; i++) { ));
$CHILD(broadcastids[i]) = for(i=0; i<$PDL(CHILD)->nbroadcastids-1; i++) {
($PARENT(nbroadcastids) > i ? $PDL(CHILD)->broadcastids[i] =
$PARENT(broadcastids[i]) : $PARENT(ndims)) + ($PDL(PARENT)->nbroadcastids > i ?
$PDL(PARENT)->broadcastids[i] : $PDL(PARENT)->ndims) +
(i <= $COMP(id) ? - $COMP(nrealwhichdims) : (i <= $COMP(id) ? - $COMP(nrealwhichdims) :
$COMP(whichdims_count) - $COMP(nrealwhichdims)); $COMP(whichdims_count) - $COMP(nrealwhichdims));
} }
$CHILD(broadcastids[$CHILD(nbroadcastids)-1]) = $CHILD(ndims); $PDL(CHILD)->broadcastids[$PDL(CHILD)->nbroadcastids-1] = $PDL(C HILD)->ndims;
', ',
); );
=head2 unbroadcast
=cut
pp_def( pp_def(
'unbroadcast', 'unbroadcast',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
All broadcasted dimensions are made real again. All broadcasted dimensions are made real again.
See [TBD Doc] for details and examples. See [TBD Doc] for details and examples.
=cut =cut
EOD EOD
P2Child => 1, P2Child => 1,
TwoWay => 1, TwoWay => 1,
AffinePriv => 1, AffinePriv => 1,
OtherPars => 'int atind;', OtherPars => 'PDL_Indx atind;',
RedoDims => ' RedoDims => '
int i; PDL_Indx i;
$SETNDIMS($PARENT(ndims)); $SETNDIMS($PDL(PARENT)->ndims);
$DOPRIVALLOC(); $DOPRIVALLOC();
$PRIV(offs) = 0; $PRIV(offs) = 0;
for(i=0; i<$PARENT(ndims); i++) { for(i=0; i<$PDL(PARENT)->ndims; i++) {
int corc; PDL_Indx corc;
if(i<$COMP(atind)) { if(i<$COMP(atind)) {
corc = i; corc = i;
} else if(i < $PARENT(broadcastids[0])) { } else if(i < $PDL(PARENT)->broadcastids[0]) {
corc = i + $PARENT(ndims)-$PARENT(broadcastids[0 corc = i + $PDL(PARENT)->ndims-$PDL(PARENT)->bro
]); adcastids[0];
} else { } else {
corc = i - $PARENT(broadcastids[0]) + $COMP(atin d); corc = i - $PDL(PARENT)->broadcastids[0] + $COMP (atind);
} }
$CHILD(dims[corc]) = $PARENT(dims[i]); $PDL(CHILD)->dims[corc] = $PDL(PARENT)->dims[i];
$PRIV(incs[corc]) = $PARENT(dimincs[i]); $PRIV(incs[corc]) = $PDL(PARENT)->dimincs[i];
} }
$SETDIMS(); $SETDIMS();
', ',
); );
pp_add_exported('', 'dice dice_axis'); pp_add_exported('', 'dice dice_axis');
pp_addpm(<<'EOD'); pp_addpm(<<'EOD');
=head2 dice =head2 dice
skipping to change at line 2248 skipping to change at line 2472
# Comp stash definitions: # Comp stash definitions:
# nargs - number of args in original call # nargs - number of args in original call
# odim[] - maps argno to output dim (or -1 for squished dims) # odim[] - maps argno to output dim (or -1 for squished dims)
# idim[] - maps argno to input dim (or -1 for dummy dims) # idim[] - maps argno to input dim (or -1 for dummy dims)
# odim_top - one more than the highest odim encountered # odim_top - one more than the highest odim encountered
# idim_top - one more than the highest idim encountered # idim_top - one more than the highest idim encountered
# start[] - maps argno to start index of slice range (inclusive) # start[] - maps argno to start index of slice range (inclusive)
# inc[] - maps argno to increment of slice range # inc[] - maps argno to increment of slice range
# end[] - maps argno to end index of slice range (inclusive) # end[] - maps argno to end index of slice range (inclusive)
# #
Comp => 'int nargs; Comp => 'PDL_Indx nargs;
PDL_Indx odim[$COMP(nargs)]; PDL_Indx odim[$COMP(nargs)];
PDL_Indx idim[$COMP(nargs)]; PDL_Indx idim[$COMP(nargs)];
PDL_Indx idim_top; PDL_Indx idim_top;
PDL_Indx odim_top; PDL_Indx odim_top;
PDL_Indx start[$COMP(nargs)]; PDL_Indx start[$COMP(nargs)];
PDL_Indx inc[$COMP(nargs)]; PDL_Indx inc[$COMP(nargs)];
PDL_Indx end[$COMP(nargs)]; PDL_Indx end[$COMP(nargs)];
', ',
AffinePriv => 1, AffinePriv => 1,
TwoWay => 1, TwoWay => 1,
MakeComp => <<'SLICE-MC' MakeComp => <<'SLICE-MC'
int nargs = 0; PDL_Indx nargs = 0;
pdl_slice_args *argsptr = arglist; pdl_slice_args *argsptr = arglist;
while (argsptr) nargs++, argsptr = argsptr->next; while (argsptr) nargs++, argsptr = argsptr->next;
$COMP(nargs) = nargs; $COMP(nargs) = nargs;
$DOCOMPALLOC(); $DOCOMPALLOC();
int i; PDL_Indx i, idim, odim, imax;
PDL_Indx idim, odim, imax;
argsptr = arglist; argsptr = arglist;
for(odim=idim=i=0; i<nargs; i++) { for(odim=idim=i=0; i<nargs; i++) {
/* Copy parsed values into the limits */ /* Copy parsed values into the limits */
$COMP(start)[i] = argsptr->start; $COMP(start)[i] = argsptr->start;
$COMP(end)[i] = argsptr->end; $COMP(end)[i] = argsptr->end;
$COMP(inc)[i] = argsptr->inc; $COMP(inc)[i] = argsptr->inc;
/* Deal with dimensions */ /* Deal with dimensions */
$COMP(odim)[i] = argsptr->squish ? -1 : odim++; $COMP(odim)[i] = argsptr->squish ? -1 : odim++;
$COMP(idim)[i] = argsptr->dummy ? -1 : idim++; $COMP(idim)[i] = argsptr->dummy ? -1 : idim++;
argsptr = argsptr->next; argsptr = argsptr->next;
} /* end of arg-parsing loop */ } /* end of arg-parsing loop */
$COMP(idim_top) = idim; $COMP(idim_top) = idim;
$COMP(odim_top) = odim; $COMP(odim_top) = odim;
SLICE-MC SLICE-MC
, ,
RedoDims => q{ RedoDims => q{
PDL_Indx i; PDL_Indx i;
PDL_Indx PDIMS; PDL_Indx PDIMS;
int o_ndims_extra = PDLMAX(0, $PARENT(ndims) - $COMP(idim_top) ); PDL_Indx o_ndims_extra = PDLMAX(0, $PDL(PARENT)->ndims - $COMP (idim_top));
/* slurped dims from the arg parsing, plus any extra broadcast dims */ /* slurped dims from the arg parsing, plus any extra broadcast dims */
$SETNDIMS( $COMP(odim_top) + o_ndims_extra ); $SETNDIMS( $COMP(odim_top) + o_ndims_extra );
$DOPRIVALLOC(); $DOPRIVALLOC();
$PRIV(offs) = 0; /* Offset vector to start of slice */ $PRIV(offs) = 0; /* Offset vector to start of slice */
for(i=0; i<$COMP(nargs); i++) { for(i=0; i<$COMP(nargs); i++) {
/** Belt-and-suspenders **/ /** Belt-and-suspenders **/
if( ($COMP(idim[i]) < 0) && ($COMP(odim[i]) < 0) ) { if( ($COMP(idim[i]) < 0) && ($COMP(odim[i]) < 0) ) {
PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0); PDL->changed($PDL(CHILD), PDL_PARENTDIMSCHANGED, 0);
$CROAK("Hmmm, both dummy and squished -- this can never happen. I quit."); $CROAK("Hmmm, both dummy and squished -- this can never happen. I quit.");
} }
/** First handle dummy dims since there's no input from th e parent **/ /** First handle dummy dims since there's no input from th e parent **/
if( $COMP(idim[i]) < 0 ) { if( $COMP(idim[i]) < 0 ) {
/* dummy dim - offset or diminc. */ /* dummy dim - offset or diminc. */
$CHILD( dims[ $COMP(odim[i]) ] ) = $COMP(end[i]) - $COM P(start[i]) + 1; $PDL(CHILD)->dims[ $COMP(odim[i]) ] = $COMP(end[i]) - $ COMP(start[i]) + 1;
$PRIV( incs[ $COMP(odim[i]) ] ) = 0; $PRIV( incs[ $COMP(odim[i]) ] ) = 0;
} else { } else {
/** This is not a dummy dim -- deal with a regular slice along it. **/ /** This is not a dummy dim -- deal with a regular slice along it. **/
/** Get parent dim size for this idim, and/or allow perm issive slicing **/ /** Get parent dim size for this idim, and/or allow perm issive slicing **/
PDL_Indx pdsize = $COMP(idim[i]) < $PARENT(ndims) ? PDL_Indx pdsize = $COMP(idim[i]) < $PDL(PARENT)->ndims ?
$PARENT(dims)[$COMP(idim)[i]] : 1; $PDL(PARENT)->dims[$COMP(idim)[i]] : 1;
PDL_Indx start = $COMP(start)[i]; PDL_Indx start = $COMP(start)[i];
PDL_Indx end = $COMP(end)[i]; PDL_Indx end = $COMP(end)[i];
if( if(
/** Trap special case: full slices of an empty dim are empty **/ /** Trap special case: full slices of an empty dim are empty **/
(pdsize==0 && start==0 && end==-1 && $COMP(inc[i]) == 0) (pdsize==0 && start==0 && end==-1 && $COMP(inc[i]) == 0)
|| ||
/* the values given when PDL::slice gets empty ndarray for index */ /* the values given when PDL::slice gets empty ndarray for index */
(start==1 && end==0 && $COMP(inc[i]) == 1) (start==1 && end==0 && $COMP(inc[i]) == 1)
) { ) {
$CHILD(dims)[$COMP(odim)[i]] = 0; $PDL(CHILD)->dims[$COMP(odim)[i]] = 0;
$PRIV(incs)[$COMP(odim)[i]] = 0; $PRIV(incs)[$COMP(odim)[i]] = 0;
} else { } else {
/** Regularize and bounds-check the start location **/ /** Regularize and bounds-check the start location **/
if(start < 0) if(start < 0)
start += pdsize; start += pdsize;
if( start < 0 || start >= pdsize ) { if( start < 0 || start >= pdsize ) {
PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0); PDL->changed($PDL(CHILD), PDL_PARENTDIMSCHANGED, 0);
if(i >= $PARENT( ndims )) { if(i >= $PDL(PARENT)->ndims) {
$CROAK("slice has too many dims (indexes dim %"IND_ $CROAK("slice has too many dims (indexes dim %"IND_
FLAG"; highest is %"IND_FLAG")",i,$PARENT( ndims )-1); FLAG"; highest is %"IND_FLAG")",i,$PDL(PARENT)->ndims-1);
} else { } else {
$CROAK("slice starts out of bounds in pos %"IND_FLAG" ( start is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,start,$CO MP(idim[i]),pdsize-1); $CROAK("slice starts out of bounds in pos %"IND_FLAG" ( start is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,start,$CO MP(idim[i]),pdsize-1);
} }
} }
if( $COMP(odim[i]) < 0) { if( $COMP(odim[i]) < 0) {
/* squished dim - just update the offset. */ /* squished dim - just update the offset. */
/* start is always defined and regularized if we are here here, since */ /* start is always defined and regularized if we are here here, since */
/* both idim[i] and odim[i] can't be <0 */ /* both idim[i] and odim[i] can't be <0 */
$PRIV(offs) += start * $PARENT( dimincs[ $COMP(idim[i ]) ] ); $PRIV(offs) += start * $PDL(PARENT)->dimincs[ $COMP(i dim[i]) ];
} else /* normal operation */ { } else /* normal operation */ {
/** Regularize and bounds-check the end location **/ /** Regularize and bounds-check the end location **/
if(end<0) end += pdsize; if(end<0) end += pdsize;
if( end < 0 || end >= pdsize ) { if( end < 0 || end >= pdsize ) {
PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0 ); PDL->changed($PDL(CHILD), PDL_PARENTDIMSCHANGED, 0) ;
$CROAK("slice ends out of bounds in pos %"IND_FLAG" (end is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,end,$COMP (idim[i]),pdsize-1); $CROAK("slice ends out of bounds in pos %"IND_FLAG" (end is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,end,$COMP (idim[i]),pdsize-1);
} }
/* regularize inc */ /* regularize inc */
PDL_Indx inc = $COMP(inc)[i]; PDL_Indx inc = $COMP(inc)[i];
if(!inc) if(!inc)
inc = (start <= end) ? 1 : -1; inc = (start <= end) ? 1 : -1;
$CHILD( dims )[ $COMP(odim)[i] ] = PDLMAX(0, (end - s $PDL(CHILD)->dims[ $COMP(odim)[i] ] = PDLMAX(0, (end
tart + inc) / inc); - start + inc) / inc);
$PRIV( incs )[ $COMP(odim)[i] ] = $PARENT(dimincs)[ $PRIV( incs )[ $COMP(odim)[i] ] = $PDL(PARENT)->dimi
$COMP(idim)[i] ] * inc; ncs[ $COMP(idim)[i] ] * inc;
$PRIV(offs) += start * $PARENT( dimincs )[ $COMP(idim $PRIV(offs) += start * $PDL(PARENT)->dimincs[ $COMP(i
)[i] ]; dim)[i] ];
} /* end of normal slice case */ } /* end of normal slice case */
} /* end of trapped strange slice case */ } /* end of trapped strange slice case */
} /* end of non-dummy slice case */ } /* end of non-dummy slice case */
} /* end of nargs loop */ } /* end of nargs loop */
/* Now fill in broadcast dimensions as needed. idim and odim persist from the parsing loop */ /* Now fill in broadcast dimensions as needed. idim and odim persist from the parsing loop */
/* up above. */ /* up above. */
for(i=0; i<o_ndims_extra; i++) { for(i=0; i<o_ndims_extra; i++) {
$CHILD(dims)[ $COMP(odim_top) + i ] = $PARENT(dims)[ $COMP(i $PDL(CHILD)->dims[ $COMP(odim_top) + i ] = $PDL(PARENT)->dim
dim_top) + i ]; s[ $COMP(idim_top) + i ];
$PRIV(incs)[ $COMP(odim_top) + i ] = $PARENT(dimincs)[ $COMP $PRIV(incs)[ $COMP(odim_top) + i ] = $PDL(PARENT)->dimincs[
(idim_top) + i ]; $COMP(idim_top) + i ];
} }
$SETDIMS(); $SETDIMS();
} # end of RedoDims for slice } # end of RedoDims for slice
); );
pp_addpm({At => 'Bot'},<< 'EOD'); pp_addpm({At => 'Bot'},<< 'EOD');
=head1 BUGS =head1 BUGS
 End of changes. 87 change blocks. 
163 lines changed or deleted 405 lines changed or added

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