view release on metacpan or  search on metacpan

Basic/Bad/bad.pd  view on Meta::CPAN

returns the original value used to represent bad values for
a given type.

This routine operates the same as L<badvalue|/badvalue>,
except you can not change the values.

It also has an I<awful> name.

=for example

   $orig_badval = orig_badvalue( float );
   $a = ones(ushort,10);
   print "The original bad data value for ushort is: ", 
      $a->orig_badvalue(), "\n";

=for bad

This method does not care if you call it on an input piddle
that has bad values. It always returns a Perl scalar
with the original bad value for the associated type.

=head2 check_badflag

=for ref

Clear the bad-value flag of a piddle if it does not
contain any bad values

Given a piddle whose bad flag is set, check whether it
actually contains any bad values and, if not, clear the flag.
It returns the final state of the bad-value flag.

=for example

 print "State of bad flag == ", $pdl->check_badflag;

=for bad

This method accepts piddles with or without bad values. It
returns a Perl scalar with the final bad-value flag, so it
never returns bad values itself.

=cut

*check_badflag = \&PDLA::check_badflag;

sub PDLA::check_badflag {
    my $pdl = shift;
    $pdl->badflag(0) if $pdl->badflag and $pdl->nbad == 0;
    return $pdl->badflag;
} # sub: check_badflag()

!NO!SUBS!

pp_addhdr <<'EOHDR';
static pdl* new_pdlscalar(int datatype)
       {
         pdl *p = PDLA->pdlnew();
         PDLA->setdims (p, NULL, 0);  /* set dims */
         p->datatype = datatype;         /* and data type */
         PDLA->allocdata (p);             /* allocate the data chunk */

         return p;
       }
EOHDR

use PDLA::Types;
my $ntypes = $#PDLA::Types::names;

my $str;
foreach my $i ( 0 .. $ntypes ) {
    my $type = PDLA::Type->new( $i );
    my $ctype = $type->ctype;
    my $realctype = $type->realctype;
    my $typesym = $type->symbol;

    my $cname = $type->ctype;
    $cname =~ s/^PDLA_//;
    my $storage = "PDLA->bvals.$cname";

    my $init_code = << "EOC";
    pdl* p;
    $ctype *data;
    p = new_pdlscalar($typesym);
    data = ($ctype *) p->data;

EOC

    my $set_code = "if ( items > 0 ) { $storage = ($realctype) val; }";

    # if UseNaN is true, then we can not change the value used to
    # represent bad elements since it's a NaN. At least, not for
    # for floating point types
    # - is there a better way of checking for the condition since
    #   the current one needs to be changed whenever the types are changed
    #
    $set_code = "" if $usenan and ($type->ppsym eq "F" or $type->ppsym eq "D");

    $str .=
"
pdl *
_badvalue_int${i}(val=0)
    double val
  CODE:
   {
    $init_code
    $set_code
    *data = ($ctype) $storage;
    RETVAL = p;
   }
  OUTPUT:
    RETVAL

pdl *
_badvalue_per_pdl_int${i}(pdl_val, val=0)
    pdl* pdl_val
    double val
  CODE:
   {
    $init_code
    if ( items > 1 ) {