"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Ufunc/ufunc.pd" between
PDL-2.077.tar.gz and PDL-2.078.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

ufunc.pd  (PDL-2.077):ufunc.pd  (PDL-2.078)
skipping to change at line 477 skipping to change at line 477
for ways of masking NaNs. for ways of masking NaNs.
', ',
); );
synonym("${name}_n_ind", "${synonym}_n_ind"); synonym("${name}_n_ind", "${synonym}_n_ind");
} # foreach: $which } # foreach: $which
pp_def( pp_def(
'minmaximum', 'minmaximum',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); [o]cmin(); [o] cmax(); indx [o]cmin_ind(); indx [o]cmax_in d();', Pars => 'a(n); [o]cmin(); [o] cmax(); indx [o]cmin_ind(); indx [o]cmax_in d();',
CopyBadStatusCode => '',
Code => Code =>
'$GENERIC() curmin = 0, curmax = 0; /* Handle null ndarray --CED */ '$GENERIC() curmin = 0, curmax = 0; /* Handle null ndarray --CED */
PDL_Indx curmin_ind = 0, curmax_ind = 0;
loop(n) %{
if ( !n ) {
curmin = curmax = $a();
curmin_ind = curmax_ind = n;
} else {
if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; }
if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; }
}
%}
$cmin() = curmin; $cmin_ind() = curmin_ind;
$cmax() = curmax; $cmax_ind() = curmax_ind;',
CopyBadStatusCode => '',
BadCode =>
'$GENERIC() curmin = 0, curmax = 0;
PDL_Indx curmin_ind = 0, curmax_ind = 0; int flag = 0; PDL_Indx curmin_ind = 0, curmax_ind = 0; int flag = 0;
loop(n) %{ loop(n) %{
if ( $ISGOOD(a()) ) { PDL_IF_BAD(if ( $ISGOOD(a()) ),) {
if ( !flag ) { if ( !flag ) {
curmin = curmax = $a(); curmin = curmax = $a();
curmin_ind = curmax_ind = n; curmin_ind = curmax_ind = n;
flag = 1; flag = 1;
} else { } else {
if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; } if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; }
if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; } if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; }
} }
} /* ISGOOD */ } /* ISGOOD */
%} %}
if ( flag ) { /* Handle null ndarray */ PDL_IF_BAD(if ( !flag ) { /* Handle null ndarray */
$cmin() = curmin; $cmin_ind() = curmin_ind;
$cmax() = curmax; $cmax_ind() = curmax_ind;
} else {
$SETBAD(cmin()); $SETBAD(cmin_ind()); $SETBAD(cmin()); $SETBAD(cmin_ind());
$SETBAD(cmax()); $SETBAD(cmax_ind()); $SETBAD(cmax()); $SETBAD(cmax_ind());
$PDLSTATESETBAD(cmin); $PDLSTATESETBAD(cmin_ind); $PDLSTATESETBAD(cmin); $PDLSTATESETBAD(cmin_ind);
$PDLSTATESETBAD(cmax); $PDLSTATESETBAD(cmax_ind); $PDLSTATESETBAD(cmax); $PDLSTATESETBAD(cmax_ind);
} else,) {
$cmin() = curmin; $cmin_ind() = curmin_ind;
$cmax() = curmax; $cmax_ind() = curmax_ind;
}', }',
Doc => Doc =>
' '
=for ref =for ref
Find minimum and maximum and their indices for a given ndarray; Find minimum and maximum and their indices for a given ndarray;
=for usage =for usage
pdl> $x=pdl [[-2,3,4],[1,0,3]] pdl> $x=pdl [[-2,3,4],[1,0,3]]
skipping to change at line 804 skipping to change at line 788
sub generic_qsortvec { sub generic_qsortvec {
my $pdl = shift; my $pdl = shift;
my $ndim = shift; my $ndim = shift;
'pdl_qsortvec_$PPSYM() ($P(' . $pdl . '), '. $ndim.', 0, nn);'; 'pdl_qsortvec_$PPSYM() ($P(' . $pdl . '), '. $ndim.', 0, nn);';
} }
# when copying the data over to the temporary array, # when copying the data over to the temporary array,
# ignore the bad values and then only send the number # ignore the bad values and then only send the number
# of good elements to the sort routines # of good elements to the sort routines
# should use broadcastloop ? # should use broadcastloop ?
my $copy_to_temp_good = ' my $copy_to_temp = '
PDL_Indx nn, nn1; if ($PDL(a)->nvals == 0)
loop(n) %{ $tmp() = $a(); %} $CROAK("cannot process empty ndarray");
nn = $SIZE(n)-1; ' . PDL_Indx nn = PDL_IF_BAD(0,$SIZE(n)-1);
generic_qsort('tmp');
my $copy_to_temp_bad = '
register PDL_Indx nn = 0;
loop(n) %{ loop(n) %{
if ( $ISGOOD(a()) ) { $tmp(n=>nn) = $a(); nn++; } PDL_IF_BAD(if ( $ISGOOD(a()) ) { $tmp(n=>nn) = $a(); nn++; },
$tmp() = $a();)
%} %}
if ( nn == 0 ) { PDL_IF_BAD(if ( nn == 0 ) {
$SETBAD(b()); $SETBAD(b());
} else { } else {
'; nn -= 1;,{)
' . generic_qsort('tmp');
my $find_median_average = ' my $find_median_average = '
nn1 = nn/2; nn2 = nn1+1; PDL_Indx nn1 = nn/2, nn2 = nn1+1;
if (nn%2==0) { if (nn%2==0) {
$b() = $tmp(n => nn1); $b() = $tmp(n => nn1);
} }
else { else {
$b() = 0.5*( $tmp(n => nn1) + $tmp(n => nn2) ); $b() = 0.5*( $tmp(n => nn1) + $tmp(n => nn2) );
}'; }';
my $find_median_lower = '
nn1 = nn/2;
$b() = $tmp(n => nn1);';
pp_def( pp_def(
'medover', 'medover',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); [o]b(); [t]tmp(n);', Pars => 'a(n); [o]b(); [t]tmp(n);',
Doc => projectdocs('median','medover',''), Doc => projectdocs('median','medover',''),
Code => Code => $copy_to_temp . $find_median_average . '}',
"PDL_Indx nn2;\n" . $copy_to_temp_good . $find_median_average,
BadCode =>
$copy_to_temp_bad .
' PDL_Indx nn1, nn2;
nn -= 1; ' .
generic_qsort('tmp') .
$find_median_average . '}',
); # pp_def: medover ); # pp_def: medover
my $find_median_lower = '
PDL_Indx nn1 = nn/2;
$b() = $tmp(n => nn1);';
pp_def( pp_def(
'oddmedover', 'oddmedover',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); [o]b(); [t]tmp(n);', Pars => 'a(n); [o]b(); [t]tmp(n);',
Doc => projectdocs('oddmedian','oddmedover',' Doc => projectdocs('oddmedian','oddmedover','
The median is sometimes not a good choice as if the array has The median is sometimes not a good choice as if the array has
an even number of elements it lies half-way between the two an even number of elements it lies half-way between the two
middle values - thus it does not always correspond to a data middle values - thus it does not always correspond to a data
value. The lower-odd median is just the lower of these two values value. The lower-odd median is just the lower of these two values
and so it ALWAYS sits on an actual data value which is useful in and so it ALWAYS sits on an actual data value which is useful in
some circumstances. some circumstances.
'), '),
Code => Code => $copy_to_temp . $find_median_lower . '}',
$copy_to_temp_good . $find_median_lower,
BadCode =>
$copy_to_temp_bad .
' PDL_Indx nn1;
nn -= 1; '.
$find_median_lower . '}',
); # pp_def: oddmedover ); # pp_def: oddmedover
pp_def('modeover', pp_def('modeover',
HandleBad=>undef, HandleBad=>undef,
Pars => 'data(n); [o]out(); [t]sorted(n);', Pars => 'data(n); [o]out(); [t]sorted(n);',
GenericTypes=>$T, GenericTypes=>$T,
Doc=>projectdocs('mode','modeover',' Doc=>projectdocs('mode','modeover','
The mode is the single element most frequently found in a The mode is the single element most frequently found in a
discrete data set. discrete data set.
skipping to change at line 914 skipping to change at line 880
most=i; most=i;
curmode = curval; curmode = curval;
} }
} }
%} %}
$out() = curmode; $out() = curmode;
EOCODE EOCODE
); );
my $find_pct_interpolate = ' my $find_pct_interpolate = '
double np, pp1, pp2;
np = nn * $p(); np = nn * $p();
nn1 = np; PDL_Indx nn1 = PDLMIN(nn,PDLMAX(0,np));
nn2 = nn1+1; PDL_Indx nn2 = PDLMIN(nn,PDLMAX(0,np+1));
nn1 = (nn1 < 0) ? 0 : nn1;
nn2 = (nn2 < 0) ? 0 : nn2;
nn1 = (nn1 > nn) ? nn : nn1;
nn2 = (nn2 > nn) ? nn : nn2;
if (nn == 0) { if (nn == 0) {
pp1 = 0; pp1 = 0;
pp2 = 0; pp2 = 0;
} else { } else {
pp1 = (double)nn1/(double)(nn); pp1 = (double)nn1/(double)(nn);
pp2 = (double)nn2/(double)(nn); pp2 = (double)nn2/(double)(nn);
} }
if ( np <= 0.0 ) { if ( np <= 0.0 ) {
$b() = $tmp(n => 0); $b() = $tmp(n => 0);
} else if ( np >= nn ) { } else if ( np >= nn ) {
$b() = $tmp(n => nn); $b() = $tmp(n => nn);
} else if ($tmp(n => nn2) == $tmp(n => nn1)) { } else if ($tmp(n => nn2) == $tmp(n => nn1)) {
$b() = $tmp(n => nn1); $b() = $tmp(n => nn1);
} else if ($p() == pp1) { } else if ($p() == pp1) {
$b() = $tmp(n => nn1); $b() = $tmp(n => nn1);
} else if ($p() == pp2) { } else if ($p() == pp2) {
$b() = $tmp(n => nn2); $b() = $tmp(n => nn2);
} else { } else {
$b() = (np - nn1)*($tmp(n => nn2) - $tmp(n => nn1)) + $tmp(n => nn 1); $b() = (np - nn1)*($tmp(n => nn2) - $tmp(n => nn1)) + $tmp(n => nn 1);
} }
'; ';
pp_def('pctover', pp_def('pctover',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); p(); [o]b(); [t]tmp(n);', Pars => 'a(n); p(); [o]b(); [t]tmp(n);',
Doc => projectdocs('specified percentile', 'pctover', Doc => projectdocs('specified percentile', 'pctover',
'The specified 'The specified
percentile must be between 0.0 and 1.0. When the specified percentile percentile must be between 0.0 and 1.0. When the specified percentile
falls between data points, the result is interpolated. Values outside falls between data points, the result is interpolated. Values outside
the allowed range are clipped to 0.0 or 1.0 respectively. The algorithm the allowed range are clipped to 0.0 or 1.0 respectively. The algorithm
implemented here is based on the interpolation variant described at implemented here is based on the interpolation variant described at
L<http://en.wikipedia.org/wiki/Percentile> as used by Microsoft Excel L<http://en.wikipedia.org/wiki/Percentile> as used by Microsoft Excel
and recommended by NIST. and recommended by NIST.
'), '),
Code => ' Code => $copy_to_temp . $find_pct_interpolate . '}',
double np, pp1, pp2;
PDL_Indx nn2;
' . $copy_to_temp_good .
$find_pct_interpolate,
BadCode =>
$copy_to_temp_bad . '
PDL_Indx nn1, nn2;
double np, pp1, pp2;
nn -= 1; ' . generic_qsort('tmp') .
$find_pct_interpolate . '}',
); );
pp_def('oddpctover', pp_def('oddpctover',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); p(); [o]b(); [t]tmp(n);', Pars => 'a(n); p(); [o]b(); [t]tmp(n);',
Doc => projectdocs('specified percentile', 'oddpctover', Doc => projectdocs('specified percentile', 'oddpctover',
'The specified 'The specified
percentile must be between 0.0 and 1.0. When the specified percentile percentile must be between 0.0 and 1.0. When the specified percentile
falls between two values, the nearest data value is the result. falls between two values, the nearest data value is the result.
The algorithm implemented is from the textbook version described The algorithm implemented is from the textbook version described
first at L<http://en.wikipedia.org/wiki/Percentile>. first at L<http://en.wikipedia.org/wiki/Percentile>.
'), '),
Code => ' Code =>
PDL_Indx np; $copy_to_temp . '
' . $copy_to_temp_good . ' PDL_Indx np = PDLMAX(0,PDLMIN(nn,(nn+1)*$p()));
np = (nn+1)*$p();
if (np > nn) np = nn;
if (np < 0) np = 0;
$b() = $tmp(n => np);
',
BadCode => 'PDL_Indx np;
' . $copy_to_temp_bad . '
nn -= 1;
' . generic_qsort('tmp') . '
np = (nn+1)*$p();
if (np > nn) np = nn;
if (np < 0) np = 0;
$b() = $tmp(n => np); $b() = $tmp(n => np);
}', }',
); );
pp_add_exported('', 'pct'); for (
pp_addpm(<<'EOD'); ['','result is interpolated'],
=head2 pct ['odd','nearest data value is the result'],
) {
pp_add_exported('', $_->[0].'pct');
pp_addpm(<<EOD);
=head2 $_->[0]pct
=for ref =for ref
Return the specified percentile of all elements in an ndarray. The Return the specified percentile of all elements in an ndarray. The
specified percentile (p) must be between 0.0 and 1.0. When the specified percentile (p) must be between 0.0 and 1.0. When the
specified percentile falls between data points, the result is specified percentile falls between data points, the $_->[1].
interpolated.
=for usage =for usage
$x = pct($data, $pct); \$x = $_->[0]pct(\$data, \$pct);
=cut =cut
*pct = \&PDL::pct; *$_->[0]pct = \\&PDL::$_->[0]pct;
sub PDL::pct { sub PDL::$_->[0]pct {
my($x, $p) = @_; my(\$x, \$p) = \@_;
$x->clump(-1)->pctover($p, my $tmp=PDL->nullcreate($x)); \$x->clump(-1)->$_->[0]pctover(\$p, my \$tmp=PDL->nullcreate(\$x));
$tmp; \$tmp;
} }
EOD EOD
pp_add_exported('', 'oddpct');
pp_addpm(<<'EOD');
=head2 oddpct
=for ref
Return the specified percentile of all elements in an ndarray. The
specified percentile must be between 0.0 and 1.0. When the specified
percentile falls between two values, the nearest data value is the
result.
=for usage
$x = oddpct($data, $pct);
=cut
*oddpct = \&PDL::oddpct;
sub PDL::oddpct {
my($x, $p) = @_;
$x->clump(-1)->oddpctover($p, my $tmp=PDL->nullcreate($x));
$tmp;
} }
EOD
sub qsort_croak { sub qsort_croak {
my ($out, $insizedim, $outsizedim) = @_; my ($out, $insizedim, $outsizedim) = @_;
'if ($PDL(a)->dims['.$insizedim.'] != $PDL('.$out.')->dims['.$outsizedim.'] && $PDL(a)->dims['.$insizedim.'] > 1) 'if ($PDL(a)->dims['.$insizedim.'] != $PDL('.$out.')->dims['.$outsizedim.'] && $PDL(a)->dims['.$insizedim.'] > 1)
/* last term detects non-trivial sort */ /* last term detects non-trivial sort */
$CROAK("You likely passed a scalar argument, when you should have passed an ndarray (or nothing at all)"); $CROAK("You likely passed a scalar argument, when you should have passed an ndarray (or nothing at all)");
if ($PDL(a)->nvals == 0) return PDL_err; if ($PDL(a)->nvals == 0) return PDL_err;
' '
} }
# move all bad values to the end of the array # move all bad values to the end of the array
#
pp_def( pp_def(
'qsort', 'qsort',
HandleBad => 1, HandleBad => 1,
Inplace => 1, Inplace => 1,
Pars => 'a(n); [o]b(n);', Pars => 'a(n); [o]b(n);',
Code => Code =>
'PDL_Indx nn;
'.qsort_croak('b',0,0).'
loop(n) %{ $b() = $a(); %}
nn = $SIZE(n)-1;
'.generic_qsort('b'),
BadCode =>
'register PDL_Indx nn = 0, nb = $SIZE(n) - 1; 'register PDL_Indx nn = 0, nb = $SIZE(n) - 1;
'.qsort_croak('b',0,0).' '.qsort_croak('b',0,0).'
loop(n) %{ loop(n) %{
if ( $ISGOOD(a()) ) { $b(n=>nn) = $a(); nn++; } PDL_IF_BAD(if (!$ISGOOD(a())) { $SETBAD(b(n=>nb)); nb--; }
else { $SETBAD(b(n=>nb)); nb--; } else,) { $b(n=>nn) = $a(); nn++; }
%} %}
if ( nn != 0 ) { if ( nn != 0 ) {
nn -= 1; nn -= 1;
' . generic_qsort('b') . ' }', ' . generic_qsort('b') . ' }',
Doc => ' Doc => '
=for ref =for ref
Quicksort a vector into ascending order. Quicksort a vector into ascending order.
=for example =for example
print qsort random(10); print qsort random(10);
=cut =cut
', ',
BadDoc => BadDoc =>
' '
Bad values are moved to the end of the array: Bad values are moved to the end of the array:
pdl> p $y pdl> p $y
[42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD] [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
pdl> p qsort($y) pdl> p qsort($y)
[22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD] [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
', ',
skipping to change at line 1116 skipping to change at line 1023
sub generic_qsort_ind { sub generic_qsort_ind {
'qsort_ind_$PPSYM() ($P(a), $P(indx), 'qsort_ind_$PPSYM() ($P(a), $P(indx),
0, nn);'; 0, nn);';
} }
pp_def( pp_def(
'qsorti', 'qsorti',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); indx [o]indx(n);', Pars => 'a(n); indx [o]indx(n);',
Code => Code =>
'PDL_Indx nn = $SIZE(n)-1; 'register PDL_Indx nn = PDL_IF_BAD(0,$SIZE(n)-1), nb = $SIZE(n) - 1;
if ($SIZE(n) == 0) return PDL_err;
'.qsort_croak('indx',0,0).'
loop(n) %{
$indx() = n;
%}
'.generic_qsort_ind(),
BadCode =>
'register PDL_Indx nn = 0, nb = $SIZE(n) - 1;
if ($SIZE(n) == 0) return PDL_err; if ($SIZE(n) == 0) return PDL_err;
'.qsort_croak('indx',0,0).' '.qsort_croak('indx',0,0).'
loop(n) %{ loop(n) %{
if ( $ISGOOD(a()) ) { $indx(n=>nn) = n; nn++; } /* play safe since nn PDL_IF_BAD(if (!$ISGOOD(a())) { $indx(n=>nb) = n; nb--; }
used more than once */ else { $indx(n=>nn) = n; nn++; } /* play saf
else { $indx(n=>nb) = n; nb--; } e since nn used more than once */
,$indx() = n;)
%} %}
if ( nn != 0 ) { PDL_IF_BAD(if ( nn != 0 ) {
nn -= 1; nn -= 1;,{)
' . generic_qsort_ind() . ' }', ' . generic_qsort_ind() . '}',
BadDoc => BadDoc =>
'Bad elements are moved to the end of the array: 'Bad elements are moved to the end of the array:
pdl> p $y pdl> p $y
[42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD] [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
pdl> p $y->index( qsorti($y) ) pdl> p $y->index( qsorti($y) )
[22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD] [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
', ',
Doc => ' Doc => '
=for ref =for ref
skipping to change at line 1164 skipping to change at line 1064
); # pp_def: qsorti ); # pp_def: qsorti
# move all bad values to the end of the array # move all bad values to the end of the array
# #
pp_def( pp_def(
'qsortvec', 'qsortvec',
HandleBad => 1, HandleBad => 1,
Inplace => 1, Inplace => 1,
Pars => 'a(n,m); [o]b(n,m);', Pars => 'a(n,m); [o]b(n,m);',
Code => Code =>
'PDL_Indx nn = ($SIZE(m))-1; 'register PDL_Indx nn = PDL_IF_BAD(0,$SIZE(m)-1), nb = $SIZE(m) - 1;
PDL_Indx nd = $SIZE(n);
'.qsort_croak('b',1,1).'
if ($P(a) != $P(b)) loop(n,m) %{ $b() = $a(); %}
'.generic_qsortvec('b','nd'),
BadCode =>
'register PDL_Indx nn = 0, nb = $SIZE(m) - 1;
char is_inplace = ($P(a) == $P(b)); char is_inplace = ($P(a) == $P(b));
PDL_Indx nd = $SIZE(n); PDL_Indx nd = $SIZE(n);
'.qsort_croak('b',1,1).' '.qsort_croak('b',1,1).'
loop(m) %{ PDL_IF_BAD(loop(m) %{
char allgood_a = 1; char allgood_a = 1;
loop(n) %{ if ( $ISBAD(a()) ) { allgood_a = 0; break; } %} loop(n) %{ if ( $ISBAD(a()) ) { allgood_a = 0; break; } %}
PDL_Indx copy_dest = allgood_a ? nn++ : nb--; PDL_Indx copy_dest = allgood_a ? nn++ : nb--;
if (is_inplace) { if (is_inplace) {
if (allgood_a) continue; /* nothing to do */ if (allgood_a) continue; /* nothing to do */
char anybad_b = 0; char anybad_b = 0;
do { do {
anybad_b = 0; anybad_b = 0;
loop(n) %{ if ($ISBAD(b(m=>copy_dest))) { anybad_b = 1; break; } %} loop(n) %{ if ($ISBAD(b(m=>copy_dest))) { anybad_b = 1; break; } %}
if (anybad_b) copy_dest = nb--; if (anybad_b) copy_dest = nb--;
skipping to change at line 1202 skipping to change at line 1096
%} %}
if (m >= nb-1) { nn = nb+1; break; } /* run out of "good" vectors */ if (m >= nb-1) { nn = nb+1; break; } /* run out of "good" vectors */
} else { } else {
loop(n) %{ loop(n) %{
if ($ISGOOD(a())) $b(m=>copy_dest) = $a(); if ($ISGOOD(a())) $b(m=>copy_dest) = $a();
else $SETBAD(b(m=>copy_dest)); else $SETBAD(b(m=>copy_dest));
%} %}
} }
%} %}
if ( nn != 0 ) { if ( nn != 0 ) {
nn -= 1;' . nn -= 1;,
if (!is_inplace) { loop(n,m) %{ $b() = $a(); %} }
{)' .
generic_qsortvec('b','nd') .' generic_qsortvec('b','nd') .'
}', }',
Doc => ' Doc => '
=for ref =for ref
Sort a list of vectors lexicographically. Sort a list of vectors lexicographically.
The 0th dimension of the source ndarray is dimension in the vector; The 0th dimension of the source ndarray is dimension in the vector;
the 1st dimension is list order. Higher dimensions are broadcasted over. the 1st dimension is list order. Higher dimensions are broadcasted over.
skipping to change at line 1252 skipping to change at line 1148
my $pdl = shift; my $pdl = shift;
my $ndim = shift; my $ndim = shift;
'pdl_qsortvec_ind_$PPSYM() ($P(' . $pdl . '), $P(indx), '. $ndim.', 0, nn);' ; 'pdl_qsortvec_ind_$PPSYM() ($P(' . $pdl . '), $P(indx), '. $ndim.', 0, nn);' ;
} }
pp_def( pp_def(
'qsortveci', 'qsortveci',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n,m); indx [o]indx(m);', Pars => 'a(n,m); indx [o]indx(m);',
Code => Code =>
'PDL_Indx nd = $SIZE(n); 'register PDL_Indx nn = PDL_IF_BAD(0,$SIZE(m)-1), nb = $SIZE(m) - 1;
PDL_Indx nn=$SIZE(m)-1;
'.qsort_croak('indx',1,0).'
loop(m) %{
$indx()=m;
%}
'.generic_qsortvec_ind('a','nd'),
BadCode =>
'register PDL_Indx nn = 0, nb = $SIZE(m) - 1;
PDL_Indx nd = $SIZE(n); PDL_Indx nd = $SIZE(n);
'.qsort_croak('indx',1,0).' '.qsort_croak('indx',1,0).'
loop(m) %{ loop(m) %{
PDL_IF_BAD(
char allgood_a = 1; char allgood_a = 1;
loop(n) %{ if ( $ISBAD(a()) ) { allgood_a = 0; break; } %} loop(n) %{ if ( $ISBAD(a()) ) { allgood_a = 0; break; } %}
PDL_Indx copy_dest = allgood_a ? nn++ : nb--; PDL_Indx copy_dest = allgood_a ? nn++ : nb--;
$indx(m=>copy_dest) = m; $indx(m=>copy_dest) = m;
,
$indx()=m;
)
%} %}
PDL_IF_BAD(
if ( nn != 0 ) { if ( nn != 0 ) {
nn -= 1;' . nn -= 1;,{)' .
generic_qsortvec_ind('a','nd') .' generic_qsortvec_ind('a','nd') .'
}', }',
Doc => ' Doc => '
=for ref =for ref
Sort a list of vectors lexicographically, returning the indices of the Sort a list of vectors lexicographically, returning the indices of the
sorted vectors rather than the sorted list itself. sorted vectors rather than the sorted list itself.
As with C<qsortvec>, the input PDL should be an NxM array containing M As with C<qsortvec>, the input PDL should be an NxM array containing M
separate N-dimensional vectors. The return value is an integer M-PDL separate N-dimensional vectors. The return value is an integer M-PDL
 End of changes. 43 change blocks. 
172 lines changed or deleted 65 lines changed or added

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