"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "GENERATED/PDL/Transform.pm" between
PDL-2.074.tar.gz and PDL-2.075.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

Transform.pm  (PDL-2.074):Transform.pm  (PDL-2.075)
skipping to change at line 17 skipping to change at line 17
our %EXPORT_TAGS = (Func=>\@EXPORT_OK); our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
use PDL::Core; use PDL::Core;
use PDL::Exporter; use PDL::Exporter;
use DynaLoader; use DynaLoader;
our @ISA = ( 'PDL::Exporter','DynaLoader' ); our @ISA = ( 'PDL::Exporter','DynaLoader' );
push @PDL::Core::PP, __PACKAGE__; push @PDL::Core::PP, __PACKAGE__;
bootstrap PDL::Transform ; bootstrap PDL::Transform ;
#line 3 "transform.pd" #line 2 "transform.pd"
=head1 NAME =head1 NAME
PDL::Transform - Coordinate transforms, image warping, and N-D functions PDL::Transform - Coordinate transforms, image warping, and N-D functions
=head1 SYNOPSIS =head1 SYNOPSIS
use PDL::Transform; use PDL::Transform;
my $t = new PDL::Transform::<type>(<opt>) my $t = new PDL::Transform::<type>(<opt>)
skipping to change at line 53 skipping to change at line 53
PDL::Transform is a convenient way to represent coordinate PDL::Transform is a convenient way to represent coordinate
transformations and resample images. It embodies functions mapping transformations and resample images. It embodies functions mapping
R^N -> R^M, both with and without inverses. Provision exists for R^N -> R^M, both with and without inverses. Provision exists for
parametrizing functions, and for composing them. You can use this parametrizing functions, and for composing them. You can use this
part of the Transform object to keep track of arbitrary functions part of the Transform object to keep track of arbitrary functions
mapping R^N -> R^M with or without inverses. mapping R^N -> R^M with or without inverses.
The simplest way to use a Transform object is to transform vector The simplest way to use a Transform object is to transform vector
data between coordinate systems. The L</apply> method data between coordinate systems. The L</apply> method
accepts a PDL whose 0th dimension is coordinate index (all other accepts a PDL whose 0th dimension is coordinate index (all other
dimensions are threaded over) and transforms the vectors into the new dimensions are broadcasted over) and transforms the vectors into the new
coordinate system. coordinate system.
Transform also includes image resampling, via the L</map> method. Transform also includes image resampling, via the L</map> method.
You define a coordinate transform using a Transform object, then use You define a coordinate transform using a Transform object, then use
it to remap an image PDL. The output is a remapped, resampled image. it to remap an image PDL. The output is a remapped, resampled image.
You can define and compose several transformations, then apply them You can define and compose several transformations, then apply them
all at once to an image. The image is interpolated only once, when all at once to an image. The image is interpolated only once, when
all the composed transformations are applied. all the composed transformations are applied.
skipping to change at line 160 skipping to change at line 160
called with the input coordinate, and the "params" hash. This called with the input coordinate, and the "params" hash. This
springboarding is done via explicit ref rather than by subclassing, springboarding is done via explicit ref rather than by subclassing,
for convenience both in coding new transforms (just add the for convenience both in coding new transforms (just add the
appropriate sub to the module) and in adding custom transforms at appropriate sub to the module) and in adding custom transforms at
run-time. Note that, if possible, new C<func>s should support run-time. Note that, if possible, new C<func>s should support
L<inplace|PDL::Core/inplace> operation to save memory when the data are flagged L<inplace|PDL::Core/inplace> operation to save memory when the data are flagged
inplace. But C<func> should always return its result even when inplace. But C<func> should always return its result even when
flagged to compute in-place. flagged to compute in-place.
C<func> should treat the 0th dimension of its input as a dimensional C<func> should treat the 0th dimension of its input as a dimensional
index (running 0..N-1 for R^N operation) and thread over all other input index (running 0..N-1 for R^N operation) and broadcast over all other input
dimensions. dimensions.
=item inv =item inv
Ref to an inverse method that reverses the transformation. It must Ref to an inverse method that reverses the transformation. It must
accept the same "params" hash that the forward method accepts. This accept the same "params" hash that the forward method accepts. This
key can be left undefined in cases where there is no inverse. key can be left undefined in cases where there is no inverse.
=item idim, odim =item idim, odim
skipping to change at line 255 skipping to change at line 255
of PDL::Transform. of PDL::Transform.
The L</apply>, L</invert>, L</map>, The L</apply>, L</invert>, L</map>,
and L</unmap> methods are also exported to the C<PDL> package: they and L</unmap> methods are also exported to the C<PDL> package: they
are both Transform methods and PDL methods. are both Transform methods and PDL methods.
=cut =cut
use strict; use strict;
use warnings; use warnings;
#line 263 "Transform.pm" #line 264 "Transform.pm"
=head1 FUNCTIONS =head1 FUNCTIONS
=cut =cut
#line 315 "transform.pd" #line 314 "transform.pd"
=head2 apply =head2 apply
=for sig =for sig
Signature: (data(); PDL::Transform t) Signature: (data(); PDL::Transform t)
=for usage =for usage
$out = $data->apply($t); $out = $data->apply($t);
skipping to change at line 309 skipping to change at line 309
if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($from,'PDL')){ if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($from,'PDL')){
croak "Applying a PDL::Transform with no func! Oops.\n" unless(defined($me ->{func}) and ref($me->{func}) eq 'CODE'); croak "Applying a PDL::Transform with no func! Oops.\n" unless(defined($me ->{func}) and ref($me->{func}) eq 'CODE');
my $result = &{$me->{func}}($from,$me->{params}); my $result = &{$me->{func}}($from,$me->{params});
$result->is_inplace(0); # clear inplace flag, just in case. $result->is_inplace(0); # clear inplace flag, just in case.
return $result; return $result;
} else { } else {
croak "apply requires both a PDL and a PDL::Transform.\n"; croak "apply requires both a PDL and a PDL::Transform.\n";
} }
} }
#line 325 "Transform.pm" #line 327 "Transform.pm"
#line 367 "transform.pd" #line 366 "transform.pd"
=head2 invert =head2 invert
=for sig =for sig
Signature: (data(); PDL::Transform t) Signature: (data(); PDL::Transform t)
=for usage =for usage
$out = $t->invert($data); $out = $t->invert($data);
skipping to change at line 356 skipping to change at line 356
if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($data,'PDL')){ if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($data,'PDL')){
croak "Inverting a PDL::Transform with no inverse! Oops.\n" unless(defined ($me->{inv}) and ref($me->{inv}) eq 'CODE'); croak "Inverting a PDL::Transform with no inverse! Oops.\n" unless(defined ($me->{inv}) and ref($me->{inv}) eq 'CODE');
my $result = &{$me->{inv}}($data, $me->{params}); my $result = &{$me->{inv}}($data, $me->{params});
$result->is_inplace(0); # make sure inplace flag is clear. $result->is_inplace(0); # make sure inplace flag is clear.
return $result; return $result;
} else { } else {
croak("invert requires a PDL and a PDL::Transform (did you want 'inverse' instead?)\n"); croak("invert requires a PDL and a PDL::Transform (did you want 'inverse' instead?)\n");
} }
} }
#line 374 "Transform.pm" #line 377 "Transform.pm"
#line 1059 "../../blib/lib/PDL/PP.pm" #line 1058 "../../blib/lib/PDL/PP.pm"
=head2 map =head2 map
=for sig =for sig
Signature: (k0(); pdl *in; pdl *out; pdl *map; SV *boundary; SV *method; Signature: (k0(); pdl *in; pdl *out; pdl *map; SV *boundary; SV *method;
long big; double blur; double sv_min; char flux; SV *bv) long big; double blur; double sv_min; char flux; SV *bv)
=head2 match =head2 match
skipping to change at line 634 skipping to change at line 634
This value lets you set the lower limit of the transformation's This value lets you set the lower limit of the transformation's
singular values in the hanning and gaussian methods, limiting the singular values in the hanning and gaussian methods, limiting the
minimum radius of influence associated with each output pixel. Large minimum radius of influence associated with each output pixel. Large
numbers yield smoother interpolation in magnified parts of the image numbers yield smoother interpolation in magnified parts of the image
but don't affect reduced parts of the image. but don't affect reduced parts of the image.
=item big, Big (default = 0.5) =item big, Big (default = 0.5)
This is the largest allowable input spot size which may be mapped to a This is the largest allowable input spot size which may be mapped to a
single output pixel by the hanning and gaussian methods, in units of single output pixel by the hanning and gaussian methods, in units of
the largest non-thread input dimension. (i.e. the default won't let the largest non-broadcast input dimension. (i.e. the default won't let
you reduce the original image to less than 5 pixels across). This places you reduce the original image to less than 5 pixels across). This places
a limit on how long the processing can take for pathological transformations. a limit on how long the processing can take for pathological transformations.
Smaller numbers keep the code from hanging for a long time; larger numbers Smaller numbers keep the code from hanging for a long time; larger numbers
provide for photometric accuracy in more pathological cases. Numbers larer provide for photometric accuracy in more pathological cases. Numbers larer
than 1.0 are silly, because they allow the entire input array to be compressed than 1.0 are silly, because they allow the entire input array to be compressed
into a region smaller than a single pixel. into a region smaller than a single pixel.
Wherever an output pixel would require averaging over an area that is too Wherever an output pixel would require averaging over an area that is too
big in input space, it instead gets NaN or the bad value. big in input space, it instead gets NaN or the bad value.
skipping to change at line 701 skipping to change at line 701
do some smoothing over bad values: if more than 1/3 of the weighted do some smoothing over bad values: if more than 1/3 of the weighted
input-array footprint of a given output pixel is bad, then the output input-array footprint of a given output pixel is bad, then the output
pixel gets marked bad. pixel gets marked bad.
=for bad =for bad
map does not process bad values. map does not process bad values.
It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
=cut =cut
#line 727 "Transform.pm" #line 731 "Transform.pm"
#line 1060 "../../blib/lib/PDL/PP.pm" #line 1059 "../../blib/lib/PDL/PP.pm"
sub PDL::match { sub PDL::match {
# Set default for rectification to 0 for simple matching... # Set default for rectification to 0 for simple matching...
if( ref($_[$#_]) ne 'HASH' ) { if( ref($_[$#_]) ne 'HASH' ) {
push(@_,{}) push(@_,{})
} }
my @k = grep(m/^r(e(c(t)?)?)?/,sort keys %{$_[-1]}); my @k = grep(m/^r(e(c(t)?)?)?/,sort keys %{$_[-1]});
#line 739 "Transform.pm" #line 744 "Transform.pm"
#line 1067 "../../blib/lib/PDL/PP.pm" #line 1067 "../../blib/lib/PDL/PP.pm"
unless(@k) { unless(@k) {
$_[-1]->{rectify} = 0; $_[-1]->{rectify} = 0;
} }
t_identity()->map(@_); t_identity()->map(@_);
} }
*PDL::map = \&map; *PDL::map = \&map;
sub map { sub map {
my($me) = shift; my($me) = shift;
skipping to change at line 761 skipping to change at line 761
# Generate an appropriate output ndarray for values to go in # Generate an appropriate output ndarray for values to go in
my($out); my($out);
my(@odims); my(@odims);
my($ohdr); my($ohdr);
if(UNIVERSAL::isa($tmp,'PDL')) { if(UNIVERSAL::isa($tmp,'PDL')) {
@odims = $tmp->dims; @odims = $tmp->dims;
my($x); my($x);
if(defined ($x = $tmp->gethdr)) { if(defined ($x = $tmp->gethdr)) {
my(%b) = %{$x}; my(%b) = %{$x};
#line 790 "Transform.pm" #line 795 "Transform.pm"
#line 1116 "../../blib/lib/PDL/PP.pm" #line 1116 "../../blib/lib/PDL/PP.pm"
$ohdr = \%b; $ohdr = \%b;
} }
} elsif(ref $tmp eq 'HASH') { } elsif(ref $tmp eq 'HASH') {
# (must be a fits header -- or would be filtered above) # (must be a fits header -- or would be filtered above)
for my $i(1..$tmp->{NAXIS}){ for my $i(1..$tmp->{NAXIS}){
push(@odims,$tmp->{"NAXIS$i"}); push(@odims,$tmp->{"NAXIS$i"});
} }
# deep-copy fits header into output # deep-copy fits header into output
my %foo = %{$tmp}; my %foo = %{$tmp};
#line 801 "Transform.pm" #line 806 "Transform.pm"
#line 1125 "../../blib/lib/PDL/PP.pm" #line 1125 "../../blib/lib/PDL/PP.pm"
$ohdr = \%foo; $ohdr = \%foo;
} elsif(ref $tmp eq 'ARRAY') { } elsif(ref $tmp eq 'ARRAY') {
@odims = @$tmp; @odims = @$tmp;
} else { } else {
barf("map: confused about dimensions of the output array...\n"); barf("map: confused about dimensions of the output array...\n");
} }
if(scalar(@odims) < scalar($in->dims)) { if(scalar(@odims) < scalar($in->dims)) {
my @idims = $in->dims; my @idims = $in->dims;
skipping to change at line 968 skipping to change at line 968
} }
$out->hdr->{"NAXIS"} = $nd; $out->hdr->{"NAXIS"} = $nd;
$out->hdr->{"SIMPLE"} = 'T'; $out->hdr->{"SIMPLE"} = 'T';
$out->hdr->{"HISTORY"} .= "Header written by PDL::Transform::Cartograp hy::map"; $out->hdr->{"HISTORY"} .= "Header written by PDL::Transform::Cartograp hy::map";
### Eliminate fancy newfangled output header pointing tags if they exi st ### Eliminate fancy newfangled output header pointing tags if they exi st
### These are the CROTA<n>, PCi_j, and CDi_j. ### These are the CROTA<n>, PCi_j, and CDi_j.
delete @{$out->hdr}{ delete @{$out->hdr}{
grep /(^CROTA\d*$)|(^(CD|PC)\d+_\d+[A-Z]?$)/, keys %{$out->hdr} grep /(^CROTA\d*$)|(^(CD|PC)\d+_\d+[A-Z]?$)/, keys %{$out->hdr}
#line 1000 "Transform.pm" #line 1005 "Transform.pm"
#line 1322 "../../blib/lib/PDL/PP.pm" #line 1322 "../../blib/lib/PDL/PP.pm"
}; };
} else { } else {
# Non-rectified output -- generate a CDi_j matrix instead of the simpl e formalism. # Non-rectified output -- generate a CDi_j matrix instead of the simpl e formalism.
# We have to deal with a linear transformation: we've got: (scaling) x !input x (t x input), # We have to deal with a linear transformation: we've got: (scaling) x !input x (t x input),
# where input is a linear transformation with offset and scaling is a simple scaling. We have # where input is a linear transformation with offset and scaling is a simple scaling. We have
# the scaling parameters and the matrix for !input -- we have only to merge them and then we # the scaling parameters and the matrix for !input -- we have only to merge them and then we
# can write out the FITS header in CDi_j form. # can write out the FITS header in CDi_j form.
print "non-rectify\n" if($PDL::Transform::debug); print "non-rectify\n" if($PDL::Transform::debug);
my $midpoint_val = (pdl(($out->dims)[0..$nd-1])/2 * $scale)->apply( $f _in ); my $midpoint_val = (pdl(($out->dims)[0..$nd-1])/2 * $scale)->apply( $f _in );
skipping to change at line 1014 skipping to change at line 1014
|| ""); || "");
for my $e(1..$nd) { for my $e(1..$nd) {
$out->hdr->{"CD${d}_${e}"} = $mat->at($d-1,$e-1); $out->hdr->{"CD${d}_${e}"} = $mat->at($d-1,$e-1);
print "setting CD${d}_${e} to ".$mat->at($d-1,$e-1)."\n" if($P DL::Transform::debug); print "setting CD${d}_${e} to ".$mat->at($d-1,$e-1)."\n" if($P DL::Transform::debug);
} }
} }
## Eliminate competing header pointing tags if they exist ## Eliminate competing header pointing tags if they exist
delete @{$out->hdr}{ delete @{$out->hdr}{
grep /(^CROTA\d*$)|(^(PC)\d+_\d+[A-Z]?$)|(CDELT\d*$)/, keys %{$out ->hdr} grep /(^CROTA\d*$)|(^(PC)\d+_\d+[A-Z]?$)|(CDELT\d*$)/, keys %{$out ->hdr}
#line 1046 "Transform.pm" #line 1051 "Transform.pm"
#line 1366 "../../blib/lib/PDL/PP.pm" #line 1366 "../../blib/lib/PDL/PP.pm"
}; };
} }
} }
$out->hdrcpy(1); $out->hdrcpy(1);
############################## ##############################
# Sandwich the transform between the input and output plane FITS headers. # Sandwich the transform between the input and output plane FITS headers.
unless($nofits) { unless($nofits) {
skipping to change at line 1064 skipping to change at line 1064
############################## ##############################
## Anti-aliasing code: ## Anti-aliasing code:
## Condition the input and call the pixelwise C interpolator. ## Condition the input and call the pixelwise C interpolator.
## ##
barf("PDL::Transform::map: Too many dims in transformation\n") barf("PDL::Transform::map: Too many dims in transformation\n")
if($in->ndims < $idx->ndims-1); if($in->ndims < $idx->ndims-1);
#################### ####################
## Condition the threading -- pixelwise interpolator only threads ## Condition the broadcasting -- pixelwise interpolator only broadcasts
## in 1 dimension, so squish all thread dimensions into 1, if necessary ## in 1 dimension, so squish all broadcast dimensions into 1, if necessary
my @iddims = $idx->dims; my @iddims = $idx->dims;
my $in2 = $in->ndims == $#iddims my $in2 = $in->ndims == $#iddims
? $in->dummy(-1,1) ? $in->dummy(-1,1)
: $in->reorder($nd..$in->ndims-1, 0..$nd-1) : $in->reorder($nd..$in->ndims-1, 0..$nd-1)
->clump($in->ndims - $nd) ->clump($in->ndims - $nd)
->mv(0,-1); ->mv(0,-1);
#################### ####################
# Allocate the output array # Allocate the output array
my $o2 = PDL->new_from_specification($in2->type, my $o2 = PDL->new_from_specification($in2->type,
skipping to change at line 1126 skipping to change at line 1126
$in2, $o2, $idx, $in2, $o2, $idx,
$bound, $method, $big, $blur, $svmin, $flux, $bv); $bound, $method, $big, $blur, $svmin, $flux, $bv);
my @rdims = (@iddims[1..$#iddims], @idims[$#iddims..$#idims]); my @rdims = (@iddims[1..$#iddims], @idims[$#iddims..$#idims]);
{ {
my $tmp; # work around perl -d "feature" my $tmp; # work around perl -d "feature"
($tmp = $out->slice(":")) .= $o2->reshape(@rdims); ($tmp = $out->slice(":")) .= $o2->reshape(@rdims);
} }
return $out; return $out;
} }
#line 1159 "Transform.pm" #line 1164 "Transform.pm"
#line 1060 "../../blib/lib/PDL/PP.pm"
#line 1061 "../../blib/lib/PDL/PP.pm"
*map = \&PDL::map; *map = \&PDL::map;
#line 1165 "Transform.pm" #line 1171 "Transform.pm"
#line 1998 "transform.pd" #line 1997 "transform.pd"
###################################################################### ######################################################################
=head2 unmap =head2 unmap
=for sig =for sig
Signature: (data(); PDL::Transform a; template(); \%opt) Signature: (data(); PDL::Transform a; template(); \%opt)
=for usage =for usage
skipping to change at line 1171 skipping to change at line 1172
my(@params) = @_; my(@params) = @_;
if(UNIVERSAL::isa($data,'PDL::Transform') && UNIVERSAL::isa($me,'PDL')) { if(UNIVERSAL::isa($data,'PDL::Transform') && UNIVERSAL::isa($me,'PDL')) {
my $x = $data; my $x = $data;
$data = $me; $data = $me;
$me = $x; $me = $x;
} }
return $me->inverse->map($data,@params); return $me->inverse->map($data,@params);
} }
#line 1208 "Transform.pm" #line 1215 "Transform.pm"
#line 2041 "transform.pd" #line 2040 "transform.pd"
=head2 t_inverse =head2 t_inverse
=for usage =for usage
$t2 = t_inverse($t); $t2 = t_inverse($t);
$t2 = $t->inverse; $t2 = $t->inverse;
$t2 = $t ** -1; $t2 = $t ** -1;
$t2 = !$t; $t2 = !$t;
skipping to change at line 1233 skipping to change at line 1234
$out->{ounit} = $me->{iunit}; $out->{ounit} = $me->{iunit};
$out->{iunit} = $me->{ounit}; $out->{iunit} = $me->{ounit};
$out->{name} = "(inverse ".$me->{name}.")"; $out->{name} = "(inverse ".$me->{name}.")";
$out->{is_inverse} = !($out->{is_inverse}); $out->{is_inverse} = !($out->{is_inverse});
bless $out,(ref $me); bless $out,(ref $me);
return $out; return $out;
} }
#line 1272 "Transform.pm" #line 1280 "Transform.pm"
#line 2105 "transform.pd" #line 2104 "transform.pd"
=head2 t_compose =head2 t_compose
=for usage =for usage
$f2 = t_compose($f, $g,[...]); $f2 = t_compose($f, $g,[...]);
$f2 = $f->compose($g[,$h,$i,...]); $f2 = $f->compose($g[,$h,$i,...]);
$f2 = $f x $g x ...; $f2 = $f x $g x ...;
=for ref =for ref
skipping to change at line 1347 skipping to change at line 1348
for my $t ( @{$p->{clist}} ) { for my $t ( @{$p->{clist}} ) {
croak("Error: tried to invert a non-invertible PDL::Transform inside a com position!\n offending transform: $t\n") croak("Error: tried to invert a non-invertible PDL::Transform inside a com position!\n offending transform: $t\n")
unless(defined($t->{inv}) and ref($t->{inv}) eq 'CODE'); unless(defined($t->{inv}) and ref($t->{inv}) eq 'CODE');
$data = &{$t->{inv}}($ip ? $data->inplace : $data, $t->{params}); $data = &{$t->{inv}}($ip ? $data->inplace : $data, $t->{params});
} }
$data; $data;
}; };
return bless($me,'PDL::Transform::Composition'); return bless($me,'PDL::Transform::Composition');
} }
#line 1388 "Transform.pm" #line 1397 "Transform.pm"
#line 2222 "transform.pd" #line 2221 "transform.pd"
=head2 t_wrap =head2 t_wrap
=for usage =for usage
$g1fg = $f->wrap($g); $g1fg = $f->wrap($g);
$g1fg = t_wrap($f,$g); $g1fg = t_wrap($f,$g);
=for ref =for ref
skipping to change at line 1415 skipping to change at line 1416
return $x if(abs($y) == 1); return $x if(abs($y) == 1);
return new PDL::Transform if(abs($y) == 0); return new PDL::Transform if(abs($y) == 0);
my(@l); my(@l);
for my $i(1..abs($y)) { for my $i(1..abs($y)) {
push(@l,$x); push(@l,$x);
} }
t_compose(@l); t_compose(@l);
} }
#line 1460 "Transform.pm" #line 1470 "Transform.pm"
#line 2295 "transform.pd" #line 2294 "transform.pd"
=head2 t_identity =head2 t_identity
=for usage =for usage
my $xform = t_identity my $xform = t_identity
my $xform = new PDL::Transform; my $xform = new PDL::Transform;
=for ref =for ref
skipping to change at line 1450 skipping to change at line 1451
my $me = {name=>'identity', my $me = {name=>'identity',
idim => 0, idim => 0,
odim => 0, odim => 0,
func=>\&PDL::Transform::_identity, func=>\&PDL::Transform::_identity,
inv=>\&PDL::Transform::_identity, inv=>\&PDL::Transform::_identity,
params=>{} params=>{}
}; };
return bless $me,$class; return bless $me,$class;
} }
#line 1497 "Transform.pm" #line 1508 "Transform.pm"
#line 2333 "transform.pd" #line 2332 "transform.pd"
=head2 t_lookup =head2 t_lookup
=for usage =for usage
$f = t_lookup($lookup, {<options>}); $f = t_lookup($lookup, {<options>});
=for ref =for ref
Transform by lookup into an explicit table. Transform by lookup into an explicit table.
skipping to change at line 1481 skipping to change at line 1482
primitive; if you want more, try composing the linear transform with primitive; if you want more, try composing the linear transform with
this one. this one.
The prescribed values in the lookup table are treated as The prescribed values in the lookup table are treated as
pixel-centered: that is, if your input array has N elements per row pixel-centered: that is, if your input array has N elements per row
then valid data exist between the locations (-0.5) and (N-0.5) in then valid data exist between the locations (-0.5) and (N-0.5) in
lookup pixel space, because the pixels (which are numbered from 0 to lookup pixel space, because the pixels (which are numbered from 0 to
N-1) are centered on their locations. N-1) are centered on their locations.
Lookup is done using L<interpND|PDL::Primitive/interpnd>, so the boundary condit ions Lookup is done using L<interpND|PDL::Primitive/interpnd>, so the boundary condit ions
and threading behaviour follow from that. and broadcasting behaviour follow from that.
The indexed-over dimensions come first in the table, followed by a The indexed-over dimensions come first in the table, followed by a
single dimension containing the column vector to be output for each single dimension containing the column vector to be output for each
set of other dimensions -- ie to output 2-vectors from 2 input set of other dimensions -- ie to output 2-vectors from 2 input
parameters, each of which can range from 0 to 49, you want an index parameters, each of which can range from 0 to 49, you want an index
that has dimension list (50,50,2). For the identity lookup table that has dimension list (50,50,2). For the identity lookup table
you could use C<cat(xvals(50,50),yvals(50,50))>. you could use C<cat(xvals(50,50),yvals(50,50))>.
If you want to output a single value per input vector, you still need If you want to output a single value per input vector, you still need
that last index threading dimension -- if necessary, use C<dummy(-1,1)>. that last index broadcasting dimension -- if necessary, use C<dummy(-1,1)>.
The lookup index scaling is: out = lookup[ (scale * data) + offset ]. The lookup index scaling is: out = lookup[ (scale * data) + offset ].
A simplistic table inversion routine is included. This means that A simplistic table inversion routine is included. This means that
you can (for example) use the C<map> method with C<t_lookup> transformations. you can (for example) use the C<map> method with C<t_lookup> transformations.
But the table inversion is exceedingly slow, and not practical for tables But the table inversion is exceedingly slow, and not practical for tables
larger than about 100x100. The inversion table is calculated in its larger than about 100x100. The inversion table is calculated in its
entirety the first time it is needed, and then cached until the object is entirety the first time it is needed, and then cached until the object is
destroyed. destroyed.
skipping to change at line 1607 skipping to change at line 1608
if($data->dim(0) > $me->{idim}) { if($data->dim(0) > $me->{idim}) {
barf("Too many dims (".$data->dim(0).") for your table (".$me->{idim}.")\n "); barf("Too many dims (".$data->dim(0).") for your table (".$me->{idim}.")\n ");
}; };
my($x)= ($table my($x)= ($table
->interpND(float($data) * $scale + $offset, ->interpND(float($data) * $scale + $offset,
$p->{interpND_opt} $p->{interpND_opt}
) )
); );
# Put the index dimension (and threaded indices) back at the front of # Put the index dimension (and broadcasted indices) back at the front of
# the dimension list. # the dimension list.
my($dnd) = $data->ndims - 1; my($dnd) = $data->ndims - 1;
return ($x -> ndims > $data->ndims - 1) ? return ($x -> ndims > $data->ndims - 1) ?
($x->reorder( $dnd..($dnd + $table->ndims - $data->dim(0)-1) ($x->reorder( $dnd..($dnd + $table->ndims - $data->dim(0)-1)
, 0..$data->ndims-2 , 0..$data->ndims-2
) )
) : $x; ) : $x;
}; };
$me->{func} = sub {my($data,$p) = @_; &$lookup_func($data,$p,$p->{table},$p-> {scale},$p->{offset})}; $me->{func} = sub {my($data,$p) = @_; &$lookup_func($data,$p,$p->{table},$p-> {scale},$p->{offset})};
skipping to change at line 1704 skipping to change at line 1705
$p->{itable} = $itable; $p->{itable} = $itable;
} }
&$lookup_func($data,$p, $p->{itable},$p->{iscale},$p->{ioffset}) ; &$lookup_func($data,$p, $p->{itable},$p->{iscale},$p->{ioffset}) ;
}; };
$me->{name} = 'Lookup'; $me->{name} = 'Lookup';
return $me; return $me;
} }
#line 1757 "Transform.pm" #line 1769 "Transform.pm"
#line 2593 "transform.pd" #line 2592 "transform.pd"
=head2 t_linear =head2 t_linear
=for usage =for usage
$f = t_linear({options}); $f = t_linear({options});
=for ref =for ref
Linear (affine) transformations with optional offset Linear (affine) transformations with optional offset
skipping to change at line 2029 skipping to change at line 2030
$out .= "Forward matrix:".($mp->{inverse}) $out .= "Forward matrix:".($mp->{inverse})
if(defined $mp->{inverse}); if(defined $mp->{inverse});
$out .= "Inverse matrix:".($mp->{matrix}) $out .= "Inverse matrix:".($mp->{matrix})
if(defined $mp->{matrix}); if(defined $mp->{matrix});
} }
$out =~ s/\n/\n /go; $out =~ s/\n/\n /go;
$out; $out;
} }
#line 2087 "Transform.pm" #line 2100 "Transform.pm"
#line 2924 "transform.pd" #line 2923 "transform.pd"
=head2 t_scale =head2 t_scale
=for usage =for usage
$f = t_scale(<scale>) $f = t_scale(<scale>)
=for ref =for ref
Convenience interface to L</t_linear>. Convenience interface to L</t_linear>.
t_scale produces a transform that scales around the origin by a fixed t_scale produces a transform that scales around the origin by a fixed
amount. It acts exactly the same as C<t_linear(Scale=>\<scale\>)>. amount. It acts exactly the same as C<t_linear(Scale=>\<scale\>)>.
=cut =cut
sub t_scale { sub t_scale {
my($scale) = shift; my($scale) = shift;
my($y) = shift; my($y) = shift;
return t_linear(scale=>$scale,%{$y}) return t_linear(scale=>$scale,%{$y})
#line 2112 "Transform.pm" #line 2126 "Transform.pm"
#line 2944 "transform.pd" #line 2944 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(Scale=>$scale,$y,@_); t_linear(Scale=>$scale,$y,@_);
} }
#line 2117 "Transform.pm" #line 2131 "Transform.pm"
#line 2952 "transform.pd" #line 2951 "transform.pd"
=head2 t_offset =head2 t_offset
=for usage =for usage
$f = t_offset(<shift>) $f = t_offset(<shift>)
=for ref =for ref
Convenience interface to L</t_linear>. Convenience interface to L</t_linear>.
t_offset produces a transform that shifts the origin to a new location. t_offset produces a transform that shifts the origin to a new location.
It acts exactly the same as C<t_linear(Pre=>\<shift\>)>. It acts exactly the same as C<t_linear(Pre=>\<shift\>)>.
=cut =cut
sub t_offset { sub t_offset {
my($pre) = shift; my($pre) = shift;
my($y) = shift; my($y) = shift;
return t_linear(pre=>$pre,%{$y}) return t_linear(pre=>$pre,%{$y})
#line 2142 "Transform.pm" #line 2157 "Transform.pm"
#line 2972 "transform.pd" #line 2972 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(pre=>$pre,$y,@_); t_linear(pre=>$pre,$y,@_);
} }
#line 2148 "Transform.pm" #line 2163 "Transform.pm"
#line 2981 "transform.pd" #line 2980 "transform.pd"
=head2 t_rot =head2 t_rot
=for usage =for usage
$f = t_rot(<rotation-in-degrees>) $f = t_rot(<rotation-in-degrees>)
=for ref =for ref
Convenience interface to L</t_linear>. Convenience interface to L</t_linear>.
skipping to change at line 2110 skipping to change at line 2111
t_rot produces a rotation transform in 2-D (scalar), 3-D (3-vector), or t_rot produces a rotation transform in 2-D (scalar), 3-D (3-vector), or
N-D (matrix). It acts exactly the same as C<t_linear(Rot=>\<shift\>)>. N-D (matrix). It acts exactly the same as C<t_linear(Rot=>\<shift\>)>.
=cut =cut
*t_rot = \&t_rotate; *t_rot = \&t_rotate;
sub t_rotate { sub t_rotate {
my $rot = shift; my $rot = shift;
my($y) = shift; my($y) = shift;
return t_linear(rot=>$rot,%{$y}) return t_linear(rot=>$rot,%{$y})
#line 2174 "Transform.pm" #line 2190 "Transform.pm"
#line 3002 "transform.pd" #line 3002 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(rot=>$rot,$y,@_); t_linear(rot=>$rot,$y,@_);
} }
#line 2180 "Transform.pm" #line 2196 "Transform.pm"
#line 3013 "transform.pd" #line 3012 "transform.pd"
=head2 t_fits =head2 t_fits
=for usage =for usage
$f = t_fits($fits,[option]); $f = t_fits($fits,[option]);
=for ref =for ref
FITS pixel-to-scientific transformation with inverse FITS pixel-to-scientific transformation with inverse
skipping to change at line 2288 skipping to change at line 2289
$me->{iunit} = \@iunit; $me->{iunit} = \@iunit;
# Check for nonlinear projection... # Check for nonlinear projection...
# if($hdr->{CTYPE1} =~ m/(\w\w\w\w)\-(\w\w\w)/) { # if($hdr->{CTYPE1} =~ m/(\w\w\w\w)\-(\w\w\w)/) {
# print "Nonlinear transformation found... ignoring nonlinear part...\n"; # print "Nonlinear transformation found... ignoring nonlinear part...\n";
# } # }
return $me; return $me;
} }
#line 2356 "Transform.pm" #line 2373 "Transform.pm"
#line 3193 "transform.pd" #line 3192 "transform.pd"
=head2 t_code =head2 t_code
=for usage =for usage
$f = t_code(<func>,[<inv>],[options]); $f = t_code(<func>,[<inv>],[options]);
=for ref =for ref
Transform implementing arbitrary perl code. Transform implementing arbitrary perl code.
skipping to change at line 2382 skipping to change at line 2383
$me->{params} = _opt($o,['p','params','Params']) || {}; $me->{params} = _opt($o,['p','params','Params']) || {};
$me->{idim} = _opt($o,['i','idim']) || 2; $me->{idim} = _opt($o,['i','idim']) || 2;
$me->{odim} = _opt($o,['o','odim']) || 2; $me->{odim} = _opt($o,['o','odim']) || 2;
$me->{itype} = _opt($o,['itype']) || []; $me->{itype} = _opt($o,['itype']) || [];
$me->{otype} = _opt($o,['otype']) || []; $me->{otype} = _opt($o,['otype']) || [];
$me->{iunit} = _opt($o,['iunit']) || []; $me->{iunit} = _opt($o,['iunit']) || [];
$me->{ounit} = _opt($o,['ounit']) || []; $me->{ounit} = _opt($o,['ounit']) || [];
$me; $me;
} }
#line 2452 "Transform.pm" #line 2470 "Transform.pm"
#line 3292 "transform.pd" #line 3291 "transform.pd"
=head2 t_cylindrical =head2 t_cylindrical
C<t_cylindrical> is an alias for C<t_radial> C<t_cylindrical> is an alias for C<t_radial>
=head2 t_radial =head2 t_radial
=for usage =for usage
$f = t_radial(<options>); $f = t_radial(<options>);
skipping to change at line 2555 skipping to change at line 2556
my($os) = $out->slice("0:1"); my($os) = $out->slice("0:1");
$os .= append(cos($d0)->dummy(0,1),-sin($d0)->dummy(0,1)); $os .= append(cos($d0)->dummy(0,1),-sin($d0)->dummy(0,1));
$os *= defined $o->{r0} ? ($o->{r0} * exp($d1)) : $d1; $os *= defined $o->{r0} ? ($o->{r0} * exp($d1)) : $d1;
$os += $o->{origin}; $os += $o->{origin};
$out; $out;
}; };
$me; $me;
} }
#line 2630 "Transform.pm" #line 2649 "Transform.pm"
#line 3470 "transform.pd" #line 3469 "transform.pd"
=head2 t_quadratic =head2 t_quadratic
=for usage =for usage
$t = t_quadratic(<options>); $t = t_quadratic(<options>);
=for ref =for ref
Quadratic scaling -- cylindrical pincushion (n-d; with inverse) Quadratic scaling -- cylindrical pincushion (n-d; with inverse)
skipping to change at line 2671 skipping to change at line 2672
/ 2 / $s * $l) * (1 - 2*($d < $o)); / 2 / $s * $l) * (1 - 2*($d < $o));
$d += $o; $d += $o;
if($data->is_inplace) { if($data->is_inplace) {
$data .= $dd; $data .= $dd;
return $data; return $data;
} }
$dd; $dd;
}; };
$me; $me;
} }
#line 2749 "Transform.pm" #line 2769 "Transform.pm"
#line 3589 "transform.pd" #line 3588 "transform.pd"
=head2 t_cubic =head2 t_cubic
=for usage =for usage
$t = t_cubic(<options>); $t = t_cubic(<options>);
=for ref =for ref
Cubic scaling - cubic pincushion (n-d; with inverse) Cubic scaling - cubic pincushion (n-d; with inverse)
skipping to change at line 2812 skipping to change at line 2813
if($data->is_inplace) { if($data->is_inplace) {
$data .= $dd; $data .= $dd;
return $data; return $data;
} else { } else {
return $dd; return $dd;
} }
}; };
$me; $me;
} }
#line 2894 "Transform.pm" #line 2915 "Transform.pm"
#line 3735 "transform.pd" #line 3734 "transform.pd"
=head2 t_quartic =head2 t_quartic
=for usage =for usage
$t = t_quartic(<options>); $t = t_quartic(<options>);
=for ref =for ref
Quartic scaling -- cylindrical pincushion (n-d; with inverse) Quartic scaling -- cylindrical pincushion (n-d; with inverse)
skipping to change at line 2932 skipping to change at line 2933
/ 2 / $s * $l) * (1 - 2*($d < $o)); / 2 / $s * $l) * (1 - 2*($d < $o));
$d += $o; $d += $o;
if($data->is_inplace) { if($data->is_inplace) {
$data .= $dd; $data .= $dd;
return $data; return $data;
} }
$dd; $dd;
}; };
$me; $me;
} }
#line 3017 "Transform.pm" #line 3039 "Transform.pm"
#line 3858 "transform.pd" #line 3857 "transform.pd"
=head2 t_spherical =head2 t_spherical
=for usage =for usage
$t = t_spherical(<options>); $t = t_spherical(<options>);
=for ref =for ref
Convert Cartesian to spherical coordinates. (3-D; with inverse) Convert Cartesian to spherical coordinates. (3-D; with inverse)
skipping to change at line 3067 skipping to change at line 3068
$x .= $r * cos($ph); $x .= $r * cos($ph);
$y .= $x * sin($th); $y .= $x * sin($th);
$x *= cos($th); $x *= cos($th);
$out += $o->{origin}; $out += $o->{origin};
$out; $out;
}; };
$me; $me;
} }
#line 3155 "Transform.pm" #line 3178 "Transform.pm"
#line 3996 "transform.pd" #line 3995 "transform.pd"
=head2 t_projective =head2 t_projective
=for usage =for usage
$t = t_projective(<options>); $t = t_projective(<options>);
=for ref =for ref
Projective transformation Projective transformation
skipping to change at line 3221 skipping to change at line 3222
$me->{inv} = sub { $me->{inv} = sub {
my($data,$o) = @_; my($data,$o) = @_;
my($id) = $data->dim(0); my($id) = $data->dim(0);
my($d) = $data->glue(0,ones($data->slice("0"))); my($d) = $data->glue(0,ones($data->slice("0")));
my($out) = ($o->{matinv} x $d->slice("*1"))->slice("(0)"); my($out) = ($o->{matinv} x $d->slice("*1"))->slice("(0)");
return ($out->slice("0:".($id-1))/$out->slice("$id")); return ($out->slice("0:".($id-1))/$out->slice("$id"));
}; };
$me; $me;
} }
#line 3312 "Transform.pm" #line 3336 "Transform.pm"
#line 245 "transform.pd" #line 244 "transform.pd"
=head1 AUTHOR =head1 AUTHOR
Copyright 2002, 2003 Craig DeForest. There is no warranty. You are allowed Copyright 2002, 2003 Craig DeForest. There is no warranty. You are allowed
to redistribute this software under certain conditions. For details, to redistribute this software under certain conditions. For details,
see the file COPYING in the PDL distribution. If this file is see the file COPYING in the PDL distribution. If this file is
separated from the PDL distribution, the copyright notice should be separated from the PDL distribution, the copyright notice should be
included in the file. included in the file.
=cut =cut
skipping to change at line 3288 skipping to change at line 3289
# call this routine first then append auxiliary information. # call this routine first then append auxiliary information.
# #
sub stringify { sub stringify {
my($me) = shift; my($me) = shift;
my($mestr) = (ref $me); my($mestr) = (ref $me);
$mestr =~ s/PDL::Transform:://; $mestr =~ s/PDL::Transform:://;
my $out = $mestr . " (" . $me->{name} . "): "; my $out = $mestr . " (" . $me->{name} . "): ";
$out .= "fwd ". ((defined ($me->{func})) ? ( (ref($me->{func}) eq 'CODE') ? "o k" : "non-CODE(!!)" ): "missing")."; "; $out .= "fwd ". ((defined ($me->{func})) ? ( (ref($me->{func}) eq 'CODE') ? "o k" : "non-CODE(!!)" ): "missing")."; ";
$out .= "inv ". ((defined ($me->{inv})) ? ( (ref($me->{inv}) eq 'CODE') ? "ok " : "non-CODE(!!)" ):"missing").".\n"; $out .= "inv ". ((defined ($me->{inv})) ? ( (ref($me->{inv}) eq 'CODE') ? "ok " : "non-CODE(!!)" ):"missing").".\n";
} }
#line 3384 "Transform.pm" #line 3409 "Transform.pm"
# Exit with OK status # Exit with OK status
1; 1;
 End of changes. 65 change blocks. 
66 lines changed or deleted 67 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)