"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "GENERATED/PDL/Transform.pm" between
PDL-2.079.tar.gz and PDL-2.080.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.079):Transform.pm  (PDL-2.080)
skipping to change at line 358 skipping to change at line 358
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 377 "Transform.pm" #line 377 "Transform.pm"
#line 1058 "../../blib/lib/PDL/PP.pm" #line 948 "../../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 703 skipping to change at line 703
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 731 "Transform.pm" #line 731 "Transform.pm"
#line 1059 "../../blib/lib/PDL/PP.pm" #line 949 "../../blib/lib/PDL/PP.pm"
#line 1573 "transform.pd" #line 1573 "transform.pd"
sub PDL::match { sub PDL::match {
# Set default for rectification to 0 for simple matching... # Set default for rectification to 0 for simple matching...
push @_, {} if ref($_[-1]) ne 'HASH'; push @_, {} if ref($_[-1]) ne 'HASH';
my @k = grep(m/^r(e(c(t)?)?)?/,sort keys %{$_[-1]}); my @k = grep(m/^r(e(c(t)?)?)?/,sort keys %{$_[-1]});
#line 1067 "../../blib/lib/PDL/PP.pm" #line 957 "../../blib/lib/PDL/PP.pm"
#line 1067 "../../blib/lib/PDL/PP.pm" #line 957 "../../blib/lib/PDL/PP.pm"
#line 1069 "../../blib/lib/PDL/PP.pm" #line 959 "../../blib/lib/PDL/PP.pm"
#line 1578 "transform.pd" #line 1578 "transform.pd"
unless(@k) { unless(@k) {
$_[-1]->{rectify} = 0; $_[-1]->{rectify} = 0;
} }
t_identity()->map(@_); t_identity()->map(@_);
} }
*PDL::map = \↦ *PDL::map = \↦
sub map { sub map {
my ($me, $in, $tmp, $opt) = @_; my ($me, $in, $tmp, $opt) = @_;
skipping to change at line 744 skipping to change at line 744
croak("PDL::Transform::map: Option 'p' was ambiguous and has been removed. You probably want 'pix' or 'phot'.") if exists($opt->{'p'}); croak("PDL::Transform::map: Option 'p' was ambiguous and has been removed. You probably want 'pix' or 'phot'.") if exists($opt->{'p'});
$tmp = [$in->dims] unless defined $tmp; # no //= because of Devel::Cover bug $tmp = [$in->dims] unless defined $tmp; # no //= because of Devel::Cover bug
# Generate an appropriate output ndarray for values to go in # Generate an appropriate output ndarray for values to go in
my ($out, @odims, $ohdr); my ($out, @odims, $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 1101 "../../blib/lib/PDL/PP.pm" #line 991 "../../blib/lib/PDL/PP.pm"
#line 1099 "../../blib/lib/PDL/PP.pm" #line 989 "../../blib/lib/PDL/PP.pm"
#line 1103 "../../blib/lib/PDL/PP.pm" #line 993 "../../blib/lib/PDL/PP.pm"
#line 1608 "transform.pd" #line 1608 "transform.pd"
$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 1114 "../../blib/lib/PDL/PP.pm" #line 1004 "../../blib/lib/PDL/PP.pm"
#line 1110 "../../blib/lib/PDL/PP.pm" #line 1000 "../../blib/lib/PDL/PP.pm"
#line 1116 "../../blib/lib/PDL/PP.pm" #line 1006 "../../blib/lib/PDL/PP.pm"
#line 1617 "transform.pd" #line 1617 "transform.pd"
$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 955 skipping to change at line 955
} }
$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 1315 "../../blib/lib/PDL/PP.pm" #line 1205 "../../blib/lib/PDL/PP.pm"
#line 1309 "../../blib/lib/PDL/PP.pm" #line 1199 "../../blib/lib/PDL/PP.pm"
#line 1317 "../../blib/lib/PDL/PP.pm" #line 1207 "../../blib/lib/PDL/PP.pm"
#line 1814 "transform.pd" #line 1814 "transform.pd"
}; };
} 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 1003 skipping to change at line 1003
|| ""); || "");
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 1363 "../../blib/lib/PDL/PP.pm" #line 1253 "../../blib/lib/PDL/PP.pm"
#line 1355 "../../blib/lib/PDL/PP.pm" #line 1245 "../../blib/lib/PDL/PP.pm"
#line 1365 "../../blib/lib/PDL/PP.pm" #line 1255 "../../blib/lib/PDL/PP.pm"
#line 1858 "transform.pd" #line 1858 "transform.pd"
}; };
} }
} }
$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 1117 skipping to change at line 1117
$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 1477 "../../blib/lib/PDL/PP.pm" #line 1367 "../../blib/lib/PDL/PP.pm"
#line 1155 "Transform.pm" #line 1155 "Transform.pm"
#line 1060 "../../blib/lib/PDL/PP.pm" #line 950 "../../blib/lib/PDL/PP.pm"
*map = \&PDL::map; *map = \&PDL::map;
#line 1162 "Transform.pm" #line 1162 "Transform.pm"
#line 1975 "transform.pd" #line 1975 "transform.pd"
###################################################################### ######################################################################
=head2 unmap =head2 unmap
skipping to change at line 1530 skipping to change at line 1530
if(!defined($o) && ((ref $source) eq 'HASH')) { if(!defined($o) && ((ref $source) eq 'HASH')) {
Carp::cluck("lookup transform called as sub not method; using 'PDL::Transfor m' as class...\n"); Carp::cluck("lookup transform called as sub not method; using 'PDL::Transfor m' as class...\n");
$o = $source; $o = $source;
$source = $class; $source = $class;
$class = "PDL::Transform"; $class = "PDL::Transform";
} }
$o = {} unless(ref $o eq 'HASH'); $o = {} unless(ref $o eq 'HASH');
my($me) = PDL::Transform::new($class); my($me) = $class->new;
my($bound) = _opt($o,['b','bound','boundary','Boundary']); my($bound) = _opt($o,['b','bound','boundary','Boundary']);
my($method)= _opt($o,['m','meth','method','Method']); my($method)= _opt($o,['m','meth','method','Method']);
$me->{idim} = $source->ndims - 1; $me->{idim} = $source->ndims - 1;
$me->{odim} = $source->dim($source->ndims-1); $me->{odim} = $source->dim($source->ndims-1);
$me->{params} = { $me->{params} = {
table => $source, table => $source,
scale => _opt($o,['s','scale','Scale'],1.0), scale => _opt($o,['s','scale','Scale'],1.0),
skipping to change at line 1767 skipping to change at line 1767
you are on your way. you are on your way.
=back =back
NOTES NOTES
the type/unit fields are currently ignored by t_linear. the type/unit fields are currently ignored by t_linear.
=cut =cut
@PDL::Transform::Linear::ISA = ('PDL::Transform'); { package PDL::Transform::Linear;
our @ISA = ('PDL::Transform');
*_opt = \&PDL::Transform::_opt;
sub t_linear { new PDL::Transform::Linear(@_); } sub PDL::Transform::t_linear { PDL::Transform::Linear->new(@_); }
sub PDL::Transform::Linear::new { sub new {
my($class) = shift; my($class) = shift;
my($o) = $_[0]; my($o) = $_[0];
pop @_ if (($#_ % 2 ==0) && !defined($_[-1])); pop @_ if (($#_ % 2 ==0) && !defined($_[-1]));
#suppresses a warning if @_ has an odd number of elements and the #suppresses a warning if @_ has an odd number of elements and the
#last is undef #last is undef
if(!(ref $o)) { if(!(ref $o)) {
$o = {@_}; $o = {@_};
} }
my($me) = PDL::Transform::new($class); my($me) = __PACKAGE__->SUPER::new;
$me->{name} = "linear"; $me->{name} = "linear";
$me->{params}{pre} = _opt($o,['pre','Pre','preoffset','offset', $me->{params}{pre} = _opt($o,['pre','Pre','preoffset','offset',
'Offset','PreOffset','Preoffset'],0); 'Offset','PreOffset','Preoffset'],0);
$me->{params}{pre} = pdl($me->{params}{pre}) $me->{params}{pre} = PDL->pdl($me->{params}{pre})
if(defined $me->{params}{pre}); if(defined $me->{params}{pre});
$me->{params}{post} = _opt($o,['post','Post','postoffset','PostOffset', $me->{params}{post} = _opt($o,['post','Post','postoffset','PostOffset',
'shift','Shift'],0); 'shift','Shift'],0);
$me->{params}{post} = pdl($me->{params}{post}) $me->{params}{post} = PDL->pdl($me->{params}{post})
if(defined $me->{params}{post}); if(defined $me->{params}{post});
$me->{params}{matrix} = _opt($o,['m','matrix','Matrix','mat','Mat']); $me->{params}{matrix} = _opt($o,['m','matrix','Matrix','mat','Mat']);
$me->{params}{matrix} = pdl($me->{params}{matrix}) $me->{params}{matrix} = PDL->pdl($me->{params}{matrix})
if(defined $me->{params}{matrix}); if(defined $me->{params}{matrix});
$me->{params}{rot} = _opt($o,['r','rot','rota','rotation','Rotation'], 0); $me->{params}{rot} = _opt($o,['r','rot','rota','rotation','Rotation'], 0);
$me->{params}{rot} = pdl($me->{params}{rot}); $me->{params}{rot} = PDL->pdl($me->{params}{rot});
my $o_dims = _opt($o,['d','dim','dims','Dims']); my $o_dims = _opt($o,['d','dim','dims','Dims']);
$o_dims = pdl($o_dims) if defined($o_dims); $o_dims = PDL->pdl($o_dims) if defined($o_dims);
my $scale = _opt($o,['s','scale','Scale']); my $scale = _opt($o,['s','scale','Scale']);
$scale = pdl($scale) if defined($scale); $scale = PDL->pdl($scale) if defined($scale);
# Figure out the number of dimensions to transform, and, # Figure out the number of dimensions to transform, and,
# if necessary, generate a new matrix. # if necessary, generate a new matrix.
if(defined($me->{params}{matrix})) { if(defined($me->{params}{matrix})) {
my $mat = $me->{params}{matrix} = $me->{params}{matrix}->slice(":,:"); my $mat = $me->{params}{matrix} = $me->{params}{matrix}->slice(":,:");
$me->{idim} = $mat->dim(0); $me->{idim} = $mat->dim(0);
$me->{odim} = $mat->dim(1); $me->{odim} = $mat->dim(1);
} else { } else {
skipping to change at line 1864 skipping to change at line 1866
# Subrotation closure -- rotates from axis $d->(0) --> $d->(1). # Subrotation closure -- rotates from axis $d->(0) --> $d->(1).
my $subrot = sub { my $subrot = sub {
my($d,$angle,$m)=@_; my($d,$angle,$m)=@_;
my($i) = identity($m->dim(0)); my($i) = identity($m->dim(0));
my($subm) = $i->dice($d,$d); my($subm) = $i->dice($d,$d);
$angle = $angle->at(0) $angle = $angle->at(0)
if(UNIVERSAL::isa($angle,'PDL')); if(UNIVERSAL::isa($angle,'PDL'));
my($x) = $angle * $PDL::Transform::DEG2RAD; my($x) = $angle * $PDL::Transform::DEG2RAD;
$subm .= $subm x pdl([cos($x),-sin($x)],[sin($x),cos($x)] ); $subm .= $subm x PDL->pdl([cos($x),-sin($x)],[sin($x),cos ($x)]);
$m .= $m x $i; $m .= $m x $i;
}; };
if(UNIVERSAL::isa($rot,'PDL') && $rot->nelem > 1) { if(UNIVERSAL::isa($rot,'PDL') && $rot->nelem > 1) {
if($rot->ndims == 2) { if($rot->ndims == 2) {
$me->{params}{matrix} x= $rot; $me->{params}{matrix} x= $rot;
} elsif($rot->nelem == 3) { } elsif($rot->nelem == 3) {
my $rm = identity(3); my $rm = identity(3);
# Do these in reverse order to make it more like # Do these in reverse order to make it more like
# function composition! # function composition!
&$subrot(pdl(0,1),$rot->at(2),$rm); &$subrot(PDL->pdl(0,1),$rot->at(2),$rm);
&$subrot(pdl(2,0),$rot->at(1),$rm); &$subrot(PDL->pdl(2,0),$rot->at(1),$rm);
&$subrot(pdl(1,2),$rot->at(0),$rm); &$subrot(PDL->pdl(1,2),$rot->at(0),$rm);
$me->{params}{matrix} .= $me->{params}{matrix} x $rm; $me->{params}{matrix} .= $me->{params}{matrix} x $rm;
} else { } else {
barf("PDL::Transform::Linear: Got a strange rot option -- giving up.\n") ; barf("PDL::Transform::Linear: Got a strange rot option -- giving up.\n") ;
} }
} else { } else {
if($rot != 0 and $me->{params}{matrix}->dim(0)>1) { if($rot != 0 and $me->{params}{matrix}->dim(0)>1) {
&$subrot(pdl(0,1),$rot,$me->{params}{matrix}); &$subrot(PDL->pdl(0,1),$rot,$me->{params}{matrix});
} }
} }
} }
# Apply scaling # Apply scaling
$me->{params}{matrix} = $me->{params}{matrix}->slice(":,:"); $me->{params}{matrix} = $me->{params}{matrix}->slice(":,:");
my $tmp; # work around perl -d "feature" my $tmp; # work around perl -d "feature"
($tmp = $me->{params}{matrix}->diagonal(0,1)) *= $scale ($tmp = $me->{params}{matrix}->diagonal(0,1)) *= $scale
if defined($scale); if defined($scale);
skipping to change at line 1936 skipping to change at line 1938
my($x) = $in->slice("0:$d")->copy - $opt->{post}; my($x) = $in->slice("0:$d")->copy - $opt->{post};
my($out) = $in->is_inplace ? $in : $in->copy; my($out) = $in->is_inplace ? $in : $in->copy;
my $tmp; # work around perl -d "feature" my $tmp; # work around perl -d "feature"
($tmp = $out->slice("0:$d")) .= $x x $opt->{inverse} - $opt->{pre}; ($tmp = $out->slice("0:$d")) .= $x x $opt->{inverse} - $opt->{pre};
$out; $out;
} : undef; } : undef;
return $me; return $me;
} }
sub PDL::Transform::Linear::stringify { sub stringify {
package PDL::Transform::Linear;
my($me) = shift; my($out) = SUPER::stringify $me; my($me) = shift; my($out) = SUPER::stringify $me;
my $mp = $me->{params}; my $mp = $me->{params};
if(!($me->{is_inverse})){ if(!($me->{is_inverse})){
$out .= "Pre-add: ".($mp->{pre})."\n" $out .= "Pre-add: ".($mp->{pre})."\n"
if(defined $mp->{pre}); if(defined $mp->{pre});
$out .= "Post-add: ".($mp->{post})."\n" $out .= "Post-add: ".($mp->{post})."\n"
if(defined $mp->{post}); if(defined $mp->{post});
skipping to change at line 1970 skipping to change at line 1971
$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 2036 "Transform.pm" }
#line 2038 "Transform.pm"
#line 2845 "transform.pd" #line 2846 "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 2062 "Transform.pm" #line 2064 "Transform.pm"
#line 2866 "transform.pd" #line 2867 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(Scale=>$scale,$y,@_); t_linear(Scale=>$scale,$y,@_);
} }
#line 2067 "Transform.pm" #line 2069 "Transform.pm"
#line 2873 "transform.pd" #line 2874 "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 2093 "Transform.pm" #line 2095 "Transform.pm"
#line 2894 "transform.pd" #line 2895 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(pre=>$pre,$y,@_); t_linear(pre=>$pre,$y,@_);
} }
#line 2099 "Transform.pm" #line 2101 "Transform.pm"
#line 2902 "transform.pd" #line 2903 "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 2051 skipping to change at line 2053
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 2126 "Transform.pm" #line 2128 "Transform.pm"
#line 2924 "transform.pd" #line 2925 "transform.pd"
if(ref $y eq 'HASH'); if(ref $y eq 'HASH');
t_linear(rot=>$rot,$y,@_); t_linear(rot=>$rot,$y,@_);
} }
#line 2132 "Transform.pm" #line 2134 "Transform.pm"
#line 2934 "transform.pd" #line 2935 "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 2222 skipping to change at line 2224
$me->{ounit} = \@ounit; $me->{ounit} = \@ounit;
$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 2301 "Transform.pm" #line 2303 "Transform.pm"
#line 3106 "transform.pd" #line 3107 "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 2302 skipping to change at line 2304
=cut =cut
sub t_code { sub t_code {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($func, $inv, $o) = @_; my($func, $inv, $o) = @_;
if(ref $inv eq 'HASH') { if(ref $inv eq 'HASH') {
$o = $inv; $o = $inv;
$inv = undef; $inv = undef;
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{name} = _opt($o,['n','name','Name']) || "code"; $me->{name} = _opt($o,['n','name','Name']) || "code";
$me->{func} = $func; $me->{func} = $func;
$me->{inv} = $inv; $me->{inv} = $inv;
$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 2398 "Transform.pm" #line 2400 "Transform.pm"
#line 3205 "transform.pd" #line 3206 "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 2417 skipping to change at line 2419
=cut =cut
*t_cylindrical = \&t_radial; *t_cylindrical = \&t_radial;
sub t_radial { sub t_radial {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = { @_ }; $o = { @_ };
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{params}{origin} = _opt($o,['o','origin','Origin']); $me->{params}{origin} = _opt($o,['o','origin','Origin']);
$me->{params}{origin} = pdl(0,0) $me->{params}{origin} = pdl(0,0)
unless defined($me->{params}{origin}); unless defined($me->{params}{origin});
$me->{params}{origin} = PDL->pdl($me->{params}{origin}); $me->{params}{origin} = PDL->pdl($me->{params}{origin});
$me->{params}{r0} = _opt($o,['r0','R0','c','conformal','Conformal']); $me->{params}{r0} = _opt($o,['r0','R0','c','conformal','Conformal']);
$me->{params}{origin} = PDL->pdl($me->{params}{origin}); $me->{params}{origin} = PDL->pdl($me->{params}{origin});
$me->{params}{u} = _opt($o,['u','unit','Unit'],'radians'); $me->{params}{u} = _opt($o,['u','unit','Unit'],'radians');
skipping to change at line 2489 skipping to change at line 2491
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 2577 "Transform.pm" #line 2579 "Transform.pm"
#line 3383 "transform.pd" #line 3384 "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 2564 skipping to change at line 2566
=back =back
=cut =cut
sub t_quadratic { sub t_quadratic {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = {@_}; $o = {@_};
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0)); $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
$me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1)); $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
$me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1)); $me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1));
$me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']); $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']);
$me->{name} = "quadratic"; $me->{name} = "quadratic";
$me->{func} = sub { $me->{func} = sub {
my($data,$o) = @_; my($data,$o) = @_;
my($dd) = $data->copy - $o->{origin}; my($dd) = $data->copy - $o->{origin};
skipping to change at line 2605 skipping to change at line 2607
/ 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 2697 "Transform.pm" #line 2699 "Transform.pm"
#line 3502 "transform.pd" #line 3503 "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 2662 skipping to change at line 2664
=back =back
=cut =cut
sub t_cubic { sub t_cubic {
my ($class) = 'PDL::Transform'; my ($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = {@_}; $o = {@_};
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{params}->{dim} = _opt($o,['d','dim','dims','Dims'],undef); $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims'],undef);
$me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0)); $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
$me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1)); $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
$me->{params}->{st} = _opt($o,['s','st','str'],pdl(0)); $me->{params}->{st} = _opt($o,['s','st','str'],pdl(0));
$me->{name} = "cubic"; $me->{name} = "cubic";
$me->{params}->{cuberoot} = sub { $me->{params}->{cuberoot} = sub {
my $x = shift; my $x = shift;
my $as = 1 - 2*($x<0); my $as = 1 - 2*($x<0);
skipping to change at line 2746 skipping to change at line 2748
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 2843 "Transform.pm" #line 2845 "Transform.pm"
#line 3648 "transform.pd" #line 3649 "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 2825 skipping to change at line 2827
=back =back
=cut =cut
sub t_quartic { sub t_quartic {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = {@_}; $o = {@_};
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0)); $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
$me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1)); $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
$me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1)); $me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1));
$me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']); $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']);
$me->{name} = "quadratic"; $me->{name} = "quadratic";
$me->{func} = sub { $me->{func} = sub {
my($data,$o) = @_; my($data,$o) = @_;
my($dd) = $data->copy - $o->{origin}; my($dd) = $data->copy - $o->{origin};
skipping to change at line 2866 skipping to change at line 2868
/ 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 2967 "Transform.pm" #line 2969 "Transform.pm"
#line 3771 "transform.pd" #line 3772 "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 2933 skipping to change at line 2935
=cut =cut
sub t_spherical { sub t_spherical {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = { @_ } ; $o = { @_ } ;
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{idim}=3; $me->{idim}=3;
$me->{odim}=3; $me->{odim}=3;
$me->{params}->{origin} = _opt($o,['o','origin','Origin']); $me->{params}->{origin} = _opt($o,['o','origin','Origin']);
$me->{params}->{origin} = PDL->zeroes(3) $me->{params}->{origin} = PDL->zeroes(3)
unless defined($me->{params}->{origin}); unless defined($me->{params}->{origin});
$me->{params}->{origin} = PDL->pdl($me->{params}->{origin}); $me->{params}->{origin} = PDL->pdl($me->{params}->{origin});
$me->{params}->{deg} = _opt($o,['d','degrees','Degrees']); $me->{params}->{deg} = _opt($o,['d','degrees','Degrees']);
skipping to change at line 3001 skipping to change at line 3003
$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 3106 "Transform.pm" #line 3108 "Transform.pm"
#line 3909 "transform.pd" #line 3910 "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 3075 skipping to change at line 3077
=cut =cut
sub t_projective { sub t_projective {
my($class) = 'PDL::Transform'; my($class) = 'PDL::Transform';
my($o) = $_[0]; my($o) = $_[0];
if(ref $o ne 'HASH') { if(ref $o ne 'HASH') {
$o = { @_ }; $o = { @_ };
} }
my($me) = PDL::Transform::new($class); my($me) = $class->new;
$me->{name} = "projective"; $me->{name} = "projective";
### Set options... ### Set options...
$me->{params}->{idim} = $me->{idim} = _opt($o,['d','dim','Dim']); $me->{params}->{idim} = $me->{idim} = _opt($o,['d','dim','Dim']);
my $matrix; my $matrix;
if(defined ($matrix=_opt($o,['m','matrix','Matrix']))) { if(defined ($matrix=_opt($o,['m','matrix','Matrix']))) {
$matrix = pdl($matrix); $matrix = pdl($matrix);
skipping to change at line 3155 skipping to change at line 3157
$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 3264 "Transform.pm" #line 3266 "Transform.pm"
#line 244 "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.
skipping to change at line 3222 skipping to change at line 3224
# 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 3337 "Transform.pm" #line 3339 "Transform.pm"
# Exit with OK status # Exit with OK status
1; 1;
 End of changes. 58 change blocks. 
74 lines changed or deleted 76 lines changed or added

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