(Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).
| bad.pd (PDL-2.082) | : | bad.pd (PDL-2.083) |
|---|
| | |
| skipping to change at line 28 | | skipping to change at line 28 |
|---|
| ## Header | | ## Header |
| pp_addpm({At=>'Top'},<<'!NO!SUBS!'); | | pp_addpm({At=>'Top'},<<'!NO!SUBS!'); |
| | |
| =head1 NAME | | =head1 NAME |
| | |
| PDL::Bad - PDL always processes bad values | | PDL::Bad - PDL always processes bad values |
| | |
| =head1 DESCRIPTION | | =head1 DESCRIPTION |
| | |
| This module is loaded when you do C<use PDL>, | | This module is loaded when you do C<use PDL>, |
|
| C<Use PDL::Lite> or C<PDL::LiteF>. | | C<use PDL::Lite> or C<use PDL::LiteF>. |
| | |
| Implementation details are given in | | Implementation details are given in |
| L<PDL::BadValues>. | | L<PDL::BadValues>. |
| | |
| =head1 SYNOPSIS | | =head1 SYNOPSIS |
| | |
| use PDL::Bad; | | use PDL::Bad; |
| print "\nBad value per PDL support in PDL is turned " . | | print "\nBad value per PDL support in PDL is turned " . |
| $PDL::Bad::PerPdl ? "on" : "off" . ".\n"; | | $PDL::Bad::PerPdl ? "on" : "off" . ".\n"; |
| | |
| | |
| skipping to change at line 79 | | skipping to change at line 79 |
|---|
| use strict; | | use strict; |
| | |
| use PDL::Types; | | use PDL::Types; |
| use PDL::Primitive; | | use PDL::Primitive; |
| | |
| ############################################################ | | ############################################################ |
| ############################################################ | | ############################################################ |
| | |
| !NO!SUBS! | | !NO!SUBS! |
| | |
|
| # we want the following to be in PDL, not PDL::Bad, hence | | |
| my $xshdr = "MODULE = PDL::Bad PACKAGE = PDL"; | | |
| | |
| pp_addxs( <<"!WITH!SUBS!"); | | |
| $xshdr | | |
| | |
| int | | |
| badflag(x,newval=0) | | |
| pdl *x | | |
| int newval | | |
| CODE: | | |
| if (items>1) | | |
| PDL->propagate_badflag( x, newval ); | | |
| RETVAL = ((x->state & PDL_BADVAL) > 0); | | |
| OUTPUT: | | |
| RETVAL | | |
| | |
| !WITH!SUBS! | | |
| | | |
| pp_addpm(<<'!NO!SUBS!'); | | pp_addpm(<<'!NO!SUBS!'); |
| ############################################################ | | ############################################################ |
| ############################################################ | | ############################################################ |
| | |
| *badflag = \&PDL::badflag; | | *badflag = \&PDL::badflag; |
| *badvalue = \&PDL::badvalue; | | *badvalue = \&PDL::badvalue; |
| *orig_badvalue = \&PDL::orig_badvalue; | | *orig_badvalue = \&PDL::orig_badvalue; |
| | |
| ############################################################ | | ############################################################ |
| ############################################################ | | ############################################################ |
| | |
| skipping to change at line 235 | | skipping to change at line 216 |
|---|
| *check_badflag = \&PDL::check_badflag; | | *check_badflag = \&PDL::check_badflag; |
| | |
| sub PDL::check_badflag { | | sub PDL::check_badflag { |
| my $pdl = shift; | | my $pdl = shift; |
| $pdl->badflag(0) if $pdl->badflag and $pdl->nbad == 0; | | $pdl->badflag(0) if $pdl->badflag and $pdl->nbad == 0; |
| return $pdl->badflag; | | return $pdl->badflag; |
| } # sub: check_badflag() | | } # sub: check_badflag() |
| | |
| !NO!SUBS! | | !NO!SUBS! |
| | |
|
| my $str = <<'EOF'; | | pp_addxs(<<'EOF'); |
| pdl * | | pdl * |
| _badvalue_int(val, type) | | _badvalue_int(val, type) |
| PDL_Anyval val | | PDL_Anyval val |
| int type | | int type |
| CODE: | | CODE: |
| { | | { |
| PDL_Anyval newval = {type, {0}}; | | PDL_Anyval newval = {type, {0}}; |
| pdl* p = PDL->scalar(newval); | | pdl* p = PDL->scalar(newval); |
| if (!p) PDL->pdl_barf("Error making new pdl"); | | if (!p) PDL->pdl_barf("Error making new pdl"); |
| if ( val.type != -1 ) { | | if ( val.type != -1 ) { |
| | |
| skipping to change at line 307 | | skipping to change at line 288 |
|---|
| if (!p) PDL->pdl_barf("Error making new pdl"); | | if (!p) PDL->pdl_barf("Error making new pdl"); |
| #define X(datatype, ctype, ppsym, shortctype, defbval, ...) \ | | #define X(datatype, ctype, ppsym, shortctype, defbval, ...) \ |
| *((ctype *)p->data) = defbval; | | *((ctype *)p->data) = defbval; |
| PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, type, X, croak("Not a known data type c
ode=%d", type)) | | PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, type, X, croak("Not a known data type c
ode=%d", type)) |
| #undef X | | #undef X |
| RETVAL = p; | | RETVAL = p; |
| OUTPUT: | | OUTPUT: |
| RETVAL | | RETVAL |
| EOF | | EOF |
| | |
|
| pp_addxs( "\n$xshdr\n\n$str\n" ); | | |
| | | |
| pp_addpm(<<'!NO!SUBS!'); | | pp_addpm(<<'!NO!SUBS!'); |
| | |
| # note: | | # note: |
| # if sent an ndarray, we have to change its bad values | | # if sent an ndarray, we have to change its bad values |
| # (but only if it contains bad values) | | # (but only if it contains bad values) |
| # - there's a slight overhead in that the badflag is | | # - there's a slight overhead in that the badflag is |
| # cleared and then set (hence propagating to all | | # cleared and then set (hence propagating to all |
| # children) but we'll ignore that) | | # children) but we'll ignore that) |
| # - we can ignore this for float/double types | | # - we can ignore this for float/double types |
| # since we can't change the bad value | | # since we can't change the bad value |
| | |
| skipping to change at line 330 | | skipping to change at line 309 |
|---|
| sub PDL::badvalue { | | sub PDL::badvalue { |
| no strict 'refs'; | | no strict 'refs'; |
| my ( $self, $val ) = @_; | | my ( $self, $val ) = @_; |
| my $num; | | my $num; |
| if ( UNIVERSAL::isa($self,"PDL") ) { | | if ( UNIVERSAL::isa($self,"PDL") ) { |
| $num = $self->get_datatype; | | $num = $self->get_datatype; |
| if ( $num < $PDL_F && defined($val) && $self->badflag ) { | | if ( $num < $PDL_F && defined($val) && $self->badflag ) { |
| $self->inplace->setbadtoval( $val ); | | $self->inplace->setbadtoval( $val ); |
| $self->badflag(1); | | $self->badflag(1); |
| } | | } |
|
| return PDL::_badvalue_per_pdl_int($self, $val, $num); | | return PDL::Bad::_badvalue_per_pdl_int($self, $val, $num); |
| } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) { | | } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) { |
| $num = $self->enum; | | $num = $self->enum; |
| } else { | | } else { |
| # assume it's a number | | # assume it's a number |
| $num = $self; | | $num = $self; |
| } | | } |
|
| PDL::_badvalue_int( $val, $num ); | | PDL::Bad::_badvalue_int( $val, $num ); |
| } | | } |
| | |
| sub PDL::orig_badvalue { | | sub PDL::orig_badvalue { |
| no strict 'refs'; | | no strict 'refs'; |
| my $self = shift; | | my $self = shift; |
| my $num; | | my $num; |
| if ( UNIVERSAL::isa($self,"PDL") ) { | | if ( UNIVERSAL::isa($self,"PDL") ) { |
| $num = $self->get_datatype; | | $num = $self->get_datatype; |
| } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) { | | } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) { |
| $num = $self->enum; | | $num = $self->enum; |
| } else { | | } else { |
| # assume it's a number | | # assume it's a number |
| $num = $self; | | $num = $self; |
| } | | } |
|
| PDL::_default_badvalue_int($num); | | PDL::Bad::_default_badvalue_int($num); |
| } | | } |
| | |
| ############################################################ | | ############################################################ |
| ############################################################ | | ############################################################ |
| | |
| !NO!SUBS! | | !NO!SUBS! |
| | |
| pp_def('isbad' . <<'=cut', | | pp_def('isbad' . <<'=cut', |
| | |
| =head2 isbad | | =head2 isbad |
| | | |
| End of changes. 7 change blocks. |
|---|
| 26 lines changed or deleted | | 5 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 