"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Primitive/primitive.pd" between
PDL-2.082.tar.gz and PDL-2.083.tar.gz

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

[ To the main PDL source changes report ]

primitive.pd  (PDL-2.082):primitive.pd  (PDL-2.083)
skipping to change at line 202 skipping to change at line 202
L</matmult> method. L</matmult> method.
=cut =cut
EOD EOD
pp_def('matmult', pp_def('matmult',
HandleBad=>0, HandleBad=>0,
Pars => 'a(t,h); b(w,t); [o]c(w,h);', Pars => 'a(t,h); b(w,t); [o]c(w,h);',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
PMCode => <<'EOPM', PMCode => pp_line_numbers(__LINE__, <<'EOPM'),
sub PDL::matmult { sub PDL::matmult {
my ($x,$y,$c) = @_; my ($x,$y,$c) = @_;
$y = PDL->topdl($y); $y = PDL->topdl($y);
$c = PDL->null unless do { local $@; eval { $c->isa('PDL') } }; $c = PDL->null unless do { local $@; eval { $c->isa('PDL') } };
while($x->getndims < 2) {$x = $x->dummy(-1)} while($x->getndims < 2) {$x = $x->dummy(-1)}
while($y->getndims < 2) {$y = $y->dummy(-1)} while($y->getndims < 2) {$y = $y->dummy(-1)}
return ($c .= $x * $y) if( ($x->dim(0)==1 && $x->dim(1)==1) || return ($c .= $x * $y) if( ($x->dim(0)==1 && $x->dim(1)==1) ||
($y->dim(0)==1 && $y->dim(1)==1) ); ($y->dim(0)==1 && $y->dim(1)==1) );
barf sprintf 'Dim mismatch in matmult of [%1$dx%2$d] x [%3$dx%4$d]: %1$d != %4$d',$x->dim(0),$x->dim(1),$y->dim(0),$y->dim(1) barf sprintf 'Dim mismatch in matmult of [%1$dx%2$d] x [%3$dx%4$d]: %1$d != %4$d',$x->dim(0),$x->dim(1),$y->dim(0),$y->dim(1)
if $y->dim(1) != $x->dim(0); if $y->dim(1) != $x->dim(0);
skipping to change at line 621 skipping to change at line 621
recommended for processing pdls with bad values in them recommended for processing pdls with bad values in them
unless special care is taken. unless special care is taken.
=cut =cut
EOD EOD
Pars => 'a(m); kern(p); [o]b(m);', Pars => 'a(m); kern(p); [o]b(m);',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
OtherPars => 'int reflect;', OtherPars => 'int reflect;',
HandleBad => 0, HandleBad => 0,
PMCode => ' PMCode => pp_line_numbers(__LINE__, <<'EOPM'),
sub PDL::conv1d { sub PDL::conv1d {
my $opt = pop @_ if ref($_[-1]) eq \'HASH\'; my $opt = pop @_ if ref($_[-1]) eq 'HASH';
die \'Usage: conv1d( a(m), kern(p), [o]b(m), {Options} )\' die 'Usage: conv1d( a(m), kern(p), [o]b(m), {Options} )'
if @_<2 || @_>3; if @_<2 || @_>3;
my($x,$kern) = @_; my($x,$kern) = @_;
my $c = @_ == 3 ? $_[2] : PDL->null; my $c = @_ == 3 ? $_[2] : PDL->null;
PDL::_conv1d_int($x,$kern,$c, PDL::_conv1d_int($x,$kern,$c,
!(defined $opt && exists $$opt{Boundary}) ? 0 : !(defined $opt && exists $$opt{Boundary}) ? 0 :
lc $$opt{Boundary} eq "reflect"); lc $$opt{Boundary} eq "reflect");
return $c; return $c;
} }
EOPM
',
Code => ' Code => '
int i,i1,i2,poff,pflip; int i,i1,i2,poff,pflip;
double tmp; double tmp;
int reflect = $COMP(reflect); int reflect = $COMP(reflect);
int m_size = $SIZE(m); int m_size = $SIZE(m);
int p_size = $SIZE(p); int p_size = $SIZE(p);
poff = (p_size-1)/2; poff = (p_size-1)/2;
for(i=0; i<m_size; i++) { for(i=0; i<m_size; i++) {
tmp = 0; tmp = 0;
skipping to change at line 914 skipping to change at line 912
pp_def( pp_def(
$name, $name,
HandleBad => 1, HandleBad => 1,
Pars => 'a(); b(); [o] c()', Pars => 'a(); b(); [o] c()',
Code => Code =>
'PDL_IF_BAD(if ( $ISBAD(a()) || $ISBAD(b()) ) { 'PDL_IF_BAD(if ( $ISBAD(a()) || $ISBAD(b()) ) {
$SETBAD(c()); $SETBAD(c());
} else,) { '.$code.' }', } else,) { '.$code.' }',
Doc => 'clip (threshold) C<$a> by C<$b> (C<$b> is '. Doc => 'clip (threshold) C<$a> by C<$b> (C<$b> is '.
($name eq 'hclip' ? 'upper' : 'lower').' bound)', ($name eq 'hclip' ? 'upper' : 'lower').' bound)',
PMCode=><<"EOD", PMCode=>pp_line_numbers(__LINE__, <<"EOD"),
sub PDL::$name { sub PDL::$name {
my (\$x,\$y) = \@_; my (\$x,\$y) = \@_;
my \$c; my \$c;
if (\$x->is_inplace) { if (\$x->is_inplace) {
\$x->set_inplace(0); \$c = \$x; \$x->set_inplace(0); \$c = \$x;
} elsif (\@_ > 2) {\$c=\$_[2]} else {\$c=PDL->nullcreate(\$x)} } elsif (\@_ > 2) {\$c=\$_[2]} else {\$c=PDL->nullcreate(\$x)}
PDL::_${name}_int(\$x,\$y,\$c); PDL::_${name}_int(\$x,\$y,\$c);
return \$c; return \$c;
} }
EOD EOD
skipping to change at line 963 skipping to change at line 961
HandleBad => 1, HandleBad => 1,
Pars => 'a(); l(); h(); [o] c()', Pars => 'a(); l(); h(); [o] c()',
Code => <<'EOBC', Code => <<'EOBC',
PDL_IF_BAD( PDL_IF_BAD(
if( $ISBAD(a()) || $ISBAD(l()) || $ISBAD(h()) ) { if( $ISBAD(a()) || $ISBAD(l()) || $ISBAD(h()) ) {
$SETBAD(c()); $SETBAD(c());
} else,) { } else,) {
$c() = PDLMIN($h(), PDLMAX($l(), $a())); $c() = PDLMIN($h(), PDLMAX($l(), $a()));
} }
EOBC EOBC
PMCode => <<'EOPM', PMCode=>pp_line_numbers(__LINE__, <<'EOPM'),
*clip = \&PDL::clip; *clip = \&PDL::clip;
sub PDL::clip { sub PDL::clip {
my($x, $l, $h) = @_; my($x, $l, $h) = @_;
my $d; my $d;
unless(defined($l) || defined($h)) { unless(defined($l) || defined($h)) {
# Deal with pathological case # Deal with pathological case
if($x->is_inplace) { if($x->is_inplace) {
$x->set_inplace(0); $x->set_inplace(0);
return $x; return $x;
} else { } else {
skipping to change at line 1087 skipping to change at line 1085
} else,) { } else,) {
$avg() = tmp / norm; /* Find mean */ $avg() = tmp / norm; /* Find mean */
$min() = curmin; $min() = curmin;
$max() = curmax; $max() = curmax;
/* Calculate the RMS and standard deviation. */ /* Calculate the RMS and standard deviation. */
tmp = 0; tmp = 0;
loop(n) %{ loop(n) %{
if ($ISGOOD(a())) { if ($ISGOOD(a())) {
diff = $a()-$avg(); diff = $a()-$avg();
tmp += diff * diff * $w(); tmp += diff * diff * $w();
tmp1 += fabs(diff) * $w(); tmp1 += fabsl(diff) * $w();
} }
%} %}
$rms() = sqrt( tmp/norm ); $rms() = sqrt( tmp/norm );
if(norm>1) if(norm>1)
$prms() = sqrt( tmp/(norm-1) ); $prms() = sqrt( tmp/(norm-1) );
else else
PDL_IF_BAD($SETBAD(prms()),$prms() = 0); PDL_IF_BAD($SETBAD(prms()),$prms() = 0);
$adev() = tmp1 / norm ; $adev() = tmp1 / norm ;
}', }',
PMCode => ' PMCode=>pp_line_numbers(__LINE__, <<'EOPM'),
sub PDL::statsover { sub PDL::statsover {
barf(\'Usage: ($mean,[$prms, $median, $min, $max, $adev, $rms]) = statsover($ data,[$weights])\') if @_>2; barf('Usage: ($mean,[$prms, $median, $min, $max, $adev, $rms]) = statsover($d ata,[$weights])') if @_>2;
my ($data, $weights) = @_; my ($data, $weights) = @_;
$weights //= $data->ones(); $weights //= $data->ones();
my $median = $data->medover; my $median = $data->medover;
my $mean = PDL->nullcreate($data); my $mean = PDL->nullcreate($data);
my $rms = PDL->nullcreate($data); my $rms = PDL->nullcreate($data);
my $min = PDL->nullcreate($data); my $min = PDL->nullcreate($data);
my $max = PDL->nullcreate($data); my $max = PDL->nullcreate($data);
my $adev = PDL->nullcreate($data); my $adev = PDL->nullcreate($data);
my $prms = PDL->nullcreate($data); my $prms = PDL->nullcreate($data);
PDL::_statsover_int($data, $weights, $mean, $prms, $median, $min, $max, $adev , $rms); PDL::_statsover_int($data, $weights, $mean, $prms, $median, $min, $max, $adev , $rms);
wantarray ? ($mean, $prms, $median, $min, $max, $adev, $rms) : $mean; wantarray ? ($mean, $prms, $median, $min, $max, $adev, $rms) : $mean;
} }
', EOPM
Doc => ' Doc => '
=for ref =for ref
Calculate useful statistics over a dimension of an ndarray Calculate useful statistics over a dimension of an ndarray
=for usage =for usage
($mean,$prms,$median,$min,$max,$adev,$rms) = statsover($ndarray, $weights); ($mean,$prms,$median,$min,$max,$adev,$rms) = statsover($ndarray, $weights);
This utility function calculates various useful This utility function calculates various useful
skipping to change at line 1464 skipping to change at line 1462
# a number of constructors: fibonacci, append, axisvalues & # a number of constructors: fibonacci, append, axisvalues &
# random numbers # random numbers
########################################################### ###########################################################
pp_def('fibonacci', pp_def('fibonacci',
Pars => 'i(n); indx [o]x(n)', Pars => 'i(n); indx [o]x(n)',
Inplace => 1, Inplace => 1,
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Doc=>'Constructor - a vector with Fibonacci\'s sequence', Doc=>'Constructor - a vector with Fibonacci\'s sequence',
PMFunc=>'', PMFunc=>'',
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub fibonacci { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->fibonacci : PDL ->fibonacci(@_) } sub fibonacci { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->fibonacci : PDL ->fibonacci(@_) }
sub PDL::fibonacci{ sub PDL::fibonacci{
my $x = &PDL::Core::_construct; my $x = &PDL::Core::_construct;
my $is_inplace = $x->is_inplace; my $is_inplace = $x->is_inplace;
my ($in, $out) = $x->clump(-1); my ($in, $out) = $x->clump(-1);
$out = $is_inplace ? $in->inplace : PDL->null; $out = $is_inplace ? $in->inplace : PDL->null;
PDL::_fibonacci_int($in, $out); PDL::_fibonacci_int($in, $out);
$out; $out;
} }
EOD EOD
skipping to change at line 1494 skipping to change at line 1492
} }
%} %}
'); ');
pp_def('append', pp_def('append',
Pars => 'a(n); b(m); [o] c(mn)', Pars => 'a(n); b(m); [o] c(mn)',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
PMCode => pp_line_numbers(__LINE__-1, ' PMCode => pp_line_numbers(__LINE__-1, '
sub PDL::append { sub PDL::append {
my ($i1, $i2, $o) = map PDL->topdl($_), @_; my ($i1, $i2, $o) = map PDL->topdl($_), @_;
if (grep $_->isempty, $i1, $i2) { my $nempty = grep $_->isempty, $i1, $i2;
if ($nempty == 2) {
my @dims = $i1->dims;
$dims[0] += $i2->dim(0);
return PDL->zeroes($i1->type, @dims);
}
if ($nempty == 1) {
if (!defined $o) { if (!defined $o) {
return $i2->isnull ? PDL->zeroes(0) : $i2->copy if $i1->isempty; return $i2->isnull ? PDL->zeroes(0) : $i2->copy if $i1->isempty;
return $i1->isnull ? PDL->zeroes(0) : $i1->copy; return $i1->isnull ? PDL->zeroes(0) : $i1->copy;
} else { } else {
$o .= $i2->isnull ? PDL->zeroes(0) : $i2, return $o if $i1->isempty; $o .= $i2->isnull ? PDL->zeroes(0) : $i2, return $o if $i1->isempty;
$o .= $i1->isnull ? PDL->zeroes(0) : $i1, return $o; $o .= $i1->isnull ? PDL->zeroes(0) : $i1, return $o;
} }
} }
$o //= PDL->null; $o //= PDL->null;
PDL::_append_int($i1, $i2->convert($i1->type), $o); PDL::_append_int($i1, $i2->convert($i1->type), $o);
skipping to change at line 1811 skipping to change at line 1815
returned. returned.
See also: L</vsearch>. See also: L</vsearch>.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>. Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD EOD
); );
pp_def('unionvec', pp_def('unionvec',
Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = $SIZE(NA) + $SIZE(NB);', RedoDimsCode => '$SIZE(NC) = $SIZE(NA) + $SIZE(NB);',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::unionvec { sub PDL::unionvec {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($nc)); $c = PDL->null if (!defined($nc));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_unionvec_int($a,$b,$c,$nc); PDL::_unionvec_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
return $c->slice(",0:".($nc->max-1)); return $c->slice(",0:".($nc->max-1));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC; nci++) { for ( ; nci < sizeNC; nci++) {
if (nai < sizeNA && nbi < sizeNB) { if (nai < sizeNA && nbi < sizeNB) {
$CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval); $CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval);
} }
else if (nai < sizeNA) { cmpval = -1; } else if (nai < sizeNA) { cmpval = -1; }
else if (nbi < sizeNB) { cmpval = 1; } else if (nbi < sizeNB) { cmpval = 1; }
else { break; } else { break; }
skipping to change at line 1873 skipping to change at line 1877
In scalar context, slices $c() to the actual number of elements in the union In scalar context, slices $c() to the actual number of elements in the union
and returns the sliced PDL. and returns the sliced PDL.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>. Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD EOD
); );
pp_def('intersectvec', pp_def('intersectvec',
Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = PDLMIN($SIZE(NA),$SIZE(NB));', RedoDimsCode => '$SIZE(NC) = PDLMIN($SIZE(NA),$SIZE(NB));',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::intersectvec { sub PDL::intersectvec {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($c)); $c = PDL->null if (!defined($c));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_intersectvec_int($a,$b,$c,$nc); PDL::_intersectvec_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
my $nc_max = $nc->max; my $nc_max = $nc->max;
return ($nc_max > 0 return ($nc_max > 0
? $c->slice(",0:".($nc_max-1)) ? $c->slice(",0:".($nc_max-1))
: $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)])); : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) { for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) {
$CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval); $CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval);
// //
if (cmpval < 0) { if (cmpval < 0) {
//-- CASE: a < b //-- CASE: a < b
nai++; nai++;
} }
skipping to change at line 1931 skipping to change at line 1935
In scalar context, slices $c() to the actual number of elements in the intersect ion In scalar context, slices $c() to the actual number of elements in the intersect ion
and returns the sliced PDL. and returns the sliced PDL.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>. Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD EOD
); );
pp_def('setdiffvec', pp_def('setdiffvec',
Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = $SIZE(NA);', RedoDimsCode => '$SIZE(NC) = $SIZE(NA);',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::setdiffvec { sub PDL::setdiffvec {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($c)); $c = PDL->null if (!defined($c));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_setdiffvec_int($a,$b,$c,$nc); PDL::_setdiffvec_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
my $nc_max = $nc->max; my $nc_max = $nc->max;
return ($nc_max > 0 return ($nc_max > 0
? $c->slice(",0:".($nc_max-1)) ? $c->slice(",0:".($nc_max-1))
: $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)])); : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) { for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) {
$CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval); $CMPVEC($a(NA=>nai),$b(NB=>nbi),M,cmpval);
// //
if (cmpval < 0) { if (cmpval < 0) {
//-- CASE: a < b //-- CASE: a < b
loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %}
nai++; nai++;
skipping to change at line 2000 skipping to change at line 2004
pp_add_macros( pp_add_macros(
CMPVAL => sub { CMPVAL => sub {
my ($val1, $val2) = @_; my ($val1, $val2) = @_;
"(($val1) < ($val2) ? -1 : ($val1) > ($val2) ? 1 : 0)"; "(($val1) < ($val2) ? -1 : ($val1) > ($val2) ? 1 : 0)";
}, },
); );
pp_def('union_sorted', pp_def('union_sorted',
Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()', Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = $SIZE(NA) + $SIZE(NB);', RedoDimsCode => '$SIZE(NC) = $SIZE(NA) + $SIZE(NB);',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::union_sorted { sub PDL::union_sorted {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($c)); $c = PDL->null if (!defined($c));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_union_sorted_int($a,$b,$c,$nc); PDL::_union_sorted_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
return $c->slice("0:".($nc->max-1)); return $c->slice("0:".($nc->max-1));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC; nci++) { for ( ; nci < sizeNC; nci++) {
if (nai < sizeNA && nbi < sizeNB) { if (nai < sizeNA && nbi < sizeNB) {
cmpval = $CMPVAL($a(NA=>nai), $b(NB=>nbi)); cmpval = $CMPVAL($a(NA=>nai), $b(NB=>nbi));
} }
else if (nai < sizeNA) { cmpval = -1; } else if (nai < sizeNA) { cmpval = -1; }
else if (nbi < sizeNB) { cmpval = 1; } else if (nbi < sizeNB) { cmpval = 1; }
else { break; } else { break; }
skipping to change at line 2060 skipping to change at line 2064
In scalar context, reshapes $c() to the actual number of elements in the union a nd returns it. In scalar context, reshapes $c() to the actual number of elements in the union a nd returns it.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>. Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD EOD
); );
pp_def('intersect_sorted', pp_def('intersect_sorted',
Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()', Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = PDLMIN($SIZE(NA),$SIZE(NB));', RedoDimsCode => '$SIZE(NC) = PDLMIN($SIZE(NA),$SIZE(NB));',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::intersect_sorted { sub PDL::intersect_sorted {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($c)); $c = PDL->null if (!defined($c));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_intersect_sorted_int($a,$b,$c,$nc); PDL::_intersect_sorted_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
my $nc_max = $nc->max; my $nc_max = $nc->max;
return ($nc_max > 0 return ($nc_max > 0
? $c->slice("0:".($nc_max-1)) ? $c->slice("0:".($nc_max-1))
: $c->reshape(0, ($c->dims)[1..($c->ndims-1)])); : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) { for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) {
cmpval = $CMPVAL($a(NA=>nai),$b(NB=>nbi)); cmpval = $CMPVAL($a(NA=>nai),$b(NB=>nbi));
// //
if (cmpval < 0) { if (cmpval < 0) {
//-- CASE: a < b //-- CASE: a < b
nai++; nai++;
} }
skipping to change at line 2117 skipping to change at line 2121
In scalar context, reshapes $c() to the actual number of elements in the interse ction and returns it. In scalar context, reshapes $c() to the actual number of elements in the interse ction and returns it.
Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>. Contributed by Bryan Jurish E<lt>moocow@cpan.orgE<gt>.
EOD EOD
); );
pp_def('setdiff_sorted', pp_def('setdiff_sorted',
Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()', Pars => 'a(NA); b(NB); [o]c(NC); indx [o]nc()',
RedoDimsCode => '$SIZE(NC) = $SIZE(NA);', RedoDimsCode => '$SIZE(NC) = $SIZE(NA);',
PMCode=> q( PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::setdiff_sorted { sub PDL::setdiff_sorted {
my ($a,$b,$c,$nc) = @_; my ($a,$b,$c,$nc) = @_;
$c = PDL->null if (!defined($c)); $c = PDL->null if (!defined($c));
$nc = PDL->null if (!defined($nc)); $nc = PDL->null if (!defined($nc));
PDL::_setdiff_sorted_int($a,$b,$c,$nc); PDL::_setdiff_sorted_int($a,$b,$c,$nc);
return ($c,$nc) if (wantarray); return ($c,$nc) if (wantarray);
my $nc_max = $nc->max; my $nc_max = $nc->max;
return ($nc_max > 0 return ($nc_max > 0
? $c->slice("0:".($nc_max-1)) ? $c->slice("0:".($nc_max-1))
: $c->reshape(0, ($c->dims)[1..($c->ndims-1)])); : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
} }
), EOD
Code => q( Code => q(
PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC); PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE( NC);
int cmpval; int cmpval;
for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) { for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) {
cmpval = $CMPVAL($a(NA=>nai),$b(NB=>nbi)); cmpval = $CMPVAL($a(NA=>nai),$b(NB=>nbi));
// //
if (cmpval < 0) { if (cmpval < 0) {
//-- CASE: a < b //-- CASE: a < b
$c(NC=>nci) = $a(NA=>nai); $c(NC=>nci) = $a(NA=>nai);
nai++; nai++;
skipping to change at line 2217 skipping to change at line 2221
Seed random-number generator with a 64-bit int. Will generate seed data Seed random-number generator with a 64-bit int. Will generate seed data
for a number of threads equal to the return-value of for a number of threads equal to the return-value of
L<PDL::Core/online_cpus>. L<PDL::Core/online_cpus>.
=for usage =for usage
srand(); # uses current time srand(); # uses current time
srand(5); # fixed number e.g. for testing srand(5); # fixed number e.g. for testing
EOF EOF
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
*srand = \&PDL::srand; *srand = \&PDL::srand;
sub PDL::srand { PDL::_srand_int($_[0] // PDL::Core::seed()) } sub PDL::srand { PDL::_srand_int($_[0] // PDL::Core::seed()) }
EOD EOD
); );
pp_def( pp_def(
'random', 'random',
Pars=>'a();', Pars=>'[o] a();',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
PMFunc => '', PMFunc => '',
Code => <<'EOF', Code => <<'EOF',
PDL_MAYBE_SRAND PDL_MAYBE_SRAND
int rand_offset = -1; int rand_offset = -1;
broadcastloop %{ broadcastloop %{
PDL_RAND_SET_OFFSET(rand_offset, $PRIV(broadcast), $PDL(a)); PDL_RAND_SET_OFFSET(rand_offset, $PRIV(broadcast), $PDL(a));
$a() = pdl_drand(pdl_rand_state + 4*rand_offset); $a() = pdl_drand(pdl_rand_state + 4*rand_offset);
%} %}
EOF EOF
skipping to change at line 2256 skipping to change at line 2260
etc (see L<zeroes|PDL::Core/zeroes>). etc (see L<zeroes|PDL::Core/zeroes>).
This is the uniform distribution between 0 and 1 (assumedly This is the uniform distribution between 0 and 1 (assumedly
excluding 1 itself). The arguments are the same as C<zeroes> excluding 1 itself). The arguments are the same as C<zeroes>
(q.v.) - i.e. one can specify dimensions, types or give (q.v.) - i.e. one can specify dimensions, types or give
a template. a template.
You can use the PDL function L</srand> to seed the random generator. You can use the PDL function L</srand> to seed the random generator.
If it has not been called yet, it will be with the current time. If it has not been called yet, it will be with the current time.
EOF EOF
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub random { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->random : PDL->rand om(@_) } sub random { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->random : PDL->rand om(@_) }
sub PDL::random { sub PDL::random {
my $class = shift; my $class = shift;
unshift @_, double() if !ref($class) and !@_;
my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inpla ce; my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inpla ce;
PDL::_random_int($x); PDL::_random_int($x);
return $x; return $x;
} }
EOD EOD
); );
pp_def( pp_def(
'randsym', 'randsym',
Pars=>'a();', Pars=>'[o] a();',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
PMFunc => '', PMFunc => '',
Code => <<'EOF', Code => <<'EOF',
PDL_MAYBE_SRAND PDL_MAYBE_SRAND
int rand_offset = -1; int rand_offset = -1;
broadcastloop %{ broadcastloop %{
PDL_RAND_SET_OFFSET(rand_offset, $PRIV(broadcast), $PDL(a)); PDL_RAND_SET_OFFSET(rand_offset, $PRIV(broadcast), $PDL(a));
double tmp; double tmp;
do tmp = pdl_drand(pdl_rand_state + 4*rand_offset); while (tmp == 0.0); /* 0 < tmp < 1 */ do tmp = pdl_drand(pdl_rand_state + 4*rand_offset); while (tmp == 0.0); /* 0 < tmp < 1 */
$a() = tmp; $a() = tmp;
skipping to change at line 2301 skipping to change at line 2306
etc (see L<zeroes|PDL::Core/zeroes>). etc (see L<zeroes|PDL::Core/zeroes>).
This is the uniform distribution between 0 and 1 (excluding both 0 and This is the uniform distribution between 0 and 1 (excluding both 0 and
1, cf L</random>). The arguments are the same as C<zeroes> (q.v.) - 1, cf L</random>). The arguments are the same as C<zeroes> (q.v.) -
i.e. one can specify dimensions, types or give a template. i.e. one can specify dimensions, types or give a template.
You can use the PDL function L</srand> to seed the random generator. You can use the PDL function L</srand> to seed the random generator.
If it has not been called yet, it will be with the current time. If it has not been called yet, it will be with the current time.
EOF EOF
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub randsym { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->randsym : PDL->ra ndsym(@_) } sub randsym { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->randsym : PDL->ra ndsym(@_) }
sub PDL::randsym { sub PDL::randsym {
my $class = shift; my $class = shift;
unshift @_, double() if !ref($class) and !@_;
my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inpla ce; my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inpla ce;
PDL::_randsym_int($x); PDL::_randsym_int($x);
return $x; return $x;
} }
EOD EOD
); );
pp_add_exported('','grandom'); pp_add_exported('','grandom');
pp_addpm(<<'EOD'); pp_addpm(<<'EOD');
=head2 grandom =head2 grandom
skipping to change at line 2957 skipping to change at line 2963
############################################################### ###############################################################
# routines somehow related to interpolation # routines somehow related to interpolation
############################################################### ###############################################################
pp_def('interpolate', pp_def('interpolate',
HandleBad => 0, HandleBad => 0,
BadDoc => 'needs major (?) work to handles bad values', BadDoc => 'needs major (?) work to handles bad values',
Pars => 'real xi(); real x(n); y(n); [o] yi(); int [o] err()', Pars => 'real xi(); real x(n); y(n); [o] yi(); int [o] err()',
GenericTypes => $AF, GenericTypes => $AF,
PMCode => 'sub PDL::interpolate { PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub PDL::interpolate {
my ($xi, $x, $y, $yi, $err) = @_; my ($xi, $x, $y, $yi, $err) = @_;
croak "x must be real" if (ref($x) && ! $x->type->real); croak "x must be real" if (ref($x) && ! $x->type->real);
croak "xi must be real" if (ref($xi) && ! $xi->type->real ); croak "xi must be real" if (ref($xi) && ! $xi->type->real );
$yi //= PDL->null; $yi //= PDL->null;
$err //= PDL->null; $err //= PDL->null;
PDL::_interpolate_int($xi, $x, $y, $yi, $err); PDL::_interpolate_int($xi, $x, $y, $yi, $err);
($yi, $err); ($yi, $err);
}', }
EOD
Code => ' Code => '
$GENERIC() d; $GENERIC() d;
PDL_Indx n = $SIZE(n); PDL_Indx n = $SIZE(n);
PDL_Indx n1 = n-1; PDL_Indx n1 = n-1;
int up = ($x(n => n1) > $x(n => 0)); int up = ($x(n => n1) > $x(n => 0));
PDL_Indx jl, jh, m; PDL_Indx jl, jh, m;
int carp; int carp;
broadcastloop %{ broadcastloop %{
jl = -1; jl = -1;
skipping to change at line 3453 skipping to change at line 3461
EOD EOD
for ( for (
{Name=>'which', {Name=>'which',
Pars => 'mask(n); indx [o] inds(n); indx [o]lastout()', Pars => 'mask(n); indx [o] inds(n); indx [o]lastout()',
Variables => 'PDL_Indx dm=0;', Variables => 'PDL_Indx dm=0;',
Elseclause => "", Elseclause => "",
Outclause => '$lastout() = dm; while (dm < $SIZE(n)) $inds(n=>dm++) = - 1;', Outclause => '$lastout() = dm; while (dm < $SIZE(n)) $inds(n=>dm++) = - 1;',
Doc => $doc_which, Doc => $doc_which,
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub which { my ($this,$out) = @_; sub which { my ($this,$out) = @_;
$this = $this->flat; $this = $this->flat;
$out //= $this->nullcreate; $out //= $this->nullcreate;
PDL::_which_int($this,$out,my $lastout = $this->nullcreate); PDL::_which_int($this,$out,my $lastout = $this->nullcreate);
my $lastoutmax = $lastout->max->sclr; my $lastoutmax = $lastout->max->sclr;
$lastoutmax ? $out->slice('0:'.($lastoutmax-1))->sever : empty(in dx); $lastoutmax ? $out->slice('0:'.($lastoutmax-1))->sever : empty(in dx);
} }
*PDL::which = \&which; *PDL::which = \&which;
EOD EOD
}, },
{Name => 'which_both', {Name => 'which_both',
Pars => 'mask(n); indx [o] inds(n); indx [o]notinds(n); indx [o]lastout (); indx [o]lastoutn()', Pars => 'mask(n); indx [o] inds(n); indx [o]notinds(n); indx [o]lastout (); indx [o]lastoutn()',
Variables => 'PDL_Indx dm=0; int dm2=0;', Variables => 'PDL_Indx dm=0; int dm2=0;',
Elseclause => "else { \n \$notinds(n => dm2)=n; \n d m2++;\n }", Elseclause => "else { \n \$notinds(n => dm2)=n; \n d m2++;\n }",
Outclause => '$lastout() = dm; $lastoutn() = dm2; while (dm < $SIZE(n)) $inds(n=>dm++) = -1; while (dm2 < $SIZE(n)) $notinds(n=>dm2++) = -1;', Outclause => '$lastout() = dm; $lastoutn() = dm2; while (dm < $SIZE(n)) $inds(n=>dm++) = -1; while (dm2 < $SIZE(n)) $notinds(n=>dm2++) = -1;',
Doc => $doc_which_both, Doc => $doc_which_both,
PMCode=><<'EOD', PMCode=>pp_line_numbers(__LINE__, <<'EOD'),
sub which_both { my ($this,$outi,$outni) = @_; sub which_both { my ($this,$outi,$outni) = @_;
$this = $this->flat; $this = $this->flat;
$outi //= $this->nullcreate; $outi //= $this->nullcreate;
$outni //= $this->nullcreate; $outni //= $this->nullcreate;
PDL::_which_both_int($this,$outi,$outni,my $lastout = $this->null create,my $lastoutn = $this->nullcreate); PDL::_which_both_int($this,$outi,$outni,my $lastout = $this->null create,my $lastoutn = $this->nullcreate);
my $lastoutmax = $lastout->max->sclr; my $lastoutmax = $lastout->max->sclr;
$outi = $lastoutmax ? $outi->slice('0:'.($lastoutmax-1))->sever : empty(indx); $outi = $lastoutmax ? $outi->slice('0:'.($lastoutmax-1))->sever : empty(indx);
return $outi if !wantarray; return $outi if !wantarray;
my $lastoutnmax = $lastoutn->max->sclr; my $lastoutnmax = $lastoutn->max->sclr;
($outi, $lastoutnmax ? $outni->slice('0:'.($lastoutnmax-1))->seve r : empty(indx)); ($outi, $lastoutnmax ? $outni->slice('0:'.($lastoutnmax-1))->seve r : empty(indx));
skipping to change at line 3670 skipping to change at line 3678
L</whichND> returns N-D indices into a multidimensional PDL, from a mask. L</whichND> returns N-D indices into a multidimensional PDL, from a mask.
=cut =cut
sub PDL::whereND :lvalue { sub PDL::whereND :lvalue {
barf "Usage: whereND( \$pdl1, ..., \$pdlN, \$mask )\n" if @_ == 1; barf "Usage: whereND( \$pdl1, ..., \$pdlN, \$mask )\n" if @_ == 1;
my $mask = pop @_; # $mask has 0==false, 1==true my $mask = pop @_; # $mask has 0==false, 1==true
my @to_return; my @to_return;
my $n = PDL::sum($mask); my $n = PDL::sum($mask);
my $maskndims = $mask->ndims;
foreach my $arr (@_) { foreach my $arr (@_) {
my $sub_i = $mask * ones($arr);
my $where_sub_i = PDL::where($arr, $sub_i);
# count the number of dims in $mask and $arr # count the number of dims in $mask and $arr
# $mask = a b c d e f..... # $mask = a b c d e f.....
my @idims = dims($arr); my @idims = dims($arr);
# ...and pop off the number of dims in $mask splice @idims, 0, $maskndims; # pop off the number of dims in $mask
foreach ( dims($mask) ) { shift(@idims) }; if (!$n or $arr->isempty) {
push @to_return, PDL->zeroes($arr->type, $n, @idims);
next;
}
my $sub_i = $mask * ones($arr);
my $where_sub_i = PDL::where($arr, $sub_i);
my $ndim = 0; my $ndim = 0;
foreach my $id ($n, @idims[0..($#idims-1)]) { foreach my $id ($n, @idims[0..($#idims-1)]) {
$where_sub_i = $where_sub_i->splitdim($ndim++,$id) if $n>0; $where_sub_i = $where_sub_i->splitdim($ndim++,$id) if $n>0;
} }
push @to_return, $where_sub_i; push @to_return, $where_sub_i;
} }
return (@to_return == 1) ? $to_return[0] : @to_return; return (@to_return == 1) ? $to_return[0] : @to_return;
} }
*whereND = \&PDL::whereND; *whereND = \&PDL::whereND;
 End of changes. 38 change blocks. 
40 lines changed or deleted 52 lines changed or added
To the Perl Programs section of the PDL source changes report or the top of this page
Mainly generated by pkgdiff using rfcdiff
Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)