=head1 NAME
PDL::Basic -- Basic utility functions for PDL
=head1 DESCRIPTION
This module contains basic utility functions for
creating and manipulating piddles. Most of these functions
are simplified interfaces to the more flexible functions in
the modules
L<PDL::Primitive|PDL::Primitive>
and
L<PDL::Slices|PDL::Slices>.
=head1 SYNOPSIS
use PDL::Basic;
=head1 FUNCTIONS
=cut
package PDL::Basic;
use PDL::Core '';
use PDL::Types;
use PDL::Exporter;
use PDL::Options;
@ISA=qw/PDL::Exporter/;
@EXPORT_OK = qw/ ndcoords rvals axisvals allaxisvals xvals yvals zvals sec ins hist whist
similar_assign transpose sequence xlinvals ylinvals
zlinvals axislinvals/;
%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
# Exportable functions
*axisvals = \&PDL::axisvals;
*allaxisvals = \&PDL::allaxisvals;
*sec = \&PDL::sec;
*ins = \&PDL::ins;
*hist = \&PDL::hist;
*whist = \&PDL::whist;
*similar_assign = \&PDL::similar_assign;
*transpose = \&PDL::transpose;
*xlinvals = \&PDL::xlinvals;
*ylinvals = \&PDL::ylinvals;
*zlinvals = \&PDL::zlinvals;
=head2 xvals
=for ref
Fills a piddle with X index values
=for usage
$x = xvals($somearray);
$x = xvals([OPTIONAL TYPE],$nx,$ny,$nz...);
etc. see L<zeroes|PDL::Core/zeroes>.
=for example
perldl> print xvals zeroes(5,10)
[
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
[0 1 2 3 4]
]
=head2 yvals
=for ref
Fills a piddle with Y index values
=for usage
$x = yvals($somearray); yvals(inplace($somearray));
$x = yvals([OPTIONAL TYPE],$nx,$ny,$nz...);
etc. see L<zeroes|PDL::Core/zeroes>.
=for example
perldl> print yvals zeroes(5,10)
[
[0 0 0 0 0]
[1 1 1 1 1]
[2 2 2 2 2]
[3 3 3 3 3]
[4 4 4 4 4]
[5 5 5 5 5]
[6 6 6 6 6]
[7 7 7 7 7]
[8 8 8 8 8]
[9 9 9 9 9]
]
=head2 zvals
=for ref
Fills a piddle with Z index values
=for usage
$x = zvals($somearray); zvals(inplace($somearray));
$x = zvals([OPTIONAL TYPE],$nx,$ny,$nz...);
etc. see L<zeroes|PDL::Core/zeroes>.
=for example
perldl> print zvals zeroes(3,4,2)
[
[
[0 0 0]
[0 0 0]
[0 0 0]
[0 0 0]
]
[
[1 1 1]
[1 1 1]
[1 1 1]
[1 1 1]
]
]
=head2 xlinvals
=for ref
X axis values between endpoints (see L<xvals|/xvals>).
=for usage
$a = zeroes(100,100);
$x = $a->xlinvals(0.5,1.5);
$y = $a->ylinvals(-2,-1);
# calculate Z for X between 0.5 and 1.5 and
# Y between -2 and -1.
$z = f($x,$y);
C<xlinvals>, C<ylinvals> and C<zlinvals> return a piddle with the same shape
as their first argument and linearly scaled values between the two other
arguments along the given axis.
=head2 ylinvals
=for ref
Y axis values between endpoints (see L<yvals|/yvals>).
See L<xlinvals|/xlinvals> for more information.
=head2 zlinvals
=for ref
Z axis values between endpoints (see L<zvals|/zvals>).
See L<xlinvals|/xlinvals> for more information.
=head2 xlogvals
=for ref
X axis values logarithmicly spaced between endpoints (see L<xvals|/xvals>).
=for usage
$a = zeroes(100,100);
$x = $a->xlogvals(1e-6,1e-3);
$y = $a->ylinvals(1e-4,1e3);
# calculate Z for X between 1e-6 and 1e-3 and
# Y between 1e-4 and 1e3.
$z = f($x,$y);
C<xlogvals>, C<ylogvals> and C<zlogvals> return a piddle with the same shape
as their first argument and logarithmicly scaled values between the two other
arguments along the given axis.
=head2 ylogvals
=for ref
Y axis values logarithmicly spaced between endpoints (see L<yvals|/yvals>).
See L<xlogvals|/xlogvals> for more information.
=head2 zlogvals
=for ref
Z axis values logarithmicly spaced between endpoints (see L<zvals|/zvals>).
See L<xlogvals|/xlogvals> for more information.
=cut
# Conveniently named interfaces to axisvals()
sub xvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->xvals : PDL->xvals(@_) }
sub yvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->yvals : PDL->yvals(@_) }
sub zvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->zvals : PDL->zvals(@_) }
sub PDL::xvals {
my $class = shift;
my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
axisvals2($pdl,0);
return $pdl;
}
sub PDL::yvals {
my $class = shift;
my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
axisvals2($pdl,1);
return $pdl;
}
sub PDL::zvals {
my $class = shift;
my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
axisvals2($pdl,2);
return $pdl;
}
sub PDL::xlinvals {
my $dim = $_[0]->getdim(0);
barf "Must have at least two elements in dimension for xlinvals"
if $dim <= 1;
return $_[0]->xvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
}
sub PDL::ylinvals {
my $dim = $_[0]->getdim(1);
barf "Must have at least two elements in dimension for ylinvals"
if $dim <= 1;
return $_[0]->yvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
}
sub PDL::zlinvals {
my $dim = $_[0]->getdim(2);
barf "Must have at least two elements in dimension for zlinvals"
if $dim <= 1;
return $_[0]->zvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
}
sub PDL::xlogvals {
my $dim = $_[0]->getdim(0);
barf "Must have at least two elements in dimension for xlogvals"
if $dim <= 1;
my ($xmin,$xmax) = @_[1,2];
barf "xmin and xmax must be positive"
if $xmin <= 0 || $xmax <= 0;
my ($lxmin,$lxmax) = (log($xmin), log($xmax));
return exp($_[0]->xvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
}
sub PDL::ylogvals {
my $dim = $_[0]->getdim(1);
barf "Must have at least two elements in dimension for xlogvals"
if $dim <= 1;
my ($xmin,$xmax) = @_[1,2];
barf "xmin and xmax must be positive"
if $xmin <= 0 || $xmax <= 0;
my ($lxmin,$lxmax) = (log($xmin), log($xmax));
return exp($_[0]->yvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
}
sub PDL::zlogvals {
my $dim = $_[0]->getdim(2);
barf "Must have at least two elements in dimension for xlogvals"
if $dim <= 1;
my ($xmin,$xmax) = @_[1,2];
barf "xmin and xmax must be positive"
if $xmin <= 0 || $xmax <= 0;
my ($lxmin,$lxmax) = (log($xmin), log($xmax));
return exp($_[0]->zvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
}
=head2 ndcoords
=for ref
Enumerate pixel coordinates for an N-D piddle
=for usage
$indices = ndcoords($pdl)
$indices = ndcoords(@dimlist)
Returns an enumerated list of coordinates suitable for use in
L<indexND|PDL::Slices/indexND> or L<range|PDL::Slices/range>:
you feed in a dimension list
and get out a piddle whose 0th dimension runs over dimension index
and whose 1st through Nth dimensions are the dimensions given in the
input. If you feed in a piddle instead of a perl list, then the
dimension list is used, as in L<xvals|xvals> etc.
=for example
perldl> print ndcoords(2,3)
[
[
[0 0]
[1 0]
[2 0]
]
[
[0 1]
[1 1]
[2 1]
]
]
=cut
sub ndcoords {
my $type;
if(ref $_[0] eq 'PDL::Type') {
$type = shift;
}
my @dims = (ref $_[0]) ? (shift)->dims : @_;
my @d = @dims;
unshift(@d,scalar(@dims));
unshift(@d,$type) if defined($type);
$out = PDL->zeroes(@d);
for my $d(0..$#dims) {
my $a = $out->index($d)->mv($d,0);
$a .= xvals($a);
}
$out;
}
=head2 hist
=for ref
Create histogram of a piddle
=for usage
$hist = hist($data,[$min,$max,$step]);
($xvals,$hist) = hist($data,[$min,$max,$step]);
If requested, C<$xvals> gives the computed bin centres
A nice idiom (with
L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>) is
bin hist $data; # Plot histogram
=for example
perldl> p $y
[13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9 11 11 12 6 12 7]
perldl> $h = hist $y,0,20,1; # hist with step 1, min 0 and 20 bins
perldl> p $h
[0 0 0 0 0 0 2 3 1 3 5 4 4 4 0 0 0 0 0 0]
=cut
sub PDL::hist {
barf('Usage: ([$xvals],$hist) = hist($data,[$min,$max,$step])') if $#_<0;
my($pdl,$min,$max,$step)=@_;
my $xvals;
($step, $min, $bins, $xvals) =
_hist_bin_calc($pdl, $min, $max, $step, wantarray());
PDL::Primitive::histogram($pdl->clump(-1),(my $hist = null),
$step,$min,$bins);
return wantarray() ? ($xvals,$hist) : $hist;
}
=head2 whist
=for ref
Create a weighted histogram of a piddle
=for usage
$hist = whist($data, $wt, [$min,$max,$step]);
($xvals,$hist) = whist($data, $wt, [$min,$max,$step]);
If requested, C<$xvals> gives the computed bin centres.
C<$data> and C<$wt> should have the same dimensionality and extents.
A nice idiom (with
L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>) is
bin whist $data, $wt; # Plot histogram
=for example
perldl> p $y
[13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9 11 11 12 6 12 7]
perldl> $wt = grandom($y->nelem)
perldl> $h = whist $y, $wt, 0, 20, 1 # hist with step 1, min 0 and 20 bins
perldl> p $h
[0 0 0 0 0 0 -0.49552342 1.7987439 0.39450696 4.0073722 -2.6255299 -2.5084501 2.6458365 4.1671676 0 0 0 0 0 0]
=cut
sub PDL::whist {
barf('Usage: ([$xvals],$hist) = whist($data,$wt,[$min,$max,$step])')
if @_ < 2;
my($pdl,$wt,$min,$max,$step)=@_;
my $xvals;
($step, $min, $bins, $xvals) =
_hist_bin_calc($pdl, $min, $max, $step, wantarray());
PDL::Primitive::whistogram($pdl->clump(-1),$wt->clump(-1),
(my $hist = null), $step, $min, $bins);
return wantarray() ? ($xvals,$hist) : $hist;
}
sub _hist_bin_calc {
my($pdl,$min,$max,$step,$wantarray)=@_;
$min = $pdl->min() unless defined $min;
$max = $pdl->max() unless defined $max;
my $ntype = $pdl->get_datatype;
unless (defined $step) {
my $defbins = 100 < $pdl->nelem ? 100 : $pdl->nelem;
$step = ($max-$min)/$defbins;
$step = int($step) > 0 ? int($step) : 1 if $ntype < $PDL_F;
}
barf "step is zero (or all data equal to one value)" if $step == 0;
my $bins = int(($max-$min)/$step);
print "hist with step $step, min $min and $bins bins\n"
if $PDL::debug;
my $xvals = $min + $step/2 + sequence(PDL::Type->new($ntype),$bins)*
PDL::convert($step,$ntype) if $wantarray;
return ( $step, $min, $bins, $xvals );
}
=head2 sequence
=for ref
Create array filled with a sequence of values
=for usage
$a = sequence($b); $a = sequence [OPTIONAL TYPE], @dims;
etc. see L<zeroes|PDL::Core/zeroes>.
=for example
perldl> p sequence(10)
[0 1 2 3 4 5 6 7 8 9]
perldl> p sequence(3,4)
[
[ 0 1 2]
[ 3 4 5]
[ 6 7 8]
[ 9 10 11]
]
=cut
sub sequence { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->sequence : PDL->sequence(@_) }
sub PDL::sequence {
my $class = shift;
my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
my $bar = $pdl->clump(-1)->inplace;
my $foo = $bar->xvals;
return $pdl;
}
=head2 rvals
=for ref
Fills a piddle with radial distance values from some centre.
=for usage
$r = rvals $piddle,{OPTIONS};
$r = rvals [OPTIONAL TYPE],$nx,$ny,...{OPTIONS};
=for options
Options:
Centre => [$x,$y,$z...] # Specify centre
Center => [$x,$y.$z...] # synonym.
Squared => 1 # return distance squared (i.e., don't take the square root)
=for example
perldl> print rvals long,7,7,{Centre=>[2,2]}
[
[2 2 2 2 2 3 4]
[2 1 1 1 2 3 4]
[2 1 0 1 2 3 4]
[2 1 1 1 2 3 4]
[2 2 2 2 2 3 4]
[3 3 3 3 3 4 5]
[4 4 4 4 4 5 5]
]
For a more general metric, one can define, e.g.,
sub distance {
my ($a,$centre,$f) = @_;
my ($r) = $a->allaxisvals-$centre;
$f->($r);
}
sub l1 { sumover(abs($_[0])); }
sub euclid { use PDL::Math 'pow'; pow(sumover(pow($_[0],2)),0.5); }
sub linfty { maximum(abs($_[0])); }
so now
distance($a, $centre, \&euclid);
will emulate rvals, while C<\&l1> and C<\&linfty> will generate other
well-known norms.
=cut
sub rvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->rvals(@_[1..$#_]) : PDL->rvals(@_) }
sub PDL::rvals { # Return radial distance from given point and offset
my $class = shift;
my $opt = pop @_ if ref($_[$#_]) eq "HASH";
my %opt = defined $opt ?
iparse( {
CENTRE => undef, # needed, otherwise centre/center handling painful
Squared => 0,
}, $opt ) : ();
my $r = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
my @pos;
@pos = @{$opt{CENTRE}} if defined $opt{CENTRE};
my $offset;
$r .= 0.0;
my $tmp = $r->copy;
my $i;
for ($i=0; $i<$r->getndims; $i++) {
$offset = (defined $pos[$i] ? $pos[$i] : int($r->getdim($i)/2));
# Note careful coding for speed and min memory footprint
PDL::Primitive::axisvalues($tmp->xchg(0,$i));
$tmp -= $offset; $tmp *= $tmp;
$r += $tmp;
}
return $opt{Squared} ? $r : $r->inplace->sqrt;
}
=head2 axisvals
=for ref
Fills a piddle with index values on Nth dimension
=for usage
$z = axisvals ($piddle, $nth);
This is the routine, for which L<xvals|/xvals>, L<yvals|/yvals> etc
are mere shorthands. C<axisvals> can be used to fill
along any dimension.
Note the 'from specification' style (see L<zeroes|PDL::Core/zeroes>) is
not available here, for obvious reasons.
=cut
sub PDL::axisvals {
my($this,$nth) = @_;
my $dummy = $this->new_or_inplace;
if($dummy->getndims() <= $nth) {
# This is 'kind of' consistency...
$dummy .= 0;
return $dummy;
# barf("Too few dimensions given to axisvals $nth\n");
}
my $bar = $dummy->xchg(0,$nth);
PDL::Primitive::axisvalues($bar);
return $dummy;
}
# We need this version for xvals etc to work in place
sub axisvals2 {
my($this,$nth) = @_;
my $dummy = shift;
if($dummy->getndims() <= $nth) {
# This is 'kind of' consistency...
$dummy .= 0;
return $dummy;
# barf("Too few dimensions given to axisvals $nth\n");
}
my $bar = $dummy->xchg(0,$nth);
PDL::Primitive::axisvalues($bar);
return $dummy;
}
=head2 allaxisvals
=for ref
Generates a piddle with index values
=for usage
$z = allaxisvals ($piddle);
C<allaxisvals> produces an array with axis values along each dimension,
adding an extra dimension at the start.
C<allaxisvals($piddle)-E<gt>slice("($nth)")> will produce the same result
as C<axisvals($piddle,$nth)> (although with extra work and not inplace).
It's useful when all the values will be required, as in the example
given of a generalized L<rvals|/rvals>.
=cut
sub PDL::allaxisvals {
my($this) = @_;
my($dims) = $this->getndims;
my($dummy) = $this->dummy(0,$dims)->new;
my(@dums) = $dummy->mv(0,$dims)->dog;
foreach (0 .. $dims-1) {
my $bar = $dums[$_]->xchg(0,$_);
PDL::Primitive::axisvalues($bar);
}
return $dummy;
}
sub PDL::sec {
my($this,@coords) = @_;
my $i; my @maps;
while($#coords > -1) {
$i = int(shift @coords) ;
push @maps, "$i:".int(shift @coords);
}
my $tmp = PDL->null;
$tmp .= $this->slice(join ',',@maps);
return $tmp;
}
sub PDL::ins {
my($this,$what,@coords) = @_;
my $w = PDL::Core::alltopdl($PDL::name,$what);
my $tmp;
if($this->is_inplace) {
$this->set_inplace(0);
} else {
$this = $this->copy;
}
($tmp = $this->slice(
(join ',',map {int($coords[$_]).":".
((int($coords[$_])+$w->getdim($_)-1)<$this->getdim($_) ?
(int($coords[$_])+$w->getdim($_)-1):$this->getdim($_))
}
0..$#coords)))
.= $w;
return $this;
}
sub PDL::similar_assign {
my($from,$to) = @_;
if((join ',',@{$from->dims}) ne (join ',',@{$to->dims})) {
barf "Similar_assign: dimensions [".
(join ',',@{$from->dims})."] and [".
(join ',',@{$to->dims})."] do not match!\n";
}
$to .= $from;
}
=head2 transpose
=for ref
transpose rows and columns.
=for usage
$b = transpose($a); $b = ~$a;
Also bound to the C<~> unary operator in PDL::Matrix.
=for example
perldl> $a = sequence(3,2)
perldl> p $a
[
[0 1 2]
[3 4 5]
]
perldl> p transpose( $a )
[
[0 3]
[1 4]
[2 5]
]
=cut
sub PDL::transpose {
my($this) = @_;
if($this->getndims == 1) {
# 1-Dim: add dummy
return pdl $this->dummy(0);
}
return $this->xchg(0,1)->sever;
}
1;