package PDL::Util;
{
$PDL::Util::VERSION = '0.010';
}
use strict;
use warnings;
=head1 NAME
PDL::Util
=head1 SYNOPSIS
use PDL;
use PDL::Util 'export2d';
my $pdl = rvals(6,4);
open my $fh, '>', 'file.dat';
export2d($pdl, $fh);
=head1 DESCRIPTION
Convenient utility functions/methods for use with PDL.
=cut
use PDL;
use Scalar::Util qw/openhandle blessed/;
use Carp;
use parent 'Exporter';
our %EXPORT_TAGS = (
functions => [qw/add_pdl_method/],
methods => [qw/unroll export2d/],
);
our @EXPORT_OK;
push @EXPORT_OK, @$_ for values %EXPORT_TAGS;
$EXPORT_TAGS{'all'} = \@EXPORT_OK;
=head1 IMPORT
use PDL:Util 'export2d', ['unroll']
# imports 'export2d', adds 'unroll' as a PDL method
L<PDL::Util> does not export anything by default. A list of symbols may be imported as usual. The exportable symbols come in two types, functions (tag C<:function>) and methods (tag C<:methods>). The word I<methods> here is a strange word. When importing symbols one does not import methods. In this context a 'method' is a function which expects a piddle as its first argument. However, there is a reason ...
If an array reference or hash reference is passed as the last item in the import list, the reference will be passed to the L<add_pdl_method> function below, in which case these functions are imported into the C<PDL> namespace and may be used as method calls. Note, when doing this for symbols from the L<PDL::Util> module, only those listed in the C<:methods> tag may be added as a method (this is the origin of the confusing terminology). Read about the L<add_pdl_method> function carefully before using this functionality.
=cut
sub import {
my $package = shift;
return 1 unless @_;
my $ref_last = ref $_[-1] || '';
my $method_spec = ( grep {$ref_last eq $_} qw/HASH ARRAY/ ) ? pop : 0;
add_pdl_method($method_spec) if ($method_spec);
__PACKAGE__->export_to_level(1, $package, @_) if @_;
}
=head1 TAG :functions
=head2 add_pdl_method
add_pdl_method({'my_method' => sub { my $self = shift; ... });
$pdl->my_method # calls the anonymous sub on $pdl
add_pdl_method(['export2d']);
$pdl->export2d() # calls 'export2d' on $pdl
add_pdl_method({'my_unroll' => 'unroll'});
$pdl->my_unroll() # calls 'unroll' method on $pdl
C<add_pdl_method> pushes subroutines into the PDL namespace. It takes a single argument, a reference either an array or hash. The keys of the hash reference are the method name that will be used in the call (e.g. C<< $pdl->method_name >>, the values are either a reference to a subroutine or a string containing the name of a method provided by L<PDL::Util>. The array reference form can only take names of C<PDL::Util> methods.
When adding your own subroutine as a L<PDL> method, be aware that the first argument passed will be a self (i.e. C<$self>) reference, in the normal Perl OO manner.
=cut
sub add_pdl_method {
my $spec = shift;
croak 'make_pdl_method expects a hash or array reference as its argument'
unless grep {ref $spec eq $_} qw/HASH ARRAY/;
if (ref $spec eq 'ARRAY') {
$spec = { map { $_ => $_ } @$spec };
}
foreach my $method (keys %$spec) {
my $function = $spec->{$method};
# Check to see if PDL already has a method by the same name
carp <<MESSAGE if PDL->can($method);
PDL already provides a method named '$method', read the PDL::Util documentation to learn to avoid this conflict.
MESSAGE
unless (ref $function && ref $function eq 'CODE') {
if ( 1 == grep { $_ eq $function } @{ $EXPORT_TAGS{'methods'} } ) {
no strict 'refs';
$function = \&{ 'PDL::Util::' . $function };
} else {
croak "value for $method must be either a code reference or the name of one of PDL::Util's exportable functions";
}
}
no strict 'refs';
*{'PDL::'.$method} = $function;
}
}
=head1 TAG :methods
Again, the I<functions> provided in the method tag are not automatically methods. They simply are function which are called with a PDL object (piddle) as their first argument. This function ARE available to be imported into the PDL namespace using the L<add_pdl_method> function describe above.
=head2 unroll
$AoA = unroll($pdl);
-- or --
$AoA = $pdl->unroll();
L<PDL> provides a function for constructing a PDL object (piddle) from a Perl nested array, however it does not provide a tool to convert a piddle to a nested array structure. The closest function is the C<list> function, which returns the elements of the piddle as a list, i.e. a 1D flattened array. C<unroll> converts piddles to a native Perl data structure; it can be thought of as the logical inverse of the C<pdl> function in that C<pdl(unroll($pdl))> should return the original data structure, although bad values and data types may be changed.
When called as a function C<unroll> takes a single argument (the piddle to unroll). When used as a method it takes no arguments. It returns a reference to an array containing the Perl equivalent data structure.
=cut
sub unroll {
my $pdl = shift;
if ( blessed($pdl) and $pdl->isa('PDL') ) {
if ($pdl->ndims > 1) {
return [ map {unroll($_)} dog $pdl ];
} else {
return [list $pdl];
}
} else {
croak "Attempted to unroll a non-PDL object";
#return $pdl;
}
}
=head2 export2d
export2d($pdl, $fh, ',');
-- or --
$pdl->export2d($fh, ',');
C<export2d> may take up to 2 optional arguments (neglecting the object reference), a lexical filehandle (or globref, e.g. C<\*FILE>) to write to, and a string containing a column separator. The defaults, if arguments are not given are to print to STDOUT and use a single space as the column separator. The order does not matter, the method will determine whether an argument refers to a file or not. This is done so that one may call either
$pdl->export2d($fh);
$pdl->export2d(',');
and it will do what you mean. Unfortunately this means that unlike C<wcols> one cannot use a filename rather than a filehandle; C<export2d> would interpret the string as the column separator!
The method returns the number of columns that were written.
=cut
sub export2d {
my ($pdl, $fh, $sep);
$pdl = shift;
unless ( blessed($pdl) and $pdl->isa('PDL') ) {
carp "cannot call export2d without a piddle input";
return 0;
}
unless ($pdl->ndims == 2) {
carp "export2d may only be called on a 2D piddle";
return 0;
}
# Parse additional input parameters
while (@_) {
my $param = shift;
if (openhandle($param)) {
$fh = $param;
} else {
$sep = $param;
}
}
# Extract columns from piddle
my @params = map {$pdl->slice("($_),")} (0..$pdl->dim(0)-1);
my $num_cols = @params;
# Push additional parameters for wcols
push @params, $fh if (defined $fh);
push @params, {Colsep => $sep} if (defined $sep);
# Write columns
wcols @params;
return $num_cols;
}
1;
=head1 SEE ALSO
L<PDL>
L<Website|http://pdl.perl.org>
=head1 SOURCE REPOSITORY
L<http://github.com/jberger/PDL-Util>
=head1 AUTHOR
Joel Berger, E<lt>joel.a.berger@gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2011 by Joel Berger
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.