"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Core/Char.pm" between
PDL-2.077.tar.gz and PDL-2.078.tar.gz

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

Char.pm  (PDL-2.077)	:	Char.pm  (PDL-2.078)
skipping to change at line 70		skipping to change at line 70
=for example		=for example
$pdlchar3d = PDL::Char->new([['abc','def','ghi'],['jkl', 'mno', 'pqr']]);		$pdlchar3d = PDL::Char->new([['abc','def','ghi'],['jkl', 'mno', 'pqr']]);
=cut		=cut
sub new {		sub new {
my $type = shift;		my $type = shift;
my $value = (scalar(@_)>1 ? [@_] : shift); # ref thyself		my $value = (scalar(@_)>1 ? [@_] : shift); # ref thyself
# re-bless byte PDLs as PDL::Char		# re-bless byte PDLs as PDL::Char
if (ref($value) =~ /PDL/) {		if (ref($value) =~ /PDL/) {
PDL::Core::barf('Cannot convert a non-byte PDL to PDL::Char')		PDL::Core::barf('Cannot convert a non-byte PDL to PDL::Char')
if ($value->get_datatype != $PDL::Types::PDL_B);		if ($value->get_datatype != $PDL::Types::PDL_B);
return bless $value, $type;		return bless $value, $type;
}		}
my $ptype = $PDL::Types::PDL_B;		my $ptype = $PDL::Types::PDL_B;
my $self = PDL->initialize();		my $self = PDL->initialize();
$self->set_datatype($ptype);		$self->set_datatype($ptype);
$value = 0 if !defined($value);		$value = 0 if !defined($value);
my $maxlength; # max length seen for all character strings		my $maxlength; # max length seen for all character strings
my $samelen = 1; # Flag = 1 if all character strings are the same length		my $samelen = 1; # Flag = 1 if all character strings are the same length
# 1st Pass thru the perl array structure, assume all strings the same length		# 1st Pass thru the perl array structure, assume all strings the same length
my @dims;		my @dims;
my $str = _rcharpack($value,\$maxlength,\$samelen,0,\@dims);		my $str = _rcharpack($value,\$maxlength,\$samelen,0,\@dims);
unless( $samelen){ # Strings weren't the same length, go thru again and null pad to		unless( $samelen){ # Strings weren't the same length, go thru again and null pad to
# the max length.		# the max length.
$str = _rcharpack2($value,$maxlength,0,\@dims);		$str = _rcharpack2($value,$maxlength,0,\@dims);
}		}
$self->setdims([reverse @dims]);		$self->setdims([reverse @dims]);
${$self->get_dataref} = $str;		${$self->get_dataref} = $str;
$self->upd_data();		$self->upd_data();
skipping to change at line 107		skipping to change at line 104
# Take an N-D perl array of strings and pack it into a single string,		# Take an N-D perl array of strings and pack it into a single string,
# Used by the 'char' constructor		# Used by the 'char' constructor
#		#
# References supplied so $maxlength and $samelen are updated along the way as w ell.		# References supplied so $maxlength and $samelen are updated along the way as w ell.
#		#
#		#
# This version (_rcharpack) is for the 1st pass thru the N-d string array.		# This version (_rcharpack) is for the 1st pass thru the N-d string array.
# It assumes that all strings are the same length, but also checks to see if they aren't		# It assumes that all strings are the same length, but also checks to see if they aren't
sub _rcharpack {		sub _rcharpack {
my $w = shift; # Input string		my $w = shift; # Input string
my ($maxlenref, $samelenref, $level, $dims) = @_; # reference to $maxlength, $ samelen		my ($maxlenref, $samelenref, $level, $dims) = @_; # reference to $maxlength, $ samelen
my ($ret,$type);		my ($ret,$type);
$ret = "";		$ret = "";
if (ref($w) eq "ARRAY") {		if (ref($w) eq "ARRAY") {
PDL::Core::barf('Array is not rectangular') if (defined($dims->[$level]) and		PDL::Core::barf('Array is not rectangular') if (defined($dims->[$level]) and
$dims->[$level] != scalar(@$w));		$dims->[$level] != scalar(@$w));
$dims->[$level] = scalar (@$w);		$dims->[$level] = scalar (@$w);
$level++;		$level++;
$type = ref($$w[0]);		$type = ref($$w[0]);
for(@$w) {		for(@$w) {
PDL::Core::barf('Array is not rectangular') unless $type eq ref($_); # Equ al types		PDL::Core::barf('Array is not rectangular') unless $type eq ref($_); # Equ al types
$ret .= _rcharpack($_,$maxlenref, $samelenref, $level, $dims);		$ret .= _rcharpack($_,$maxlenref, $samelenref, $level, $dims);
}		}
}elsif (ref(\$w) eq "SCALAR") {		}elsif (ref(\$w) eq "SCALAR") {
my $len = length($w);		my $len = length($w);
# Check for this length being different then the others:		# Check for this length being different then the others:
$$samelenref = 0 if( defined($$maxlenref) && ($len != $$maxlenref) );		$$samelenref = 0 if( defined($$maxlenref) && ($len != $$maxlenref) );
# Save the max length:		# Save the max length:
$$maxlenref = $len if( !defined($$maxlenref) || $len > $$maxlenref); # see i f this is the max length seen so far		$$maxlenref = $len if( !defined($$maxlenref) || $len > $$maxlenref); # see i f this is the max length seen so far
$dims->[$level] = $len;		$dims->[$level] = $len;
$ret = $w;		$ret = $w;
}else{		}else{
PDL::Core::barf("Don't know how to make a PDL object from passed argument");		PDL::Core::barf("Don't know how to make a PDL object from passed argument");
}		}
return $ret;		return $ret;
}		}
#
#
# This version (_rcharpack2) is for the 2nd pass (if required) thru the N-d st ring array.		# This version (_rcharpack2) is for the 2nd pass (if required) thru the N-d st ring array.
# If the 1st pass thru (_rcharpack) finds that all strings were not the same l ength,		# If the 1st pass thru (_rcharpack) finds that all strings were not the same l ength,
# this routine will go thru and null-pad all strings to the max length seen.		# this routine will go thru and null-pad all strings to the max length seen.
# Note: For efficiency, the error checking is not repeated here, because any errors will		# Note: For efficiency, the error checking is not repeated here, because any errors will
# already be detected in the 1st pass.		# already be detected in the 1st pass.
#		#
sub _rcharpack2 {		sub _rcharpack2 {
my $w = shift; # Input string		my $w = shift; # Input string
my ($maxlen, $level, $dims) = @_; # Length to pad strings to		my ($maxlen, $level, $dims) = @_; # Length to pad strings to
my ($ret,$type);		my ($ret,$type);
$ret = "";		$ret = "";
if (ref($w) eq "ARRAY") {		if (ref($w) eq "ARRAY") {
# Checks not needed the second time thru (removed)		# Checks not needed the second time thru (removed)
$dims->[$level] = scalar (@$w);		$dims->[$level] = scalar (@$w);
$level++;		$level++;
$type = ref($$w[0]);		$type = ref($$w[0]);
for(@$w) {		for(@$w) {
$ret .= _rcharpack2($_,$maxlen,$level,$dims);		$ret .= _rcharpack2($_,$maxlen,$level,$dims);
}		}
}elsif (ref(\$w) eq "SCALAR") {		}elsif (ref(\$w) eq "SCALAR") {
my $len = length($w);		my $len = length($w);
$dims->[$level] = $maxlen;		$dims->[$level] = $maxlen;
$ret = $w.("\00" x ($maxlen - $len));		$ret = $w.("\00" x ($maxlen - $len));
}		}
return $ret;		return $ret;
}		}
#
#
=head2 string		=head2 string
=for ref		=for ref
Function to print a character PDL (created by 'char') in a pretty format.		Function to print a character PDL (created by 'char') in a pretty format.
=for usage		=for usage
$char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );		$char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );
print $char; # 'string' bound to "", perl stringify function		print $char; # 'string' bound to "", perl stringify function
skipping to change at line 208		skipping to change at line 184
# 'string' is overloaded to the "" operator, so:		# 'string' is overloaded to the "" operator, so:
# print $char;		# print $char;
# should have the same effect.		# should have the same effect.
=cut		=cut
sub string {		sub string {
my $self = shift;		my $self = shift;
my $level = shift || 0;		my $level = shift || 0;
my $sep = $PDL::use_commas ? "," : " ";		my $sep = $PDL::use_commas ? "," : " ";
if ($self->dims == 1) {		if ($self->dims == 1) {
my $str = ${$self->get_dataref}; # get copy of string		my $str = ${$self->get_dataref}; # get copy of string
$str =~ s/\00+$//g; # get rid of any null padding		$str =~ s/\00+$//g; # get rid of any null padding
return "\'". $str. "\'". $sep;		return "\'". $str. "\'". $sep;
} else {		} else {
my @dims = reverse $self->dims;		my @dims = reverse $self->dims;
my $ret = '';		my $ret = '';
$ret .= (" " x $level) . '[' . ((@dims == 2) ? ' ' : "\n");		$ret .= (" " x $level) . '[' . ((@dims == 2) ? ' ' : "\n");
for (my $i=0;$i<$dims[0];$i++) {		for (my $i=0;$i<$dims[0];$i++) {
my $slicestr = ":," x (scalar(@dims)-1) . "($i)";		my $slicestr = ":," x (scalar(@dims)-1) . "($i)";
my $substr = $self->slice($slicestr);		my $substr = $self->slice($slicestr);
$ret .= $substr->string($level+1);		$ret .= $substr->string($level+1);
}		}
$ret .= (" " x $level) . ']' . $sep . "\n";		$ret .= (" " x $level) . ']' . $sep . "\n";
return $ret;		return $ret;
}		}
}		}
=head2 setstr		=head2 setstr
=for ref		=for ref
Function to set one string value in a character PDL. The input position is		Function to set one string value in a character PDL. The input position is
the position of the string, not a character in the string. The first dimension		the position of the string, not a character in the string. The first dimension
is assumed to be the length of the string.		is assumed to be the length of the string.
skipping to change at line 265		skipping to change at line 238
# ['abc' 'def' 'ghi']		# ['abc' 'def' 'ghi']
# ['foo' 'mno' 'f'] -> note that this 'f' is stored "f\0\0"		# ['foo' 'mno' 'f'] -> note that this 'f' is stored "f\0\0"
# ]		# ]
=cut		=cut
sub setstr { # Sets a particular single value to a string.		sub setstr { # Sets a particular single value to a string.
PDL::Core::barf('Usage: setstr($pdl, $x, $y,.., $value)') if $#_<2;		PDL::Core::barf('Usage: setstr($pdl, $x, $y,.., $value)') if $#_<2;
my $self = shift;		my $self = shift;
my $val = pop;		my $val = pop;
my @dims = $self->dims;		my @dims = $self->dims;
my $n = $dims[0];		my $n = $dims[0];
for (my $i=0;$i<$n;$i++) {		for (my $i=0;$i<$n;$i++) {
my $chr = ($i >= length($val)) ? 0 : unpack ("C", substr ($val, $i, 1));		my $chr = ($i >= length($val)) ? 0 : unpack ("C", substr ($val, $i, 1));
PDL::Core::set_c ($self, [$i, @_], $chr);		PDL::Core::set_c ($self, [$i, @_], $chr);
}		}
}		}
=head2 atstr		=head2 atstr
=for ref		=for ref
Function to fetch one string value from a PDL::Char type PDL, given a position w ithin the PDL.		Function to fetch one string value from a PDL::Char type PDL, given a position w ithin the PDL.
The input position of the string, not a character in the string. The length of the input		The input position of the string, not a character in the string. The length of the input
string is the implied first dimension.		string is the implied first dimension.
skipping to change at line 296		skipping to change at line 266
$char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );		$char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );
print $char->atstr(0,1);		print $char->atstr(0,1);
# Prints:		# Prints:
# jkl		# jkl
=cut		=cut
sub atstr { # Fetchs a string value from a PDL::Char		sub atstr { # Fetchs a string value from a PDL::Char
PDL::Core::barf('Usage: atstr($pdl, $x, $y,..,)') if (@_ < 2);		PDL::Core::barf('Usage: atstr($pdl, $x, $y,..,)') if (@_ < 2);
my $self = shift;		my $self = shift;
my $str = ':,' . join (',', map {"($_)"} @_);		my $str = ':,' . join (',', map {"($_)"} @_);
my $w = $self->slice($str);		my $w = $self->slice($str);
my $val = ${$w->get_dataref}; # get the data		my $val = ${$w->get_dataref}; # get the data
$val =~ s/\00+$//g; # get rid of any null padding		$val =~ s/\00+$//g; # get rid of any null padding
return $val;		return $val;
}		}
# yuck ;) this is a cool little accessor method		# yuck ;) this is a cool little accessor method
# rebless a slice into PDL; originally		# rebless a slice into PDL; originally
# Marc's idea used in PDL::Complex		# Marc's idea used in PDL::Complex
sub numeric {		sub numeric {
my ($seq) = @_;		my ($seq) = @_;
End of changes. 30 change blocks.
33 lines changed or deleted		1 lines changed or added

---