view release on metacpan or  search on metacpan

lib/PDL/Core.pm  view on Meta::CPAN

  my ($item, $sofar) = @_;
  barf("Error: $sofar > max type value($MAX_TYPE)") if $sofar > $MAX_TYPE;
  return $sofar if $sofar == $MAX_TYPE;
  return $PDL_CD if UNIVERSAL::isa($item, 'Math::Complex');
  return max($item->type->enum, $sofar) if UNIVERSAL::isa($item, 'PDL');
  return $PDL_D if ref($item) ne 'ARRAY';
  #  only need to check first item for an array of complex vals
  return $MAX_TYPE if _establish_type($item->[0], $sofar) == $MAX_TYPE;
  #  only need to recurse for items that are refs
  #  as $sofar will be $PDL_D at a minimum
  max ($sofar, map _establish_type($_, $sofar), grep ref, @$item);
}

sub PDL::new {
   return $_[0]->copy if ref($_[0]) and UNIVERSAL::isa($_[0], 'PDL');
   my $this = shift;
   my $type = ref($_[0]) eq 'PDL::Type' ? shift->enum : undef;
   my $value = (@_ > 1 ? [@_] : shift);
   unless(defined $value) {
       if($PDL::debug) {
	   print STDERR "Warning: PDL::new converted undef to \$PDL::undefval ($PDL::undefval)\n";
       }
       $value = ($PDL::undefval//0)+0
   }
   $type //= ref($value) ? _establish_type($value, $PDL_D) : $PDL_D;

   return pdl_avref($value,$this,$type) if ref($value) eq "ARRAY";
   my $new = $this->initialize;
   $new->set_datatype($type);

   if (ref(\$value) eq "SCALAR") {
      # The string processing is extremely slow. Benchmarks indicated that it
      # takes 10x longer to process a scalar number compared with normal Perl
      # conversion of a string to a number. So, only use the string processing
      # if the input looks like a real string, i.e. it doesn't look like a plain
      # number. Note that for our purposes, looks_like_number incorrectly
      # handles the strings 'inf' and 'nan' on Windows machines. We want to send
      # those to the string processing, so this checks for them in a way that
      # short-circuits the looks_like_number check.
      if (PDL::Core::is_scalar_SvPOK($value)
            and ($value =~ /inf/i or $value =~ /nan/i
               or !Scalar::Util::looks_like_number($value))) {
         # new was passed a string argument that doesn't look like a number
         # so we can process as a Matlab-style data entry format.
		return PDL::Core::new_pdl_from_string($new,$value,$this,$type);
      } elsif (! $CAN_PACK_QUAD && $pack[$new->get_datatype] =~ /^q\*$/i ) {
         # special case when running on a perl without 64bit int support
         # we have to avoid pack("q", ...) in this case
         # because it dies with error: "Invalid type 'q' in pack"
         $new->setdims([]);
         set_c($new, [0], $value);
      } elsif (! $CAN_PACK_D && $pack[$new->get_datatype] =~ /^(\QD*\E|\Q(DD)*\E)$/ ) {
         # if "D" is not available for pack(),
         # it dies with error: "Invalid type 'D' in pack".
         $new->setdims([]);
         set_c($new, [0], $value);
      } else {
         $new->setdims([]);
         if ($value) {
           $new->update_data_from( pack $pack[$new->get_datatype], $value );
         } else { # do nothing if 0 - allocdata already memsets to 0
           $new->make_physical;
         }
      }
   }
   elsif (blessed($value) and UNIVERSAL::isa($value, 'Math::Complex')) {
      $new->setdims([]);
      set_c($new, [], $value);
   }
   elsif (blessed($value)) { # Object
      $new = $value->copy;
   }
   else {
      barf("Can not interpret argument $value of type ".ref($value) );
   }
   $new;
}


=head2 copy

=for ref

Make a physical copy of an ndarray

=for usage

 $new = $old->copy;

Since C<$new = $old> just makes a new reference, the
C<copy> method is provided to allow real independent
copies to be made.

=cut

sub PDL::copy {
    my $value = shift;
    barf("Argument is an ".ref($value)." not an object") unless blessed($value);
    return $value->nullcreate if $value->isnull;
    # broadcastI(-1,[]) is just an identity vafftrans with broadcastid copying ;)
    my $is_inplace = $value->is_inplace;
    $value->set_inplace(0) if $is_inplace;
    my $ret = $value->broadcastI(-1,[])->sever;
    $value->set_inplace(1) if $is_inplace;
    $ret;
}

=head2 hdr_copy

=for ref

Return an explicit copy of the header of a PDL.

hdr_copy is just a wrapper for the internal routine _hdr_copy, which
takes the hash ref itself.  That is the routine which is used to make
copies of the header during normal operations if the hdrcpy() flag of
a PDL is set.

General-purpose deep copies are expensive in perl, so some simple
optimization happens: