"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Core/Core.pm" 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).

Core.pm  (PDL-2.082)	:	Core.pm  (PDL-2.083)
skipping to change at line 32		skipping to change at line 32
# If "D" is available for pack().		# If "D" is available for pack().
our $CAN_PACK_D = !! eval { my $packed = pack "D", 0; 1 };		our $CAN_PACK_D = !! eval { my $packed = pack "D", 0; 1 };
our @EXPORT = qw( piddle pdl null barf ); # Only stuff always exported!		our @EXPORT = qw( piddle pdl null barf ); # Only stuff always exported!
my @convertfuncs = map $_->convertfunc, PDL::Types::types();		my @convertfuncs = map $_->convertfunc, PDL::Types::types();
my @exports_internal = qw(howbig broadcastids topdl);		my @exports_internal = qw(howbig broadcastids topdl);
my @exports_normal = (@EXPORT,		my @exports_normal = (@EXPORT,
@convertfuncs,		@convertfuncs,
qw(nelem dims shape null		qw(nelem dims shape null
empty dup dupN inflateN		empty dup dupN inflateN
		badflag
convert inplace zeroes zeros ones nan inf i list listindices unpdl		convert inplace zeroes zeros ones nan inf i list listindices unpdl
set at flows broadcast_define over reshape dog cat barf type		set at flows broadcast_define over reshape dog cat barf type
thread_define dummy mslice approx flat sclr squeeze		thread_define dummy mslice approx flat sclr squeeze
get_autopthread_targ set_autopthread_targ get_autopthread_actual		get_autopthread_targ set_autopthread_targ get_autopthread_actual
get_autopthread_dim get_autopthread_size set_autopthread_size) );		get_autopthread_dim get_autopthread_size set_autopthread_size) );
our @EXPORT_OK = (@exports_internal, @exports_normal);		our @EXPORT_OK = (@exports_internal, @exports_normal);
our %EXPORT_TAGS = (		our %EXPORT_TAGS = (
Func => [@exports_normal],		Func => [@exports_normal],
Internal => [@exports_internal] );		Internal => [@exports_internal] );
skipping to change at line 64		skipping to change at line 65
$PDL::indxformat = "%12d"; # Default print format for PDL_Indx values		$PDL::indxformat = "%12d"; # Default print format for PDL_Indx values
$PDL::undefval = 0; # Value to use instead of undef when creating PDL s		$PDL::undefval = 0; # Value to use instead of undef when creating PDL s
$PDL::toolongtoprint = 10000; # maximum pdl size to stringify for printing		$PDL::toolongtoprint = 10000; # maximum pdl size to stringify for printing
################ Exportable functions of the Core ######################		################ Exportable functions of the Core ######################
*at_c = *at_bad_c; # back-compat alias		*at_c = *at_bad_c; # back-compat alias
*thread_define = *broadcast_define;		*thread_define = *broadcast_define;
*PDL::threadover_n = *PDL::broadcastover_n;		*PDL::threadover_n = *PDL::broadcastover_n;
*dup = \&PDL::dup; *dupN = \&PDL::dupN;
*howbig = \&PDL::howbig; *unpdl = \&PDL::unpdl;
*nelem = \&PDL::nelem; *inplace = \&PDL::inplace;
*dims = \&PDL::dims; *list = \&PDL::list;
*broadcastids = \&PDL::broadcastids; *listindices = \&PDL::listindices;
*null = \&PDL::null; *set = \&PDL::set;
*at = \&PDL::at; *flows = \&PDL::flows;
*sclr = \&PDL::sclr; *shape = \&PDL::shape;
for my $t (PDL::Types::types()) {		for my $t (PDL::Types::types()) {
my $conv = $t->convertfunc;		my $conv = $t->convertfunc;
no strict 'refs';		no strict 'refs';
*$conv = *{"PDL::$conv"} = sub {		*$conv = *{"PDL::$conv"} = sub {
return $t unless @_;		return $t unless @_;
alltopdl('PDL', (@_>1 ? [@_] : shift), $t);		alltopdl('PDL', (@_>1 ? [@_] : shift), $t);
};		};
}		}
BEGIN {		BEGIN {
*broadcast_define = \&PDL::broadcast_define;		for (qw(
*convert = \&PDL::convert; *over = \&PDL::over;		inflateN badflag dup dupN howbig unpdl nelem inplace dims
*dog = \&PDL::dog; *cat = \&PDL::cat;		list broadcastids listindices null set at flows sclr shape
*type = \&PDL::type; *approx = \&PDL::approx;		broadcast_define convert over dog cat mslice
*dummy = \&PDL::dummy;		type approx dummy isempty string
*mslice = \&PDL::mslice;		)) {
*isempty = \&PDL::isempty;		no strict 'refs'; *{$_} = \&{"PDL::$_"};
*string = \&PDL::string;		}
}		}
=head1 NAME		=head1 NAME
PDL::Core - fundamental PDL functionality and vectorization/broadcasting		PDL::Core - fundamental PDL functionality and vectorization/broadcasting
=head1 DESCRIPTION		=head1 DESCRIPTION
Methods and functions for type conversions, PDL creation,		Methods and functions for type conversions, PDL creation,
type conversion, broadcasting etc.		type conversion, broadcasting etc.
skipping to change at line 411		skipping to change at line 403
$x = pdl([[1,2,3],[2,undef,undef]]);		$x = pdl([[1,2,3],[2,undef,undef]]);
If your PDL module has bad values compiled into it (see L<PDL::Bad>),		If your PDL module has bad values compiled into it (see L<PDL::Bad>),
you can pass BAD values into the constructor within pre-existing PDLs.		you can pass BAD values into the constructor within pre-existing PDLs.
The BAD values are automatically kept BAD and propagated correctly.		The BAD values are automatically kept BAD and propagated correctly.
C<pdl()> is a functional synonym for the 'new' constructor,		C<pdl()> is a functional synonym for the 'new' constructor,
e.g.:		e.g.:
$x = new PDL [1..10];		$x = PDL->new([1..10]);
In order to control how undefs are handled in converting from perl lists to		In order to control how undefs are handled in converting from perl lists to
PDLs, one can set the variable C<$PDL::undefval>.		PDLs, one can set the variable C<$PDL::undefval>.
For example:		For example:
$foo = [[1,2,undef],[undef,3,4]];		$foo = [[1,2,undef],[undef,3,4]];
$PDL::undefval = -999;		$PDL::undefval = -999;
$f = pdl $foo;		$f = pdl $foo;
print $f		print $f
[		[
skipping to change at line 765		skipping to change at line 757
unless $_[0]->nelem == 1;		unless $_[0]->nelem == 1;
confess("bad value ndarray in conditional expression")		confess("bad value ndarray in conditional expression")
if $_[0]->badflag and $_[0].'' eq 'BAD';		if $_[0]->badflag and $_[0].'' eq 'BAD';
$_[0]->clump(-1)->at(0);		$_[0]->clump(-1)->at(0);
},		},
;		;
}		}
##################### Data type/conversion stuff ########################		##################### Data type/conversion stuff ########################
sub PDL::dims { # Return dimensions as @list
PDL->topdl(shift)->dims_c;
}
sub PDL::shape { # Return dimensions as a pdl		sub PDL::shape { # Return dimensions as a pdl
indx([PDL->topdl(shift)->dims]);		indx([PDL->topdl(shift)->dims]);
}		}
sub PDL::howbig {		sub PDL::howbig {
my $t = shift;		my $t = shift;
if("PDL::Type" eq ref $t) {$t = $t->[0]}		if("PDL::Type" eq ref $t) {$t = $t->[0]}
PDL::howbig_c($t);		PDL::howbig_c($t);
}		}
skipping to change at line 797		skipping to change at line 785
=for usage		=for usage
use PDL::Core ':Internal'; # use the internal routines of		use PDL::Core ':Internal'; # use the internal routines of
# the Core module		# the Core module
@ids = broadcastids $ndarray;		@ids = broadcastids $ndarray;
=cut		=cut
sub PDL::broadcastids {
PDL->topdl(shift)->broadcastids_c;
}
################# Creation/copying functions #######################		################# Creation/copying functions #######################
sub piddle {PDL->pdl(@_)}		sub piddle {PDL->pdl(@_)}
sub pdl {PDL->pdl(@_)}		sub pdl {PDL->pdl(@_)}
sub PDL::pdl { shift->new(@_) }		sub PDL::pdl { shift->new(@_) }
=head2 doflow		=head2 doflow
=for ref		=for ref
skipping to change at line 872		skipping to change at line 856
new ndarray constructor method		new ndarray constructor method
=for usage		=for usage
$x = PDL->new(SCALAR|ARRAY|ARRAY REF|STRING);		$x = PDL->new(SCALAR|ARRAY|ARRAY REF|STRING);
=for example		=for example
$x = PDL->new(42); # new from a Perl scalar		$x = PDL->new(42); # new from a Perl scalar
$x = new PDL 42; # ditto
$y = PDL->new(@list_of_vals); # new from Perl list		$y = PDL->new(@list_of_vals); # new from Perl list
$y = new PDL @list_of_vals; # ditto
$z = PDL->new(\@list_of_vals); # new from Perl list reference		$z = PDL->new(\@list_of_vals); # new from Perl list reference
$w = PDL->new("[1 2 3]"); # new from Perl string, using		$w = PDL->new("[1 2 3]"); # new from Perl string, using
# Matlab constructor syntax		# Matlab constructor syntax
Constructs ndarray from perl numbers and lists		Constructs ndarray from perl numbers and lists
and strings with Matlab/Octave style constructor		and strings with Matlab/Octave style constructor
syntax.		syntax.
The string input is fairly versatile though not		The string input is fairly versatile though not
performance optimized. The goal is to make it		performance optimized. The goal is to make it
skipping to change at line 983		skipping to change at line 965
if ($has_inf and not $types[$type]->usenan);		if ($has_inf and not $types[$type]->usenan);
# Make the white-space uniform and see if any not-allowed characters are		# Make the white-space uniform and see if any not-allowed characters are
# present:		# present:
$value =~ s/\s+/ /g;		$value =~ s/\s+/ /g;
if (my ($disallowed) = ($value =~ /([^\[\]\+\-0-9;,.eE ]+)/)) {		if (my ($disallowed) = ($value =~ /([^\[\]\+\-0-9;,.eE ]+)/)) {
croak("PDL::Core::new_pdl_from_string: found disallowed character(s) '$dis allowed' in '$original_value', value now: '$value'");		croak("PDL::Core::new_pdl_from_string: found disallowed character(s) '$dis allowed' in '$original_value', value now: '$value'");
}		}
# Wrap the string in brackets [], so that the following works:		# Wrap the string in brackets [], so that the following works:
# $x = new PDL q[1 2 3];		# $x = PDL->new(q[1 2 3]);
# We'll have to check for dimensions of size one after we've parsed		# We'll have to check for dimensions of size one after we've parsed
# the string and built a PDL from the resulting array.		# the string and built a PDL from the resulting array.
$value = '[' . $value . ']';		$value = '[' . $value . ']';
# Make sure that each closing bracket followed by an opening bracket		# Make sure that each closing bracket followed by an opening bracket
# has a comma in between them:		# has a comma in between them:
$value =~ s/\]\s*\[/],[/g;		$value =~ s/\]\s*\[/],[/g;
# Semicolons indicate 'start a new row' and require special handling:		# Semicolons indicate 'start a new row' and require special handling:
if ($value =~ /;/) {		if ($value =~ /;/) {
skipping to change at line 3094		skipping to change at line 3076
$x = sequence(10);		$x = sequence(10);
$y = $x->slice('4');		$y = $x->slice('4');
print $y->sclr; # no problem		print $y->sclr; # no problem
print $y->at(); # error: needs at least one zero		print $y->at(); # error: needs at least one zero
C<sclr> is generally used when a Perl scalar is required instead		C<sclr> is generally used when a Perl scalar is required instead
of a one-element ndarray. As of 2.064, if the input is a multielement ndarray		of a one-element ndarray. As of 2.064, if the input is a multielement ndarray
it will throw an exception.		it will throw an exception.
=cut
sub PDL::sclr {
my $this = shift;
confess "multielement ndarray in 'sclr' call"
if $this->nelem > 1;
return sclr_c($this);
}
=head2 cat		=head2 cat
=for ref		=for ref
concatenate ndarrays to N+1 dimensional ndarray		concatenate ndarrays to N+1 dimensional ndarray
Takes a list of N ndarrays of same shape as argument,		Takes a list of N ndarrays of same shape as argument,
returns a single ndarray of dimension N+1.		returns a single ndarray of dimension N+1.
=for example		=for example
skipping to change at line 3155		skipping to change at line 3128
to 10x) than cat.		to 10x) than cat.
=cut		=cut
sub PDL::cat {		sub PDL::cat {
my $res;		my $res;
my $old_err = $@;		my $old_err = $@;
$@ = '';		$@ = '';
eval {		eval {
$res = $_[0]->initialize;		$res = $_[0]->initialize;
$res->set_datatype((sort {$b<=>$a} map{$_->get_datatype} @_)[0] ) ;		$res->set_datatype(max(map $_->get_datatype, @_));
my @resdims = $_[0]->dims;		my @resdims = $_[0]->dims;
for my $i(0..$#_){		for my $i(0..$#_){
my @d = $_[$i]->dims;		my @d = $_[$i]->dims;
for my $j(0..$#d) {		for my $j(0..$#d) {
$resdims[$j] = $d[$j] if( !defined($resdims[$j]) or $resd ims[$j]==1 );		$resdims[$j] = $d[$j] if( !defined($resdims[$j]) or $resd ims[$j]==1 );
die "mismatched dims\n" if($d[$j] != 1 and $resdims[$j] ! = $d[$j]);		die "mismatched dims\n" if($d[$j] != 1 and $resdims[$j] ! = $d[$j]);
}		}
}		}
$res->setdims( [@resdims,scalar(@_) ]);		$res->setdims( [@resdims,scalar(@_) ]);
my ($i,$t); my $s = ":,"x@resdims;		my ($i,$t); my $s = ":,"x@resdims;
for (@_) { $t = $res->slice($s."(".$i++.")"); $t .= $_}		for (@_) { $t = $res->slice($s."(".$i++.")"); $t .= $_}
# propagate any bad flags		# propagate any bad flags
for (@_) { if ( $_->badflag() ) { $res->badflag(1); last; } }		for (@_) { if ( $_->badflag() ) { $res->badflag(1); last; } }
};		};
if ($@ eq '') {		$@ = $old_err, return $res if !$@; # Restore the old error and return
# Restore the old error and return
$@ = $old_err;
return $res;
}
# If we've gotten here, then there's been an error, so check things		# If we've gotten here, then there's been an error, so check things
# and barf out a meaningful message.		# and barf out a meaningful message.
if ($@ =~ /PDL::Ops::assgn|mismatched/		if ($@ =~ /PDL::Ops::assgn|mismatched/
or $@ =~ /"badflag"/		or $@ =~ /"badflag"/
or $@ =~ /"initialize"/) {		or $@ =~ /"initialize"/) {
my (@mismatched_dims, @not_a_ndarray);		my (@mismatched_dims, @not_a_ndarray);
my $i = 0;		my $i = 0;
skipping to change at line 3935		skipping to change at line 3904
sub PDL::fhdr {		sub PDL::fhdr {
my $pdl = shift;		my $pdl = shift;
return $pdl->hdr		return $pdl->hdr
if( (defined $pdl->gethdr) ||		if( (defined $pdl->gethdr) ||
!defined $Astro::FITS::Header::VERSION		!defined $Astro::FITS::Header::VERSION
);		);
# Avoid bug in 1.15 and earlier Astro::FITS::Header		# Avoid bug in 1.15 and earlier Astro::FITS::Header
my @hdr = ("SIMPLE = T");		my @hdr = ("SIMPLE = T");
my $hdr = new Astro::FITS::Header(Cards=>\@hdr);		my $hdr = Astro::FITS::Header->new(Cards=>\@hdr);
tie my %hdr, "Astro::FITS::Header", $hdr;		tie my %hdr, "Astro::FITS::Header", $hdr;
$pdl->sethdr(\%hdr);		$pdl->sethdr(\%hdr);
return \%hdr;		return \%hdr;
}		}
sub PDL::set_data_by_file_map {		sub PDL::set_data_by_file_map {
require Fcntl;		require Fcntl;
require File::Map;		require File::Map;
my ($pdl,$name,$len,$shared,$writable,$creat,$mode,$trunc) = @_;		my ($pdl,$name,$len,$shared,$writable,$creat,$mode,$trunc) = @_;
my $pdl_dataref = $pdl->get_dataref();		my $pdl_dataref = $pdl->get_dataref();
End of changes. 13 change blocks.
45 lines changed or deleted		14 lines changed or added

---