diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm index 671f092e4..94394822c 100644 --- a/Basic/Core/Core.pm +++ b/Basic/Core/Core.pm @@ -3271,7 +3271,10 @@ sub PDL::type { return PDL::Type->new($_[0]->get_datatype); } =for ref -Convert ndarray to string, optionally using a C format. +Convert ndarray to string, optionally using a C format. If such +a format is provided, it is used. If not, then the formatting variables +in L provide a default, though heuristics are attempted to +make a nice-looking output. =for usage @@ -3770,128 +3773,62 @@ sub strND { # String 1D array in nice format sub str1D { - my($self,$format)=@_; - barf "Not 1D" if $self->getndims()!=1; - my $x = listref_c($self); - my ($ret,$dformat,$t); - $ret = "["; - my $dtype = $self->get_datatype(); - $dformat = $PDL::floatformat if $dtype == $PDL_F; - $dformat = $PDL::doubleformat if $dtype == $PDL_D; - $dformat = $PDL::indxformat if $dtype == $PDL_IND; - - my $badflag = $self->badflag(); - for $t (@$x) { - if ( $badflag and $t eq "BAD" ) { - # do nothing - } elsif ($format) { - $t = sprintf $format,$t; - } else{ # Default - if ($dformat && length($t)>7) { # Try smaller - $t = sprintf $dformat,$t; - } - } - $ret .= $t.$sep; - } + my($self,$format)=@_; + barf "Not 1D" if $self->getndims != 1; + my $x = listref_c($self); + my $badflag = $self->badflag; + return "[".join($sep, map + $badflag && $_ eq "BAD" ? $_ : + $format ? sprintf $format,$_ : $_, + @$x)."]"; +} - chop $ret; $ret.="]"; - return $ret; +sub str_list { + my ($x, $row_len, $format, $dtype, $badflag) = @_; + my ($len, $findmax) = (0, 1); + if (!defined $format || $format eq "") { + # Format not given? - find max length of default + $len = max map length($_), @$x; + $format = "%".$len."s"; + if ($len>7) { # Too long? - perhaps try smaller format + if ($dtype == $PDL_F) { + $format = $PDL::floatformat; + } elsif ($dtype == $PDL_D) { + $format = $PDL::doubleformat; + } elsif ($dtype == $PDL_IND) { + $format = $PDL::indxformat; + } else { + # Stick with default + $findmax = 0; + } + } else { + # Default ok + $findmax = 0; + } + } + $len = $badflag ? + max map $_ eq "BAD" ? 3 : length(sprintf $format,$_), @$x : + max map length(sprintf $format,$_), @$x + if $findmax; # Find max length of strings in final format + my @ret; + for (my $i=0; $i<=$#$x; $i+=$row_len) { + push @ret, "[".join($sep, map sprintf("%${len}s", $badflag && $_ eq "BAD" ? "BAD" : sprintf $format,$_), @$x[$i..$i+$row_len-1])."]"; + } + return @ret; } # String 2D array in nice uniform format sub str2D{ - my($self,$format,$level)=@_; - my @dims = $self->dims(); - barf "Not 2D" if scalar(@dims)!=2; - my $x = listref_c($self); - my ($i, $f, $t, $len, $ret); - - my $dtype = $self->get_datatype(); - my $badflag = $self->badflag(); - - my $findmax = 1; - if (!defined $format || $format eq "") { - # Format not given? - find max length of default - $len=0; - - if ( $badflag ) { - for (@$x) { - if ( $_ eq "BAD" ) { $i = 3; } - else { $i = length($_); } - $len = $i>$len ? $i : $len; - } - } else { - for (@$x) {$i = length($_); $len = $i>$len ? $i : $len }; - } - - $format = "%".$len."s"; - - if ($len>7) { # Too long? - perhaps try smaller format - if ($dtype == $PDL_F) { - $format = $PDL::floatformat; - } elsif ($dtype == $PDL_D) { - $format = $PDL::doubleformat; - } elsif ($dtype == $PDL_IND) { - $format = $PDL::indxformat; - } else { - # Stick with default - $findmax = 0; - } - } - else { - # Default ok - $findmax = 0; - } - } - - if($findmax) { - # Find max length of strings in final format - $len=0; - - if ( $badflag ) { - for (@$x) { - if ( $_ eq "BAD" ) { $i = 3; } - else { $i = length(sprintf $format,$_); } - $len = $i>$len ? $i : $len; - } - } else { - for (@$x) { - $i = length(sprintf $format,$_); $len = $i>$len ? $i : $len; - } - } - } # if: $findmax - - $ret = "\n" . " "x$level . "[\n"; - { - my $level = $level+1; - $ret .= " "x$level ."["; - for ($i=0; $i<=$#$x; $i++) { - - if ( $badflag and $$x[$i] eq "BAD" ) { - $f = "BAD"; - } else { - $f = sprintf $format,$$x[$i]; - } - - $t = $len-length($f); $f = " "x$t .$f if $t>0; - $ret .= $f; - if (($i+1)%$dims[0]) { - $ret.=$sep; - } - else{ # End of output line - $ret.="]"; - if ($i==$#$x) { # very last number - $ret.="\n"; - } - else{ - $ret.= $sep2."\n" . " "x$level ."["; - } - } - } - } - $ret .= " "x$level."]\n"; - return $ret; + my($self,$format,$level)=@_; + my @dims = $self->dims(); + barf "Not 2D" if scalar(@dims)!=2; + my $x = listref_c($self); + my @lines = str_list($x, $dims[0], $format, $self->get_datatype, $self->badflag); + my $ret = "\n" . " "x$level . "[\n"; + $ret .= join $sep2."\n", map " "x($level+1).$_, @lines; + $ret .= "\n".(" "x$level)."]\n"; + return $ret; } ########## Docs for functions in Core.xs ################## diff --git a/Changes b/Changes index 7450a2d35..fffcde8e3 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,4 @@ -- document PDL::string (#459) - thanks @vadim-160102 for report +- test, document PDL::string, make more consistent (#459) - thanks @vadim-160102 for report 2.085 2024-01-30 - switch FFT code to use heap, not VLA (#436) - thanks @HaraldJoerg for report diff --git a/t/core.t b/t/core.t index e1b2a80d1..15357896b 100644 --- a/t/core.t +++ b/t/core.t @@ -131,6 +131,37 @@ isa_ok( PDL->topdl(1,2,3), "PDL", "topdl(1,2,3) returns an ndarray" ); $x=PDL->topdl(1,2,3); ok (($x->nelem == 3 and all($x == pdl(1,2,3))), "topdl(1,2,3) returns a 3-ndarray containing (1,2,3)"); +# stringification +{ +my $x = sequence( 3 + 1e7 ); +my $x_indx = which( $x > 1e7 - 4 ); +is $x_indx.'', "[9999997 9999998 9999999 10000000 10000001 10000002]"; +my $x_indx_bad = $x_indx->copy; +$x_indx_bad->setbadat($_) for 1, 4; +is $x_indx_bad.'', "[9999997 BAD 9999999 10000000 BAD 10000002]"; +is +($x_indx - 10).'', "[9999987 9999988 9999989 9999990 9999991 9999992]"; +is +($x_indx)->splitdim(0,3).'', "\n[\n [ 9999997 9999998 9999999]\n [ 10000000 10000001 10000002]\n]\n"; +is +($x_indx - 10)->splitdim(0,3).'', "\n[\n [9999987 9999988 9999989]\n [9999990 9999991 9999992]\n]\n"; +is +($x_indx_bad)->splitdim(0,3).'', "\n[\n [ 9999997 BAD 9999999]\n [ 10000000 BAD 10000002]\n]\n"; +is +($x_indx_bad - 10)->splitdim(0,3).'', "\n[\n [9999987 BAD 9999989]\n [9999990 BAD 9999992]\n]\n"; +my $x_double = where( $x, $x > 1e7 - 4 ); +is $x_double.'', "[9999997 9999998 9999999 10000000 10000001 10000002]"; +is +($x_double - 10).'', "[9999987 9999988 9999989 9999990 9999991 9999992]"; +is +($x_double)->splitdim(0,3).'', "\n[\n [ 9999997 9999998 9999999]\n [ 10000000 10000001 10000002]\n]\n"; +is +($x_double - 10)->splitdim(0,3).'', "\n[\n [9999987 9999988 9999989]\n [9999990 9999991 9999992]\n]\n"; +my $x_long = where( long($x), $x > 1e7 - 4 ); +is $x_long.'', "[9999997 9999998 9999999 10000000 10000001 10000002]"; +is +($x_long - 10).'', "[9999987 9999988 9999989 9999990 9999991 9999992]"; +is +($x_long)->splitdim(0,3).'', "\n[\n [ 9999997 9999998 9999999]\n [10000000 10000001 10000002]\n]\n"; +is +($x_long - 10)->splitdim(0,3).'', "\n[\n [9999987 9999988 9999989]\n [9999990 9999991 9999992]\n]\n"; +my $fracs = sequence(9) / 16; +is $PDL::doubleformat, "%10.8g"; +is $fracs.'', "[0 0.0625 0.125 0.1875 0.25 0.3125 0.375 0.4375 0.5]"; +is $fracs->string($PDL::doubleformat).'', "[ 0 0.0625 0.125 0.1875 0.25 0.3125 0.375 0.4375 0.5]"; +local $PDL::doubleformat = '%8.2g'; +is $fracs.'', "[0 0.0625 0.125 0.1875 0.25 0.3125 0.375 0.4375 0.5]"; +is $fracs->string($PDL::doubleformat).'', "[ 0 0.062 0.12 0.19 0.25 0.31 0.38 0.44 0.5]"; +} # test $PDL::undefval support in pdl (bug #886263) #