PDL::Interpolate - provide a consistent interface to the interpolation routines available in PDL
Index
Code Index:
NAME
PDL::Interpolate - provide a consistent interface to the interpolation routines available in PDL
SYNOPSIS
use PDL::Interpolate;
my $i = new PDL::Interpolate( x => $x, y = $y );
my $y = $i->interpolate( $xi );
DESCRIPTION
This module aims to provide a relatively-uniform interface
to the various interpolation methods available to PDL.
The idea is that a different interpolation scheme
can be used just by changing the new call.
At present, PDL::Interpolate itself just provides
a somewhat-convoluted interface to the interpolate
function of PDL::Primitive (interpolate in PDL::Primitive).
However, it is expected that derived classes,
such as
PDL::Interpolate::Slatec,
will actually be used in real-world situations.
To use, create a PDL::Interpolate (or a derived class)
object, supplying it with its required attributes.
LIBRARIES
Currently, the avaliable classes are
- PDL::Interpolate
-
Provides an interface to the interpolation routines of PDL.
At present this is the linear interpolation routine
PDL::Primitive::interpol (interpol in PDL::Primitive).
- PDL::Interpolate::Slatec
-
The SLATEC library contains several approaches to interpolation:
piecewise cubic Hermite functions and B-splines.
At present, only the former method is available.
It should be relatively easy to provide an interface to other
interpolation routines, such as those provided by the
Gnu Scientific Library (GSL).
ATTRIBUTES
The attributes (or options) of an object are as follows;
derived classes may modify this list.
Attribute Flag Description
x sgr x positions of data
y sgr function values at x positions
bc g boundary conditions
err g error flag
type g type of interpolation
A flag of s means that a user can set this attribute
with the new or set methods,
a flag of g means that the user can obtain the
value of this attribute using get,
and a flag of r means that the attribute is required
when an object is created (see the new method).
Attribute Default value
bc "none"
type "linear"
If a routine is sent an attribute it does not understand, then
it ignores that attribute, except for get, which
returns undef for that value.
METHODS
The default methods are described below. However, defined classes
may extend them as they see fit, and add new methods.
Throughout this documentation, $x and $y refer to the function
to be interpolated whilst $xi and $yi are the interpolated values.
THREADING
The class will thread properly if the routines it calls do so.
See the SYNOPSIS section of PDL::Interpolate::Slatec
(if available) for an example.
new
$obj = new PDL::Interpolate( x => $x, y => $y );
Create a PDL::Interpolate object.
The required attributes are
x and y.
At present the only available interpolation method
is "linear" - which just uses
PDL::Primitive::interpolate (PDL::Primitive::interpolate) - and
there are no options for boundary conditions, which is why
the type and bc attributes can not be changed.
set
my $nset = $obj->set( x = $newx, $y => $newy );
Set attributes for a PDL::Interpolate object.
The return value gives the number of the supplied attributes
which were actually set.
get
my $x = $obj->get( x );
my ( $x, $y ) = $obj->get( qw( x y ) );
Get attributes from a PDL::Interpolate object.
Given a list of attribute names, return a list of
their values; in scalar mode return a scalar value.
If the supplied list contains an unknown attribute,
get returns a value of undef for that
attribute.
interpolate
my $yi = $obj->interpolate( $xi );
Returns the interpolated function at a given set of points.
A status value of -1, as returned by the status method,
means that some of the $xi points lay outside the
range of the data. The values for these points
were calculated using linear extrapolation.
status
my $status = $obj->status;
Returns the status of a PDL::Interpolate object
Returns 1 if everything is okay, 0 if
there has been a serious error since the last time
status was called, and -1 if there
was a problem which was not serious.
In the latter case, $obj->get("err") may
provide more information, depending on the
particular class.
library
my $name = $obj->library;
Returns the name of the library used by a PDL::Interpolate object
For PDL::Interpolate, the library name is "PDL".
routine
my $name = $obj->routine;
Returns the name of the last routine called by a PDL::Interpolate object.
For PDL::Interpolate, the only routine used is "interpolate".
This will be more useful when calling derived classes,
in particular when trying to decode the values stored in the
err attribute.
attributes
$obj->attributes;
PDL::Interpolate::attributes;
Print out the flags for the attributes of an object.
Useful in case the documentation is just too opaque!
PDL::Interpolate->attributes;
Flags Attribute
SGR x
SGR y
G err
G type
G bc
AUTHOR
Copyright (C) 2000 Doug Burke (burke@ifa.hawaii.edu).
All rights reserved. There is no warranty.
You are allowed to redistribute this software / documentation as
described in the file COPYING in the PDL distribution.
SEE ALSO
package PDL::Interpolate;
use Carp;
use strict;
####################################################################
## Public routines:
# meaning of types:
# required - required, if this attr is changed, we need to re-initialise
# settable - can be changed with a new() or set() command
# gettable - can be read with a get() command
#
sub new {
my $this = shift;
my $class = ref($this) || $this;
# class structure
my $self = {
attributes => {},
values => {},
types => { required => 0, settable => 0, gettable => 0 },
flags => { library => "PDL", status => 1, routine => "none", changed => 1 },
};
# make $self into an object
bless $self, $class;
# set up default attributes
#
$self->_add_attr(
x => { required => 1, settable => 1, gettable => 1 },
y => { required => 1, settable => 1, gettable => 1 },
bc => { gettable => 1 },
err => { gettable => 1 },
type => { gettable => 1 },
);
$self->_set_value(
bc => "none",
type => "linear",
);
# set variables
# - expect sub-classes to call this new with no variables, so $#_ == -1
$self->set( @_ ) if ( @_ );
# return the object
return $self;
} # sub: new()
#####################################################################
# in _add_attr(), _change_attr() and _add_attr_type()
# we set flags->changed to 1 when something changes. It's
# a bit over the top to do this, as these should only be called when
# creating the object, when the changed flag should be set to 1 anyway
# add attributes to the object and sets value to undef
#
# supply a hash array, keys == variable name,
# values are a hash array with keys matching
# $self->{values}, which also gives the default value
# for the type
#
# this can only be used to create an attribute -
# see _change_attr() to change an already exsiting attribute.
#
# the fields are set to the default values, then filled in with the supplied values
# any value that is unknown is ignored
#
sub _add_attr {
my $self = shift;
my %attrs = ( @_ );
foreach my $attr ( keys %attrs ) {
croak "ERROR: adding an attribute ($attr) which is already known.\n"
if defined $self->{attributes}->{$attr};
# set default values
foreach my $type ( keys %{$self->{types}} ) {
$self->{attributes}->{$attr}->{$type} = $self->{types}->{$type};
}
# change the values to those supplied
foreach my $type ( keys %{$attrs{$attr}} ) {
$self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type}
if exists $self->{types}->{$type};
}
# set value to undef
$self->{values}->{$attr} = undef;
}
$self->{flags}->{changed} = 1;
} # sub: _add_attr()
# changes attributes of the object
#
# the given attributes MUST already exist
#
sub _change_attr {
my $self = shift;
my %attrs = ( @_ );
foreach my $attr ( keys %attrs ) {
croak "ERROR: changing an attribute ($attr) which is not known.\n"
unless defined $self->{attributes}->{$attr};
# change the values to those supplied
foreach my $type ( keys %{$attrs{$attr}} ) {
if ( exists $self->{types}->{$type} ) {
$self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type};
$self->{flags}->{changed} = 1;
}
}
}
} # sub: _change_attr()
# adds the given types to the allowed list, and
# updates all attributes to contain the default value
#
# Useful for sub-classes which add new types
#
sub _add_attr_type {
my $self = shift;
my %types = ( @_ );
foreach my $type ( keys %types ) {
croak "ERROR: adding type ($type) that is already known.\n"
if exists $self->{types}->{$type};
$self->{types}->{$type} = $types{$type};
# loop through each attribute, adding this type
foreach my $attr ( keys %{$self->{attributes}} ) {
$self->{attributes}->{$attr}->{$type} = $types{$type};
}
$self->{flags}->{changed} = 1;
}
} # sub: _add_attr_type()
####################################################################
# if an attribute has changed, check all required attributes
# still exist and re-initialise the object (for PDL::Interpolate
# this is a nop)
#
sub _check_attr {
my $self = shift;
return unless $self->{flags}->{changed};
my @emsg;
foreach my $name ( keys %{ $self->{attributes} } ) {
if( $self->{attributes}->{$name}->{required} ) {
push @emsg, $name unless defined($self->{values}->{$name});
}
}
croak "ERROR - the following attributes must be supplied:\n [ @emsg ]\n"
unless $#emsg == -1;
$self->{flags}->{routine} = "none";
$self->{flags}->{status} = 1;
$self->_initialise;
$self->{flags}->{new} = 0;
} # sub: check_attr()
####################################################################
#
# method to be over-ridden by sub-classes
# PDL::Interpolate needs no initialisation
#
sub _initialise {}
####################################################################
# a version of set that ignores the settable flag
# - for use by the class, not by the public
#
# it still ignores unknown attributes
#
sub _set_value {
my $self = shift;
my %attrs = ( @_ );
foreach my $attr ( keys %attrs ) {
if ( exists($self->{values}->{$attr}) ) {
$self->{values}->{$attr} = $attrs{$attr};
$self->{flags}->{changed} = 1;
}
}
} # sub: _set_value()
# a version of get that ignores the gettable flag
# - for use by the class, not by the public
#
# an unknown attribute returns an undef
#
sub _get_value {
my $self = shift;
my @ret;
foreach my $name ( @_ ) {
if ( exists $self->{values}->{$name} ) {
push @ret, $self->{values}->{$name};
} else {
push @ret, undef;
}
}
return wantarray ? @ret : $ret[0];
} # sub: _get_value()
####################################################################
sub set {
my $self = shift;
my %vals = ( @_ );
my $ctr = 0;
foreach my $name ( keys %vals ) {
if ( exists $self->{attributes}->{$name}->{settable} ) {
$self->{values}->{$name} = $vals{$name};
$ctr++;
}
}
$self->{flags}->{changed} = 1 if $ctr;
return $ctr;
} # sub: set()
####################################################################
sub get {
my $self = shift;
my @ret;
foreach my $name ( @_ ) {
if ( exists $self->{attributes}->{$name}->{gettable} ) {
push @ret, $self->{values}->{$name};
} else {
push @ret, undef;
}
}
return wantarray ? @ret : $ret[0];
} # sub: get()
####################################################################
sub interpolate {
my $self = shift;
my $xi = shift;
croak 'Usage: $obj->interpolate( $xi )' . "\n"
unless defined $xi;
# check everything is fine
$self->_check_attr();
# get values in one go
my ( $x, $y ) = $self->_get_value( qw( x y ) );
my ( $yi, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
if ( any $err ) {
$self->{flags}->{status} = -1;
} else {
$self->{flags}->{status} = 1;
}
$self->_set_value( err => $err );
$self->{flags}->{routine} = "interpolate";
return $yi;
}
####################################################################
#
# access to flags - have individual methods for these
sub status { my $self = shift; return $self->{flags}->{status}; }
sub library { my $self = shift; return $self->{flags}->{library}; }
sub routine { my $self = shift; return $self->{flags}->{routine}; }
# note, can be called with the class, rather than just
# an object
#
# to allow this, I've used a horrible hack - we actually
# create an object and then print out the attributes from that
# Ugh!
#
sub attributes {
my $self = shift;
# ugh
$self = $self->new unless ref($self);
print "Flags Attribute\n";
while ( my ( $attr, $hashref ) = each %{$self->{attributes}} ) {
my $flag = "";
$flag .= "S" if $hashref->{settable};
$flag .= "G" if $hashref->{gettable};
$flag .= "R" if $hashref->{required};
printf " %-3s %s\n", $flag, $attr;
}
return;
}
####################################################################
####################################################################
# End with a true
1;