"Fossies" - the Fresh Open Source Software Archive  

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

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

primitive.pd  (PDL-2.078):primitive.pd  (PDL-2.079)
skipping to change at line 65 skipping to change at line 65
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Code => Code =>
'double tmp = 0; 'double tmp = 0;
int badflag = 0; int badflag = 0;
loop(n) %{ loop(n) %{
PDL_IF_BAD(if (!($ISGOOD(a()) && $ISGOOD(b()))) { badflag = 1; break; } PDL_IF_BAD(if (!($ISGOOD(a()) && $ISGOOD(b()))) { badflag = 1; break; }
else,) { tmp += $a() * $b(); } else,) { tmp += $a() * $b(); }
%} %}
PDL_IF_BAD(if (badflag) { $SETBAD(c()); $PDLSTATESETBAD(c); } PDL_IF_BAD(if (badflag) { $SETBAD(c()); $PDLSTATESETBAD(c); }
else,) { $c() = tmp; }', else,) { $c() = tmp; }',
CopyBadStatusCode => '',
Doc => ' Doc => '
=for ref =for ref
Inner product over one dimension Inner product over one dimension
c = sum_i a_i * b_i c = sum_i a_i * b_i
=cut
', ',
BadDoc => ' BadDoc => '
=for bad =for bad
If C<a() * b()> contains only bad data, If C<a() * b()> contains only bad data,
C<c()> is set bad. Otherwise C<c()> will have its bad flag cleared, C<c()> is set bad. Otherwise C<c()> will have its bad flag cleared,
as it will not contain any bad values. as it will not contain any bad values.
=cut
', ',
); # pp_def( inner ) ); # pp_def( inner )
pp_def( pp_def(
'outer', 'outer',
HandleBad => 1, HandleBad => 1,
Pars => 'a(n); b(m); [o]c(n,m);', Pars => 'a(n); b(m); [o]c(n,m);',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Code => Code =>
'loop(n,m) %{ 'loop(n,m) %{
skipping to change at line 1037 skipping to change at line 1028
wtsum += $wt(); wtsum += $wt();
tmp=1; tmp=1;
for(i=0; i<$COMP(deg); i++) for(i=0; i<$COMP(deg); i++)
tmp *= $a(); tmp *= $a();
statsum += $wt() * (tmp - $avg()); statsum += $wt() * (tmp - $avg());
flag = 1; flag = 1;
} }
%} %}
PDL_IF_BAD(if (!flag) { $SETBAD(b()); $PDLSTATESETBAD(b); } PDL_IF_BAD(if (!flag) { $SETBAD(b()); $PDLSTATESETBAD(b); }
else,) { $b() = statsum / wtsum; }', else,) { $b() = statsum / wtsum; }',
CopyBadStatusCode => '',
Doc => ' Doc => '
=for ref =for ref
Weighted statistical moment of given degree Weighted statistical moment of given degree
This calculates a weighted statistic over the vector C<a>. This calculates a weighted statistic over the vector C<a>.
The formula is The formula is
b() = (sum_i wt_i * (a_i ** degree - avg)) / (sum_i wt_i) b() = (sum_i wt_i * (a_i ** degree - avg)) / (sum_i wt_i)
', ',
skipping to change at line 1107 skipping to change at line 1097
tmp1 += fabs(diff) * $w(); tmp1 += fabs(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 ;
}', }',
CopyBadStatusCode => '',
PMCode => ' PMCode => '
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($ data,[$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);
skipping to change at line 1589 skipping to change at line 1578
only two ndarrays along their first dimension, and only two ndarrays along their first dimension, and
L<cat|PDL::Core/cat>, which can append more than two ndarrays that all L<cat|PDL::Core/cat>, which can append more than two ndarrays that all
have the same sized dimensions. have the same sized dimensions.
=cut =cut
sub PDL::glue{ sub PDL::glue{
my($x) = shift; my($x) = shift;
my($dim) = shift; my($dim) = shift;
if(defined $x && !(ref $x)) { ($dim, $x) = ($x, $dim) if defined $x && !ref $x;
my $y = $dim; confess 'dimension must be Perl scalar' if ref $dim;
$dim = $x;
$x = $y;
}
if(!defined $x || $x->nelem==0) { if(!defined $x || $x->nelem==0) {
return $x unless(@_); return $x unless(@_);
return shift() if(@_<=1); return shift() if(@_<=1);
$x=shift; $x=shift;
return PDL::glue($x,$dim,@_); return PDL::glue($x,$dim,@_);
} }
if($dim - $x->dim(0) > 100) { if($dim - $x->dim(0) > 100) {
print STDERR "warning:: PDL::glue allocating >100 dimensions!\n"; print STDERR "warning:: PDL::glue allocating >100 dimensions!\n";
skipping to change at line 1633 skipping to change at line 1619
EOD EOD
pp_def( 'axisvalues', pp_def( 'axisvalues',
Pars => 'i(n); [o]a(n)', Pars => 'i(n); [o]a(n)',
Inplace => 1, Inplace => 1,
Code => 'loop(n) %{ $a() = n; %}', Code => 'loop(n) %{ $a() = n; %}',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Doc => undef, Doc => undef,
); # pp_def: axisvalues ); # pp_def: axisvalues
pp_def(
'cmpvec',
HandleBad => 1,
Pars => 'a(n); b(n); sbyte [o]c();',
Code => '
char anybad = 0;
broadcastloop %{
$c() = 0;
loop(n) %{
PDL_IF_BAD(if ($ISBAD(a()) || $ISBAD(b())) { $SETBAD(c()); anybad = 1;
break; }
else,) if ($a() != $b()) { $c() = $a() < $b() ? -1 : 1; break; }
%}
%}
PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(c);,)
',
Doc => '
=for ref
Compare two vectors lexicographically, returning -1 if a is less, 1 if
greater, 0 if equal.
',
BadDoc => '
The output is bad if any input values up to the point of inequality are
bad - any after are ignored.
',
);
pp_def(
'eqvec',
HandleBad => 1,
Pars => 'a(n); b(n); sbyte [o]c();',
Code => '
char anybad = 0;
broadcastloop %{
$c() = 1;
loop(n) %{
PDL_IF_BAD(if ($ISBAD(a()) || $ISBAD(b())) { $SETBAD(c()); anybad = 1;
break; }
else,) if ($a() != $b()) { $c() = 0; PDL_IF_BAD(,break;) }
%}
%}
PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(c);,)
',
Doc => '
=for ref
Compare two vectors, returning 1 if equal, 0 if not equal.
',
BadDoc => 'The output is bad if any input values are bad.',
);
pp_addhdr(<<'EOH'); pp_addhdr(<<'EOH');
extern int pdl_srand_threads; extern int pdl_srand_threads;
extern uint64_t *pdl_rand_state; extern uint64_t *pdl_rand_state;
void pdl_srand(uint64_t **s, uint64_t seed, int n); void pdl_srand(uint64_t **s, uint64_t seed, int n);
double pdl_drand(uint64_t *s); double pdl_drand(uint64_t *s);
#define PDL_MAYBE_SRAND \ #define PDL_MAYBE_SRAND \
if (pdl_srand_threads < 0) \ if (pdl_srand_threads < 0) \
pdl_srand(&pdl_rand_state, PDL->pdl_seed(), PDL->online_cpus()); pdl_srand(&pdl_rand_state, PDL->pdl_seed(), PDL->online_cpus());
#define PDL_RAND_SET_OFFSET(v, thr, pdl) \ #define PDL_RAND_SET_OFFSET(v, thr, pdl) \
if (v < 0) { \ if (v < 0) { \
skipping to change at line 2894 skipping to change at line 2930
pdl> ($big, $small) = which_both($x >= 5); p "$big\n$small" pdl> ($big, $small) = which_both($x >= 5); p "$big\n$small"
[5 6 7 8 9] [5 6 7 8 9]
[0 1 2 3 4] [0 1 2 3 4]
=cut =cut
EOD EOD
for ( for (
{Name=>'which', {Name=>'which',
Pars => 'mask(n); indx [o] inds(m);', Pars => 'mask(n); indx [o] inds(n); indx [o]lastout()',
Variables => 'int dm=0;', Variables => 'PDL_Indx dm=0;',
Elseclause => "", Elseclause => "",
Autosize => '$SIZE(m) = sum;', Outclause => '$lastout() = dm; while (dm < $SIZE(n)) $inds(n=>dm++) = - 1;',
Doc => $doc_which, Doc => $doc_which,
PMCode=><<'EOD', PMCode=><<'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); PDL::_which_int($this,$out,my $lastout = $this->nullcreate);
return $out; my $lastoutmax = $lastout->max->sclr;
$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(m); indx [o]notinds(q)', Pars => 'mask(n); indx [o] inds(n); indx [o]notinds(n); indx [o]lastout
Variables => 'int dm=0; int dm2=0;', (); indx [o]lastoutn()',
Elseclause => "else { \n \$notinds(q => dm2)=n; \n d Variables => 'PDL_Indx dm=0; int dm2=0;',
m2++;\n }", Elseclause => "else { \n \$notinds(n => dm2)=n; \n d
Autosize => '$SIZE(m) = sum;'."\n".' $SIZE(q) = dpdl->dims[0 m2++;\n }",
]-sum;', 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=><<'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); PDL::_which_both_int($this,$outi,$outni,my $lastout = $this->null
return wantarray ? ($outi,$outni) : $outi; create,my $lastoutn = $this->nullcreate);
my $lastoutmax = $lastout->max->sclr;
$outi = $lastoutmax ? $outi->slice('0:'.($lastoutmax-1))->sever :
empty(indx);
return $outi if !wantarray;
my $lastoutnmax = $lastoutn->max->sclr;
($outi, $lastoutnmax ? $outni->slice('0:'.($lastoutnmax-1))->seve
r : empty(indx));
} }
*PDL::which_both = \&which_both; *PDL::which_both = \&which_both;
EOD EOD
} }
) )
{ {
my $code = $_->{Variables} .'
loop(n) %{
if ( $mask() PDL_IF_BAD(&& $ISGOOD($mask()),) ) {
$inds(m => dm) = n;
dm++;
}'.$_->{Elseclause}.'
%}';
pp_def($_->{Name}, pp_def($_->{Name},
HandleBad => 1, HandleBad => 1,
Doc => $_->{Doc}, Doc => $_->{Doc},
Pars => $_->{Pars}, Pars => $_->{Pars},
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
PMCode => $_->{PMCode}, PMCode => $_->{PMCode},
Code => $code, Code => $_->{Variables} .'
# the next one is currently a dirty hack loop(n) %{
# this will probably break once dataflow is enabled again if ( $mask() PDL_IF_BAD(&& $ISGOOD($mask()),) ) {
# *unless* we have made sure that mask is physical by now!!! $inds(n => dm) = n;
RedoDimsCode => ' dm++;
PDL_Indx sum = 0; }'.$_->{Elseclause}.'
/* not sure if this is necessary */ %}'.$_->{Outclause},
pdl * dpdl = $PDL(mask); );
$GENERIC() *m_datap = (($GENERIC() *)(PDL_REPRP(dpdl)));
PDL_Indx inc = PDL_REPRINC(dpdl,0);
PDL_Indx offs = PDL_REPROFFS(dpdl);
PDL_Indx i;
if (dpdl->ndims != 1)
$CROAK("dimflag currently works only with 1D pdls");
if(dpdl->state & PDL_BADVAL)
for (i=0; i<dpdl->dims[0]; i++) {
$GENERIC() foo = *(m_datap+inc*i+offs);
if(foo && $ISGOODVAR(foo,mask) )sum++;
}
else
for (i=0; i<dpdl->dims[0]; i++) {
$GENERIC() foo = *(m_datap+inc*i+offs);
if(foo) sum++;
}
'. $_->{Autosize}
);
} }
pp_add_exported("", 'where'); pp_add_exported("", 'where');
pp_addpm(<<'EOD'); pp_addpm(<<'EOD');
=head2 where =head2 where
=for ref =for ref
Use a mask to select values from one or more data PDLs Use a mask to select values from one or more data PDLs
 End of changes. 16 change blocks. 
65 lines changed or deleted 85 lines changed or added

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