Christian Soeller > PDL-2.4.1 > PDL::Ufunc

Download:
PDL-2.4.1.tar.gz

Annotate this POD

CPAN RT

Open  0
View/Report Bugs
Source   Latest Release: PDL-2.007_02

NAME ^

PDL::Ufunc - primitive ufunc operations for pdl

DESCRIPTION ^

This module provides some primitive and useful functions defined using PDL::PP based on functionality of what are sometimes called ufuncs (for example NumPY and Mathematica talk about these). It collects all the functions generally used to reduce or accumulate along a dimension. These all do their job across the first dimension but by using the slicing functions you can do it on any dimension.

The PDL::Reduce module provides an alternative interface to many of the functions in this module.

SYNOPSIS ^

 use PDL::Ufunc;

Project via $name to N-1 dimensions

This function reduces the dimensionality of a piddle by one by taking the $name along the 1st dimension.

By using xchg etc. it is possible to use any dimension.

 \$a = $op(\$b);
 \$spectrum = $op \$image->xchg(0,1)

$extras

EOD

} # sub: projectdocs()

sub cumuprojectdocs { my $name = shift; my $op = shift; my $extras = shift; return <<EOD;

Cumulative $name

This function calculates the cumulative $name along the 1st dimension.

By using xchg etc. it is possible to use any dimension.

The sum is started so that the first element in the cumulative $name is the first element of the parameter.

 \$a = $op(\$b);
 \$spectrum = $op \$image->xchg(0,1)

$extras

EOD

} # sub: cumuprojectdocs()

# it's a bit unclear what to do with the comparison operators, # since the return value could be bad because all elements are bad, # which needs checking for since the bad value could evaluate to # true or false (eg if the user has set it to 0) # # by setting CopyBadStatusCode to '', we stop the output piddle # from automatically being set bad if any of the input piddles are bad. # - we can set the flag within BadCode if necessary # # This may NOT be sensible. Only time, and comments, will tell... #

my %over = ( sumover => { name => 'sum', op => '+=', init => 0, }, prodover => { name => 'product', op => '*=', init => 1, }, );

foreach my $func ( keys %over ) {

    # creates $func and cumu$func functions
    # and d$func and dcumu$func functions, which
    # perform the calculations in double precision
    
    my $name = $over{$func}{name};
    my $op   = $over{$func}{op};
    my $init = $over{$func}{init};

    pp_def(
           $func,
           HandleBad => 1,
           Pars => 'a(n); int+ [o]b();',
           Code => 
           '$GENERIC(b) tmp = ' . $init . ';
            loop(n) %{ tmp ' . $op . ' $a(); %}
            $b() = tmp;',
           BadCode => 
           '$GENERIC(b) tmp = ' . $init . ';
            int flag = 0;
            loop(n) %{ 
               if ( $ISGOOD(a()) ) { tmp ' . $op . ' $a(); flag = 1; }
            %}
            if ( flag ) { $b() = tmp; }
            else        { $SETBAD(b()); }',
           Doc => projectdocs( $name, $func, '' ),
           );

    # as above, but in double precision
    pp_def(
           "d$func",
           HandleBad => 1,
           Pars => 'a(n); double [o]b();',
           Code => 
           'double tmp = ' . $init . ';
            loop(n) %{ tmp ' . $op . ' $a(); %}
            $b() = tmp;',
           BadCode => 
           'double tmp = ' . $init . ';
            int flag = 0;
            loop(n) %{ 
               if ( $ISGOOD(a()) ) { tmp ' . $op . ' $a(); flag = 1; }
            %}
            if ( flag ) { $b() = tmp; }
            else        { $SETBAD(b()); }',
           Doc => projectdocs( $name, "d$func", 
"Unlike L<$func|/$func>, the calculations are performed in double\n" .
"precision." ),
           );

    my $cfunc = "cumu${func}";
    pp_def(
           $cfunc,
           HandleBad => 1,
           Pars => 'a(n); int+ [o]b(n);',
           Code => 
           '$GENERIC(b) tmp = ' . $init . ';
            loop(n) %{ 
               tmp ' . $op . ' $a();
               $b() = tmp;
            %}',
           BadCode => 
           '$GENERIC(b) tmp = ' . $init . ';
            loop(n) %{ 
               if ( $ISBAD(a()) ) { $SETBAD(b()); }
               else {
                  tmp ' . $op . ' $a();
                  $b() = tmp;
               }
            %}',
           Doc => cumuprojectdocs( $name, $cfunc, '' ),
           );

    # as above but in double precision
    pp_def(
           "d$cfunc",
           HandleBad => 1,
           Pars => 'a(n); double [o]b(n);',
           Code => 
           'double tmp = ' . $init . ';
            loop(n) %{ 
               tmp ' . $op . ' $a();
               $b() = tmp;
            %}',
           BadCode => 
           'double tmp = ' . $init . ';
            loop(n) %{ 
               if ( $ISBAD(a()) ) { $SETBAD(b()); }
               else {
                  tmp ' . $op . ' $a();
                  $b() = tmp;
               }
            %}',
           Doc => cumuprojectdocs( $name, $cfunc, 
"Unlike L<cumu$func|/cumu$func>, the calculations are performed in double\n" .
"precision." ),
           );

} # foreach: my $func

%over = ( zcover => { def=>'char tmp', txt => '== 0', init => 1, alltypes => 1, op => 'tmp &= ($a() == 0);', check => '!tmp' }, andover => { def=>'char tmp', txt => 'and', init => 1, alltypes => 1, op => 'tmp &= ($a() != 0);', check => '!tmp' }, bandover => { def=>'$GENERIC(b) tmp', txt => 'bitwise and', init => '~0', op => 'tmp &= $a();', check => '!tmp' }, orover => { def=>'char tmp', txt => 'or', init => 0, alltypes => 1, op => 'tmp |= ($a() != 0);', check => 'tmp' }, borover => { def=>'$GENERIC(b) tmp', txt => 'bitwise or', init => 0, op => 'tmp |= $a() ;', check => '!~tmp' },

     );

foreach my $func ( keys %over ) {

    my $def   = $over{$func}{def};
    my $txt   = $over{$func}{txt};
    my $init  = $over{$func}{init};
    my $op    = $over{$func}{op};
    my $check = $over{$func}{check};

    my %extra = {};
    unless ( defined $over{$func}{alltypes} and $over{$func}{alltypes} ) {
        $extra{GenericTypes} = ['B','S','U','L'];
    }

    pp_def(
           $func,
           HandleBad => 1,
           %extra,
           Pars => 'a(n); int+ [o]b();',
           Code =>
           $def . '=' . $init . ';
            loop(n) %{ ' . $op . ' if (' . $check . ') break; %}
            $b() = tmp;',
           BadCode => 
           'char tmp = ' . $init . ';
            $GENERIC(b) gtmp = '. $init . ';
            int flag = 0;
            loop(n) %{
               if ( $ISGOOD(a()) ) { ' . $op . ' flag = 1; if (' . $check . ') break; }
            %}
            if ( flag ) { $b() = tmp; }
            else        { $SETBAD(b()); $PDLSTATESETBAD(b); }',
           CopyBadStatusCode => '',
           Doc => projectdocs( $txt, $func,''), 
       BadDoc => 
'If C<a()> contains only bad data (and its bad flag is set), 
C<b()> is set bad. Otherwise C<b()> will have its bad flag cleared,
as it will not contain any bad values.',
           );

} # foreach: $func

# this would need a lot of work to support bad values # plus it gives me a chance to check out HandleBad => 0 ;) # pp_def( 'intover', HandleBad => 0, Pars => 'a(n); int+ [o]b();', Code => '$GENERIC(b) tmp = 0; int ns = $SIZE(n), nn; /* Integration formulae from Press et al 2nd Ed S 4.1 */ switch (ns) { case 1: threadloop %{ $b() = 0.; /* not a(n=>0); as interval has zero width */ %} break; case 2: threadloop %{ $b() = 0.5*($a(n=>0)+$a(n=>1)); %} break; case 3: threadloop %{ $b() = ($a(n=>0)+4*$a(n=>1)+$a(n=>2))/3.; %} break; case 4: threadloop %{ $b() = ($a(n=>0)+$a(n=>3)+3.*($a(n=>1)+$a(n=>2)))*0.375; %} break; case 5: threadloop %{ $b() = (14.*($a(n=>0)+$a(n=>4)) +64.*($a(n=>1)+$a(n=>3)) +24.*$a(n=>2))/45.; %} break; default: threadloop %{ for (nn=3,tmp=0;nn<ns-3;nn++) { tmp += $a(n=>nn); } tmp += (23./24.)*($a(n=>2)+$a(n=>nn));nn++; tmp += (7./6.) *($a(n=>1)+$a(n=>nn));nn++; tmp += 0.375 *($a(n=>0)+$a(n=>nn)); $b() = tmp; %} } ', Doc => projectdocs('integral','intover', q~Notes:

For n > 3, these are all O(h^4) (like Simpson's rule), but are integrals between the end points assuming the pdl gives values just at these centres: for such `functions', sumover is correct to O(h), but is the natural (and correct) choice for binned data, of course. ~) ); # intover

pp_def( 'average', HandleBad => 1, Pars => 'a(n); int+ [o]b();', Code => '$GENERIC(b) tmp = 0; if($SIZE(n)) { loop(n) %{ tmp += $a(); %} ; $b() = tmp / ($GENERIC(b)) $SIZE(n); } else { $GENERIC(b) foo = 0.25; if(foo == 0) { /* Cheesy check for floating-pointiness */ $b() = 0; /* Integer - set to 0 */ } else { $b() = sqrt(-1); /* Cheesy NaN -- CED */ } }',

        BadCode => 
        '$GENERIC(b) tmp = 0;
         long cnt = 0;
         loop(n) %{ 
            if ( $ISGOOD(a()) ) { tmp += $a(); cnt++; }
         %}
         if ( cnt ) { $b() = tmp / ($GENERIC(b)) cnt; }
         else       { $SETBAD(b()); }',
        Doc => projectdocs( 'average', 'average', '' ),
        );

# do the above calculation, but in double precision pp_def( 'daverage', HandleBad => 1, Pars => 'a(n); double [o]b();', Code => 'double tmp = 0; if($SIZE(n)) { loop(n) %{ tmp += $a(); %} $b() = tmp / $SIZE(n); } else { $b() = 0; }', BadCode => 'double tmp = 0; long cnt = 0; loop(n) %{ if ( $ISGOOD(a()) ) { tmp += $a(); cnt++; } %} if ( cnt ) { $b() = tmp / cnt; } else { $SETBAD(b()); }', Doc => projectdocs( 'average', 'daverage', "Unlike average, the calculation is performed in double\n" . "precision." ), );

# Internal utility sorting routine for median/qsort/qsortvec routines. # # note: we export them to the PDL Core structure for use in # other modules (eg Image2D)

for (keys %PDL::Types::typehash) { my $ctype = $PDL::Types::typehash{$_}{ctype}; my $ppsym = $PDL::Types::typehash{$_}{ppsym};

    pp_add_boot( " PDL->qsort_${ppsym} = pdl_qsort_${ppsym};" .
                 " PDL->qsort_ind_${ppsym} = pdl_qsort_ind_${ppsym};\n" );

    pp_addhdr(<<"FOO"

      void pdl_qsort_$ppsym($ctype* xx, int a, int b) {

         int i,j;

         $ctype t, median;

         i = a; j = b;
         median = xx[(i+j) / 2];
         do {
            while (xx[i] < median)
               i++;
            while (median < xx[j])
               j--;
            if (i <= j) {
               t = xx[i]; xx[i] = xx[j]; xx[j] = t;
               i++; j--;
            }
         } while (i <= j);

         if (a < j)
            pdl_qsort_$ppsym(xx,a,j);
         if (i < b)
            pdl_qsort_$ppsym(xx,i,b);

      }

      void pdl_qsort_ind_$ppsym($ctype* xx,  int* ix, int a, int b) {

         int i,j;

         int t;
        $ctype median;

         i = a; j = b;
         median = xx[ix[(i+j) / 2]];

         do {
          while (xx[ix[i]] < median)
               i++;
            while (median < xx[ix[j]])
               j--;
            if (i <= j) {
               t = ix[i]; ix[i] = ix[j]; ix[j] = t;
               i++; j--;
            }
         } while (i <= j);

         if (a < j)
            pdl_qsort_ind_$ppsym(xx,ix,a,j);
         if (i < b)
            pdl_qsort_ind_$ppsym(xx,ix,i,b);

      }


        /*******
         * qsortvec helper routines
         *   --CED 21-Aug-2003
         */

        /* Compare a vector in lexicographic order, returning the
         *  equivalent of "<=>". 
         */
      char pdl_cmpvec_$ppsym($ctype *a, $ctype *b, int n) {
        int i;
        for(i=0; i<n; a++,b++,i++) {
         if( *a < *b ) return -1;
         if( *a > *b ) return 1;
        }
        return 0;
     }  
        
      void pdl_qsortvec_$ppsym($ctype *xx, int n, int a, int b) {
                
        int i,j;
        $ctype t, *median;
        i = a; 
        j = b;

        median = &xx[n*((i+j)/2)];

        do {
          while( pdl_cmpvec_$ppsym( &(xx[n*i]), median, n )  <  0 ) 
                i++;
          while( pdl_cmpvec_$ppsym( &(xx[n*j]), median, n )  >  0 ) 
                j--;
          if(i<=j) {
                int k;
                $ctype *aa = &xx[n*i];
                $ctype *bb = &xx[n*j];
                for( k=0; k<n; aa++,bb++,k++ ) {
                  $ctype z;
                  z = *aa;
                  *aa = *bb;
                  *bb = z;      
                }
                i++; 
                j--;
          }
        } while (i <= j);
        
        if (a < j)
          pdl_qsortvec_$ppsym( xx, n, a, j );
        if (i < b)
          pdl_qsortvec_$ppsym( xx, n, i, b );
        
      }

FOO ); }

# when copying the data over to the temporary array, # ignore the bad values and then only send the number # of good elements to the sort routines #

sub generic_qsort { my $pdl = shift; return '$TBSULQFD(pdl_qsort_B,pdl_qsort_S,pdl_qsort_U, pdl_qsort_L,pdl_qsort_Q,pdl_qsort_F,pdl_qsort_D) ($P(' . $pdl . '), 0, nn);'; }

sub generic_qsortvec { my $pdl = shift; my $ndim = shift; return '$TBSULQFD(pdl_qsortvec_B,pdl_qsortvec_S,pdl_qsortvec_U, pdl_qsortvec_L,pdl_qsortvec_Q,pdl_qsortvec_F,pdl_qsortvec_D) ($P(' . $pdl . '), '. $ndim.', 0, nn);'; }

# should use threadloop ? # my $copy_to_temp_good = ' int nn, nn1; loop(n) %{ $tmp() = $a(); %} nn = $COMP(__n_size)-1; ' . generic_qsort('tmp');

my $copy_to_temp_bad = ' register int nn = 0; loop(n) %{ if ( $ISGOOD(a()) ) { $tmp(n=>nn) = $a(); nn++; } %} if ( nn == 0 ) { $SETBAD(b()); } else { ';

my $find_median_average = ' nn1 = nn/2; nn2 = nn1+1; if (nn%2==0) { $b() = $tmp(n => nn1); } else { $b() = 0.5*( $tmp(n => nn1) + $tmp(n => nn2) ); }';

my $find_median_lower = ' nn1 = nn/2; $b() = $tmp(n => nn1);';

pp_def( 'medover', HandleBad => 1, Pars => 'a(n); [o]b(); [t]tmp(n);', Doc => projectdocs('median','medover',''), Code => "int nn2;\n" . $copy_to_temp_good . $find_median_average, BadCode => $copy_to_temp_bad . ' int nn1, nn2; nn -= 1; ' . generic_qsort('tmp') . $find_median_average . '}',

       ); # pp_def: medover

pp_def( 'oddmedover', HandleBad => 1, Pars => 'a(n); [o]b(); [t]tmp(n);', Doc => projectdocs('oddmedian','oddmedover','

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 middle values - thus it does not always correspond to a data 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 some circumstances. '), Code => $copy_to_temp_good . $find_median_lower, BadCode => $copy_to_temp_bad . ' int nn1; nn -= 1; '. $find_median_lower . '}',

       ); # pp_def: oddmedover

pp_def('pctover', Pars => 'a(n); p(); [o]b(); [t]tmp(n);', Doc => '

Project via percentile to N-1 dimensions

This function reduces the dimensionality of a piddle by one by finding the specified percentile (p) along the 1st dimension. The specified percentile must be between 0.0 and 1.0. When the specified percentile falls between data points, the result is interpolated.

By using xchg etc. it is possible to use any dimension.

 $a = pctover($b, $p);
 $spectrum = pctover $image->xchg(0,1) $p
 $a = oddpctover($b, $p);
 $spectrum = oddpctover $image->xchg(0,1) $p

pct

Return the specified percentile of all elements in a piddle. The specified percentile (p) must be between 0.0 and 1.0. When the specified percentile falls between data points, the result is interpolated.

 \$x = pct(\$data, \$pct);

oddpct

Return the specified percentile of all elements in a piddle. 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.

 \$x = oddpct(\$data, \$pct);

$name

Return the $text of all elements in a piddle

 \$x = $name(\$data);

EOD

    if ( $bvalflag ) {
        pp_addpm(<<"EOD");
=for bad

This routine handles bad values (see the documentation for $func). I still need to decide how to handle the case when the return value is a bad value (eg to make sure it has the same type as the input piddle OR perhaps we should die - makes sense for the conditional ops but not things like sum)

EOD } # if: bvalflag

   pp_addpm(<<"EOD");

any

Return true if any element in piddle set

Useful in conditional expressions:

 if (any $a>15) { print "some values are greater than 15\n" }

EOPM

    if ( $bvalflag ) {
        pp_addpm(<<'EOPM');
=for bad

See or for comments on what happens when all elements in the check are bad.

EOPM } # if: bvalflag

pp_addpm(<<'EOPM');

all

Return true if all elements in piddle set

Useful in conditional expressions:

 if (all $a>15) { print "all values are greater than 15\n" }

EOPM

    if ( $bvalflag ) {
        pp_addpm(<<'EOPM');
=for bad

See and for comments on what happens when all elements in the check are bad.

EOPM } # IF: BVALFLAG

pp_addpm(<<'EOPM');

minmax

Returns an array with minimum and maximum values of a piddle.

 ($mn, $mx) = minmax($pdl);

This routine does not thread over the dimensions of $pdl; it returns the minimum and maximum values of the whole array. See minmaximum if this is not what is required. The two values are returned as Perl scalars similar to min/max.

 perldl> $x = pdl [1,-2,3,5,0]
 perldl> ($min, $max) = minmax($x);
 perldl> p "$min $max\n";
 -2 5

Quicksort a vector into ascending order.

 print qsort random(10);

', BadDoc => ' Bad values are moved to the end of the array:

 perldl> p $b
 [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
 perldl> p qsort($b)
 [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
',
    ); # pp_def qsort

sub generic_qsort_ind { return '$TBSULQFD(pdl_qsort_ind_B,pdl_qsort_ind_S,pdl_qsort_ind_U, pdl_qsort_ind_L,pdl_qsort_ind_Q,pdl_qsort_ind_F,pdl_qsort_ind_D) ($P(a), $P(indx), 0, nn);'; }

pp_def( 'qsorti', HandleBad => 1, Pars => 'a(n); int [o]indx(n);', Code => 'int nn = $COMP(__n_size)-1; loop(n) %{ $indx() = n; %} ' . generic_qsort_ind(), BadCode => 'register int nn = 0, nb = $SIZE(n) - 1; loop(n) %{ if ( $ISGOOD(a()) ) { $indx(n=>nn) = n; nn++; } /* play safe since nn used more than once */ else { $indx(n=>nb) = n; nb--; } %} if ( nn != 0 ) { nn -= 1; ' . generic_qsort_ind() . ' }', BadDoc => 'Bad elements are moved to the end of the array:

 perldl> p $b
 [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
 perldl> p $b->index( qsorti($b) )
 [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
',
       Doc => '
=for ref

Quicksort a vector and return index of elements in ascending order.

 $ix = qsorti $a;
 print $a->index($ix); # Sorted list

' ); # pp_def: qsorti

# move all bad values to the end of the array # pp_def( 'qsortvec', HandleBad => 1, Pars => 'a(n,m); [o]b(n,m);', Code => 'int nn; int nd; loop(n,m) %{ $b() = $a(); %} nn = ($COMP(__m_size))-1; nd = $COMP(__n_size); ' . generic_qsortvec('b','nd'), Doc => ' =for ref

Sort a list of vectors lexicographically.

The 0th dimension of the source piddle is dimension in the vector; the 1st dimension is list order. Higher dimensions are threaded over.

 print qsortvec pdl([[1,2],[0,500],[2,3],[4,2],[3,4],[3,5]]);
 [
  [  0 500]
  [  1   2]
  [  2   3]
  [  3   4]
  [  3   5]
  [  4   2]
 ]

', BadDoc => ' Vectors with bad components should be moved to the end of the array: ', ); # pp_def qsort

# I don't think the old behaviour is correct in the presence of NaN's - # surely it will set the min/max values to NaN in this case? # # I have kept in the check for when Bad value support is not being compiled # my $nan_check = $bvalflag ? '' : '|| IsNaN(cur)';

for my $which ( ['minimum','<'], ['maximum','>'] ) { my $name = $which->[0]; my $op = $which->[1];

    pp_def( 
            $name,
            HandleBad => 1,
            Pars => 'a(n); [o]c();', 
            Code => 
            '$GENERIC() cur;
             loop(n) %{
                if(!n || $a() '.$op.' cur ' . $nan_check . ') {cur = $a();}
             %}
             $c() = cur;',
            BadCode => 
            '$GENERIC() cur;
             int flag = 0;
             loop(n) %{
                if( $ISGOOD(a()) && (!flag || $a() '.$op.' cur)) {cur = $a(); flag = 1;}
             %}
             if ( flag ) { $c() = cur; }
             else        { $SETBAD(c()); $PDLSTATESETBAD(c); }',
            CopyBadStatusCode => '',
            Doc => projectdocs($name,$name),
            BadDoc => 
'Output is set bad if all elements of the input are bad,
otherwise the bad flag is cleared for the output piddle.

Note that NaNs are considered to be valid values; see isfinite and badmask for ways of masking NaNs. ', );

    pp_def( 
            "${name}_ind",
            HandleBad => 1,
            Pars => 'a(n); int [o] c();', 
            Code => 
            '$GENERIC() cur;
             int curind;
             loop(n) %{
                if(!n || $a() '.$op.' cur ' . $nan_check . ')
                   {cur = $a(); curind = n;}
             %}
             $c() = curind;',
            BadCode => 
            '$GENERIC() cur;
             int curind, flag = 0; /* should set curind to -1 and check for that, then do not need flag */
             loop(n) %{
                if( $ISGOOD(a()) && (!flag || $a() '.$op.' cur)) 
                   {cur = $a(); curind = n; flag = 1;}
             %}
             if ( flag ) { $c() = curind; }
             else        { $SETBAD(c()); $PDLSTATESETBAD(c); }',
            CopyBadStatusCode => '',
            Doc => "Like $name but returns the index rather than the value",
            BadDoc => 
'Output is set bad if all elements of the input are bad,
otherwise the bad flag is cleared for the output piddle.',
            );

    pp_def( 
            "${name}_n_ind",
            HandleBad => 0,   # just a marker 
            Pars => 'a(n); int[o]c(m);',
            Code =>
            '$GENERIC() cur; int curind; register int ns = $SIZE(n);
             if($SIZE(m) > $SIZE(n)) $CROAK("n_ind: m_size > n_size");
             loop(m) %{
                 curind = ns;
                 loop(n) %{
                        int nm; int flag=0;
                        for(nm=0; nm<m; nm++) {
                                if($c(m=>nm) == n) {flag=1; break;}
                        }
                        if(!flag &&
                           ((curind == ns) || $a() '.$op.' cur || IsNaN(cur)))
                                {cur = $a(); curind = n;}
                 %}
                 $c() = curind;
             %}',
            Doc => "Returns the index of C<m> $name elements",
            BadDoc => 'Not yet been converted to ignore bad values',
            );

} # foreach: $which

# removed IsNaN handling, even from Code section # I think it was wrong, since it was # # if (!n || ($a() < curmin) || IsNaN(curmin)) {curmin = $a(); curmin_ind = n;}; # if (!n || ($a() > curmax) || IsNaN(curmax)) {curmax = $a(); curmax_ind = n;}; # # surely this succeeds if cur... is a NaN?? # pp_def( 'minmaximum', HandleBad => 1, Pars => 'a(n); [o]cmin(); [o] cmax(); int [o]cmin_ind(); int [o]cmax_ind();', Code => '$GENERIC() curmin, curmax; int curmin_ind, curmax_ind;

         curmin = curmax = 0; /* Handle null piddle --CED */

         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, curmax;
         int curmin_ind, curmax_ind, flag = 0;
        
         loop(n) %{
            if ( $ISGOOD(a()) ) {
               if ( !flag ) {
                  curmin = curmax = $a();
                  curmin_ind = curmax_ind = n;
                  flag = 1;
               } else {
                  if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; }
                  if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; }
               }
            } /* ISGOOD */
         %}
         if ( flag ) { /* Handle null piddle */
            $cmin() = curmin; $cmin_ind() = curmin_ind;
            $cmax() = curmax; $cmax_ind() = curmax_ind;
         } else {
            $SETBAD(cmin()); $SETBAD(cmin_ind());
            $SETBAD(cmax()); $SETBAD(cmax_ind());
            $PDLSTATESETBAD(cmin); $PDLSTATESETBAD(cmin_ind);
            $PDLSTATESETBAD(cmax); $PDLSTATESETBAD(cmax_ind);
         }',
        Doc =>
'
=for ref

Find minimum and maximum and their indices for a given piddle;

 perldl> $a=pdl [[-2,3,4],[1,0,3]]
 perldl> ($min, $max, $min_ind, $max_ind)=minmaximum($a)
 perldl> p $min, $max, $min_ind, $max_ind
 [-2 0] [4 3] [0 1] [2 2]

See also minmax, which clumps the piddle together.

', BadDoc => 'If a() contains only bad data, then the output piddles will be set bad, along with their bad flag. Otherwise they will have their bad flags cleared, since they will not contain any bad values.', ); # pp_def minmaximum

pp_addpm({At=>'Bot'},<<'EOD');

AUTHOR ^

Copyright (C) Tuomas J. Lukka 1997 (lukka@husc.harvard.edu). Contributions by Christian Soeller (c.soeller@auckland.ac.nz) and Karl Glazebrook (kgb@aaoepp.aao.gov.au). All rights reserved. There is no warranty. You are allowed to redistribute this software / documentation under certain conditions. For details, see the file COPYING in the PDL distribution. If this file is separated from the PDL distribution, the copyright notice should be included in the file.

syntax highlighting: