4
PDL::Interpolate - provide a consistent interface to the interpolation routines available in PDL
10
my $i = new PDL::Interpolate( x => $x, y = $y );
11
my $y = $i->interpolate( $xi );
15
This module aims to provide a relatively-uniform interface
16
to the various interpolation methods available to PDL.
17
The idea is that a different interpolation scheme
18
can be used just by changing the C<new> call.
20
At present, PDL::Interpolate itself just provides
21
a somewhat-convoluted interface to the C<interpolate>
22
function of L<PDL::Primitive|PDL::Primitive/interpolate>.
23
However, it is expected that derived classes,
25
L<PDL::Interpolate::Slatec|PDL::Interpolate::Slatec>,
26
will actually be used in real-world situations.
28
To use, create a PDL::Interpolate (or a derived class)
29
object, supplying it with its required attributes.
33
Currently, the avaliable classes are
37
=item PDL::Interpolate
39
Provides an interface to the interpolation routines of PDL.
40
At present this is the linear interpolation routine
41
L<PDL::Primitive::interpol|PDL::Primitive/interpol>.
43
=item PDL::Interpolate::Slatec
45
The SLATEC library contains several approaches to interpolation:
46
piecewise cubic Hermite functions and B-splines.
47
At present, only the former method is available.
51
It should be relatively easy to provide an interface to other
52
interpolation routines, such as those provided by the
53
Gnu Scientific Library (GSL).
57
The attributes (or options) of an object are as follows;
58
derived classes may modify this list.
60
Attribute Flag Description
61
x sgr x positions of data
62
y sgr function values at x positions
63
bc g boundary conditions
65
type g type of interpolation
67
A flag of C<s> means that a user can set this attribute
68
with the L<new|/new> or L<set|/set> methods,
69
a flag of C<g> means that the user can obtain the
70
value of this attribute using L<get|/get>,
71
and a flag of C<r> means that the attribute is required
72
when an object is created (see the L<new|/new> method).
74
Attribute Default value
78
If a routine is sent an attribute it does not understand, then
79
it ignores that attribute, except for L<get|/get>, which
80
returns C<undef> for that value.
84
The default methods are described below. However, defined classes
85
may extend them as they see fit, and add new methods.
87
Throughout this documentation, C<$x> and C<$y> refer to the function
88
to be interpolated whilst C<$xi> and C<$yi> are the interpolated values.
92
The class will thread properly if the routines it calls do so.
93
See the SYNOPSIS section of L<PDL::Interpolate::Slatec>
94
(if available) for an example.
98
package PDL::Interpolate;
103
####################################################################
111
$obj = new PDL::Interpolate( x => $x, y => $y );
115
Create a PDL::Interpolate object.
117
The required L<attributes|/attributes> are
119
At present the only available interpolation method
120
is C<"linear"> - which just uses
121
L<PDL::Primitive::interpolate|PDL::Primitive::interpolate> - and
122
there are no options for boundary conditions, which is why
123
the C<type> and C<bc> attributes can not be changed.
128
# required - required, if this attr is changed, we need to re-initialise
129
# settable - can be changed with a new() or set() command
130
# gettable - can be read with a get() command
134
my $class = ref($this) || $this;
140
types => { required => 0, settable => 0, gettable => 0 },
141
flags => { library => "PDL", status => 1, routine => "none", changed => 1 },
144
# make $self into an object
147
# set up default attributes
150
x => { required => 1, settable => 1, gettable => 1 },
151
y => { required => 1, settable => 1, gettable => 1 },
152
bc => { gettable => 1 },
153
err => { gettable => 1 },
154
type => { gettable => 1 },
162
# - expect sub-classes to call this new with no variables, so $#_ == -1
163
$self->set( @_ ) if ( @_ );
170
#####################################################################
172
# in _add_attr(), _change_attr() and _add_attr_type()
173
# we set flags->changed to 1 when something changes. It's
174
# a bit over the top to do this, as these should only be called when
175
# creating the object, when the changed flag should be set to 1 anyway
177
# add attributes to the object and sets value to undef
179
# supply a hash array, keys == variable name,
180
# values are a hash array with keys matching
181
# $self->{values}, which also gives the default value
184
# this can only be used to create an attribute -
185
# see _change_attr() to change an already exsiting attribute.
187
# the fields are set to the default values, then filled in with the supplied values
188
# any value that is unknown is ignored
194
foreach my $attr ( keys %attrs ) {
195
croak "ERROR: adding an attribute ($attr) which is already known.\n"
196
if defined $self->{attributes}->{$attr};
199
foreach my $type ( keys %{$self->{types}} ) {
200
$self->{attributes}->{$attr}->{$type} = $self->{types}->{$type};
203
# change the values to those supplied
204
foreach my $type ( keys %{$attrs{$attr}} ) {
205
$self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type}
206
if exists $self->{types}->{$type};
209
$self->{values}->{$attr} = undef;
211
$self->{flags}->{changed} = 1;
215
# changes attributes of the object
217
# the given attributes MUST already exist
223
foreach my $attr ( keys %attrs ) {
224
croak "ERROR: changing an attribute ($attr) which is not known.\n"
225
unless defined $self->{attributes}->{$attr};
227
# change the values to those supplied
228
foreach my $type ( keys %{$attrs{$attr}} ) {
229
if ( exists $self->{types}->{$type} ) {
230
$self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type};
231
$self->{flags}->{changed} = 1;
235
} # sub: _change_attr()
237
# adds the given types to the allowed list, and
238
# updates all attributes to contain the default value
240
# Useful for sub-classes which add new types
246
foreach my $type ( keys %types ) {
247
croak "ERROR: adding type ($type) that is already known.\n"
248
if exists $self->{types}->{$type};
249
$self->{types}->{$type} = $types{$type};
251
# loop through each attribute, adding this type
252
foreach my $attr ( keys %{$self->{attributes}} ) {
253
$self->{attributes}->{$attr}->{$type} = $types{$type};
256
$self->{flags}->{changed} = 1;
258
} # sub: _add_attr_type()
260
####################################################################
262
# if an attribute has changed, check all required attributes
263
# still exist and re-initialise the object (for PDL::Interpolate
268
return unless $self->{flags}->{changed};
271
foreach my $name ( keys %{ $self->{attributes} } ) {
272
if( $self->{attributes}->{$name}->{required} ) {
273
push @emsg, $name unless defined($self->{values}->{$name});
276
croak "ERROR - the following attributes must be supplied:\n [ @emsg ]\n"
279
$self->{flags}->{routine} = "none";
280
$self->{flags}->{status} = 1;
283
$self->{flags}->{new} = 0;
285
} # sub: check_attr()
287
####################################################################
289
# method to be over-ridden by sub-classes
291
# PDL::Interpolate needs no initialisation
295
####################################################################
297
# a version of set that ignores the settable flag
298
# - for use by the class, not by the public
300
# it still ignores unknown attributes
306
foreach my $attr ( keys %attrs ) {
307
if ( exists($self->{values}->{$attr}) ) {
308
$self->{values}->{$attr} = $attrs{$attr};
309
$self->{flags}->{changed} = 1;
313
} # sub: _set_value()
315
# a version of get that ignores the gettable flag
316
# - for use by the class, not by the public
318
# an unknown attribute returns an undef
324
foreach my $name ( @_ ) {
325
if ( exists $self->{values}->{$name} ) {
326
push @ret, $self->{values}->{$name};
332
return wantarray ? @ret : $ret[0];
334
} # sub: _get_value()
336
####################################################################
342
my $nset = $obj->set( x = $newx, $y => $newy );
346
Set attributes for a PDL::Interpolate object.
348
The return value gives the number of the supplied attributes
349
which were actually set.
358
foreach my $name ( keys %vals ) {
359
if ( exists $self->{attributes}->{$name}->{settable} ) {
360
$self->{values}->{$name} = $vals{$name};
365
$self->{flags}->{changed} = 1 if $ctr;
370
####################################################################
376
my $x = $obj->get( x );
377
my ( $x, $y ) = $obj->get( qw( x y ) );
381
Get attributes from a PDL::Interpolate object.
383
Given a list of attribute names, return a list of
384
their values; in scalar mode return a scalar value.
385
If the supplied list contains an unknown attribute,
386
C<get> returns a value of C<undef> for that
395
foreach my $name ( @_ ) {
396
if ( exists $self->{attributes}->{$name}->{gettable} ) {
397
push @ret, $self->{values}->{$name};
403
return wantarray ? @ret : $ret[0];
407
####################################################################
413
my $yi = $obj->interpolate( $xi );
417
Returns the interpolated function at a given set of points.
419
A status value of -1, as returned by the C<status> method,
420
means that some of the C<$xi> points lay outside the
421
range of the data. The values for these points
422
were calculated using linear extrapolation.
430
croak 'Usage: $obj->interpolate( $xi )' . "\n"
433
# check everything is fine
434
$self->_check_attr();
436
# get values in one go
437
my ( $x, $y ) = $self->_get_value( qw( x y ) );
439
my ( $yi, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
442
$self->{flags}->{status} = -1;
444
$self->{flags}->{status} = 1;
446
$self->_set_value( err => $err );
448
$self->{flags}->{routine} = "interpolate";
453
####################################################################
455
# access to flags - have individual methods for these
461
my $status = $obj->status;
465
Returns the status of a PDL::Interpolate object
467
Returns B<1> if everything is okay, B<0> if
468
there has been a serious error since the last time
469
C<status> was called, and B<-1> if there
470
was a problem which was not serious.
471
In the latter case, C<$obj-E<gt>get("err")> may
472
provide more information, depending on the
477
sub status { my $self = shift; return $self->{flags}->{status}; }
483
my $name = $obj->library;
487
Returns the name of the library used by a PDL::Interpolate object
489
For PDL::Interpolate, the library name is C<"PDL">.
493
sub library { my $self = shift; return $self->{flags}->{library}; }
499
my $name = $obj->routine;
503
Returns the name of the last routine called by a PDL::Interpolate object.
505
For PDL::Interpolate, the only routine used is C<"interpolate">.
506
This will be more useful when calling derived classes,
507
in particular when trying to decode the values stored in the
512
sub routine { my $self = shift; return $self->{flags}->{routine}; }
519
PDL::Interpolate::attributes;
523
Print out the flags for the attributes of an object.
524
Useful in case the documentation is just too opaque!
528
PDL::Interpolate->attributes;
538
# note, can be called with the class, rather than just
541
# to allow this, I've used a horrible hack - we actually
542
# create an object and then print out the attributes from that
549
$self = $self->new unless ref($self);
551
print "Flags Attribute\n";
552
while ( my ( $attr, $hashref ) = each %{$self->{attributes}} ) {
554
$flag .= "S" if $hashref->{settable};
555
$flag .= "G" if $hashref->{gettable};
556
$flag .= "R" if $hashref->{required};
558
printf " %-3s %s\n", $flag, $attr;
563
####################################################################
567
Copyright (C) 2000 Doug Burke (burke@ifa.hawaii.edu).
568
All rights reserved. There is no warranty.
569
You are allowed to redistribute this software / documentation as
570
described in the file COPYING in the PDL distribution.
578
####################################################################
added
removed
Lib/Interpolate/Interpolate.pm
