Index: Basic/Primitive/primitive.pd =================================================================== RCS file: /cvsroot/PDL/PDL/Basic/Primitive/primitive.pd,v retrieving revision 1.9 diff -u -r1.9 primitive.pd --- Basic/Primitive/primitive.pd 2000/04/29 11:27:49 1.9 +++ Basic/Primitive/primitive.pd 2000/06/01 20:24:19 @@ -379,7 +379,149 @@ \$b() = \$tmp(n => nn1); '); +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 L etc. it is possible to use +I dimension. + +=for usage + + \$a = pctover(\$b, \$p); + +=for example + + \$spectrum = pctover \$image->xchg(0,1) \$p + +=cut +', + Code => ' + int nn, nn1, nn2; + double pp1, pp2; + loop(n) %{ \$tmp() = \$a(); %} + nn = \$COMP(__n_size)-1; + \$TBSULFD(pdl_qsort_B,pdl_qsort_S,pdl_qsort_U, + pdl_qsort_L,pdl_qsort_F,pdl_qsort_D) (\$P(tmp), 0, nn); + + nn1 = (nn + 1)*\$p() - 1 + 0.5; nn2 = nn1+1; + if (nn2 > nn) nn2 = nn; + if (nn1 > nn) nn1 = nn; + pp1 = (double)nn1/(double)nn; + pp2 = (double)nn2/(double)nn; + if (\$tmp(n => nn2) == \$tmp(n => nn1)) { + \$b() = \$tmp(n => nn1); + } else if (\$p() == pp1) { + \$b() = \$tmp(n => nn1); + } else if (\$p() == pp2) { + \$b() = \$tmp(n => nn2); + } else { + \$b() = (\$p() - pp1)/(pp2 - pp1)* + ( \$tmp(n => nn2) - \$tmp(n => nn1) ) + \$tmp(n => nn1); + } +'); + +pp_def('oddpctover', + 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 along the 1st dimension. 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. + +By using L etc. it is possible to use +I dimension. + +=for usage + + \$a = oddpctover(\$b, \$p); + +=for example + + \$spectrum = oddpctover \$image->xchg(0,1) \$p + +=cut +', + Code => ' + int nn, nn1; + loop(n) %{ \$tmp() = \$a(); %} + nn = \$COMP(__n_size)-1; + \$TBSULFD(pdl_qsort_B,pdl_qsort_S,pdl_qsort_U, + pdl_qsort_L,pdl_qsort_F,pdl_qsort_D) (\$P(tmp), 0, nn); + + nn1 = (nn + 1)*\$p() - 1 + 0.5; + if (nn1 > nn) nn1 = nn; + if (nn1 < 0) nn1 = 0; + \$b() = \$tmp(n => nn1); +'); + +pp_add_exported('', 'pct'); +pp_addpm(<<"EOD"); + +=head2 pct + +=for ref + +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. + +=for usage + + \\$x = pct(\\$data, \\$pct); + +=cut + +*pct = \\&PDL::pct; +sub PDL::pct { + my(\\$x, \\$p) = \@_; + my \\$tmp; + \\$x->clump(-1)->pctover(\\$p, \\$tmp=PDL->nullcreate(\\$x)); + return \\$tmp->at(); +} + +EOD + +pp_add_exported('', 'oddpct'); +pp_addpm(<<"EOD"); + +=head2 oddpct + +=for ref + +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. + +=for usage + + \\$x = oddpct(\\$data, \\$pct); + +=cut + +*oddpct = \\&PDL::oddpct; +sub PDL::oddpct { + my(\\$x, \\$p) = \@_; + my \\$tmp; + \\$x->clump(-1)->oddpctover(\\$p, \\$tmp=PDL->nullcreate(\\$x)); + return \\$tmp->at(); +} + +EOD + + # Generate small ops functions to do entire array for \$op ( ['avg','average','average'], @@ -391,8 +533,8 @@ ['bor','borover','bitwise or'], ['min','minimum','minimum'], ['max','maximum','maximum'], - ['median', 'medover', 'median'], - ['oddmedian','oddmedover','oddmedian']) { + ['median', 'medover', 'median'] + ) { pp_add_exported('', \$op->[0]); pp_addpm(<<"EOD");