"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Complex/complex.pd" between
PDL-2.082.tar.gz and PDL-2.083.tar.gz

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

complex.pd  (PDL-2.082)	:	complex.pd  (PDL-2.083)
use strict;		use strict;
use warnings;		use warnings;
use PDL::Types qw(ppdefs ppdefs_complex types);		use PDL::Types qw(ppdefs ppdefs_complex types);
my $R = [ppdefs()];		my $R = [ppdefs()];
my $F = [map $_->ppsym, grep $_->real && !$_->integer, types()];		my $F = [map $_->ppsym, grep $_->real && !$_->integer, types()];
my $C = [ppdefs_complex()];		my $C = [ppdefs_complex()];
		pp_core_importList('()');
pp_beginwrap; # required for overload to work		pp_beginwrap; # required for overload to work
# pp_def functions go into the PDL::Complex namespace		# pp_def functions go into the PDL::Complex namespace
# to avoid clashing with PDL::FFTW funcs of the same name that go		# to avoid clashing with PDL::FFTW funcs of the same name that go
# into the PDL namespace		# into the PDL namespace
# it should be of no effect to the user of the module but you		# it should be of no effect to the user of the module but you
# never know....		# never know....
pp_bless('PDL::Complex');		pp_bless('PDL::Complex');
pp_addpm {At => 'Top'}, <<'EOD';		pp_addpm {At => 'Top'}, <<'EOD';
use strict;		use strict;
use warnings;		use warnings;
use Carp;		use Carp;
our $VERSION = '2.009';		our $VERSION = '2.009';
use PDL::Slices;
use PDL::Types;
use PDL::Bad;
=encoding iso-8859-1		=encoding iso-8859-1
=head1 NAME		=head1 NAME
PDL::Complex - handle complex numbers (DEPRECATED - use native complex)		PDL::Complex - handle complex numbers (DEPRECATED - use native complex)
=head1 SYNOPSIS		=head1 SYNOPSIS
use PDL;		use PDL;
skipping to change at line 227		skipping to change at line 225
=item "" (stringification)		=item "" (stringification)
=back		=back
Comparing complex numbers other than for equality is a fatal error.		Comparing complex numbers other than for equality is a fatal error.
=cut		=cut
my $i;		my $i;
BEGIN { $i = bless pdl 0,1 }		BEGIN { $i = bless PDL->pdl(0,1) }
{		{
no warnings 'redefine';		no warnings 'redefine';
sub i { $i->copy + (@_ ? $_[0] : 0) };		sub i { $i->copy + (@_ ? $_[0] : 0) };
}		}
# sensible aliases from PDL::LinearAlgebra		# sensible aliases from PDL::LinearAlgebra
*r2p = \&Cr2p;		*r2p = \&Cr2p;
*p2r = \&Cp2r;		*p2r = \&Cp2r;
*conj = \&Cconj;		*conj = \&Cconj;
*abs = \&Cabs;		*abs = \&Cabs;
skipping to change at line 564		skipping to change at line 562
;		;
pp_def 'Cdiv',		pp_def 'Cdiv',
Pars => 'a(m=2); b(m=2); [o]c(m=2)',		Pars => 'a(m=2); b(m=2); [o]c(m=2)',
GenericTypes => $F,		GenericTypes => $F,
Doc => 'complex division',		Doc => 'complex division',
Code => q^		Code => q^
$GENERIC() ar = $a(m=>0), ai = $a(m=>1);		$GENERIC() ar = $a(m=>0), ai = $a(m=>1);
$GENERIC() br = $b(m=>0), bi = $b(m=>1);		$GENERIC() br = $b(m=>0), bi = $b(m=>1);
if (fabs (br) > fabs (bi))		if (fabsl (br) > fabsl (bi))
{		{
$GENERIC() tt = bi / br;		$GENERIC() tt = bi / br;
$GENERIC() dn = br + tt * bi;		$GENERIC() dn = br + tt * bi;
$c(m=>0) = (ar + tt * ai) / dn;		$c(m=>0) = (ar + tt * ai) / dn;
$c(m=>1) = (ai - tt * ar) / dn;		$c(m=>1) = (ai - tt * ar) / dn;
}		}
else		else
{		{
$GENERIC() tt = br / bi;		$GENERIC() tt = br / bi;
$GENERIC() dn = br * tt + bi;		$GENERIC() dn = br * tt + bi;
skipping to change at line 844		skipping to change at line 842
=for ref		=for ref
Return the complex C<atan()>.		Return the complex C<atan()>.
Does not work inplace.		Does not work inplace.
=cut		=cut
sub Catan($) {		sub Catan($) {
my $z = shift;		my $z = shift;
Cmul Clog(Cdiv (PDL::Complex::i()+$z, PDL::Complex::i()-$z)), pdl(0, 0.5);		Cmul Clog(Cdiv (PDL::Complex::i()+$z, PDL::Complex::i()-$z)), PDL->pdl(0, 0.5 );
}		}
EOD		EOD
pp_def 'Csinh',		pp_def 'Csinh',
Pars => 'a(m=2); [o]c(m=2)',		Pars => 'a(m=2); [o]c(m=2)',
Inplace => 1,		Inplace => 1,
GenericTypes => $F,		GenericTypes => $F,
Doc => ' sinh (a) = (exp (a) - exp (-a)) / 2. Works inplace',		Doc => ' sinh (a) = (exp (a) - exp (-a)) / 2. Works inplace',
Code => q^		Code => q^
skipping to change at line 1065		skipping to change at line 1063
$out(c=>0) = or;		$out(c=>0) = or;
$out(c=>1) = oi;		$out(c=>1) = oi;
%}		%}
!		!
;		;
pp_add_isa 'PDL';		pp_add_isa 'PDL';
pp_addpm {At => 'Bot'}, <<'EOD';		pp_addpm {At => 'Bot'}, <<'EOD';
# overload must be here, so that all the functions can be seen
# undocumented compatibility functions (thanks to Luis Mochan!)		# undocumented compatibility functions (thanks to Luis Mochan!)
sub Catan2($$) { Clog( $_[1] + i()*$_[0])/i }		sub Catan2 { Clog( $_[1] + i()*$_[0])/i }
sub atan2($$) { Clog( $_[1] + i()*$_[0])/i }		sub atan2 { Clog( $_[1] + i()*$_[0])/i }
=begin comment		=begin comment
In _gen_biop, the '+' or '-' between the operator (e.g., '*') and the		In _gen_biop, the '+' or '-' between the operator (e.g., '*') and the
function that it overloads (e.g., 'Cmul') flags whether the operation		function that it overloads (e.g., 'Cmul') flags whether the operation
is ('+') or is not ('-') commutative. See the discussion of argument		is ('+') or is not ('-') commutative. See the discussion of argument
swapping in the section "Calling Conventions and Magic Autogeneration"		swapping in the section "Calling Conventions and Magic Autogeneration"
in "perldoc overload".		in "perldoc overload".
=end comment		=end comment
=cut		=cut
my %NO_MUTATE; BEGIN { @NO_MUTATE{qw(atan2 .= ==)} = (); }		my %NO_MUTATE; BEGIN { @NO_MUTATE{qw(atan2 .= ==)} = (); }
sub _gen_biop {		sub _gen_biop {
local $_ = shift;		local $_ = shift;
my $sub;		my $sub;
if (/(\S+)\+(\w+)/) { #commutes		die if !(my ($op, $commutes, $func) = /(\S+)([-+])(\w+)/);
$sub = eval 'sub { '.$2.' $_[0], ref $_[1] eq __PACKAGE__ ? $_[1] : r2C $_		$sub = eval 'sub {
[1] }';		my ($x, $y) = '.($commutes eq '+' ? '' : '$_[2] ? @_[1,0] : ').'@_[0,1];
} elsif (/(\S+)\-(\w+)/) { #does not commute		$_ = r2C $_ for grep ref $_ ne __PACKAGE__, $x, $y;
$sub = eval 'sub { my $y = ref $_[1] eq __PACKAGE__ ? $_[1] : r2C $_[1];		'.$func.'($x, $y);
$_[2] ? '.$2.' $y, $_[0] : '.$2.' $_[0], $y }'; #need to		}'; #need to swap?
swap?		die if $@;
} else {		($op, $sub, exists $NO_MUTATE{$op} ? () : ("$op=", $sub));
die;
}
return ($1, $sub) if exists $NO_MUTATE{$1};
($1, $sub, "$1=", $sub);
}		}
sub _gen_unop {		sub _gen_unop {
my ($op, $func) = ($_[0] =~ /(.+)@(\w+)/);		my ($op, $func) = split '@', $_[0];
no strict 'refs';		no strict 'refs';
*$op = \&$func if $op =~ /\w+/; # create an alias		*$op = \&$func if $op =~ /\w+/; # create an alias
($op, eval 'sub { '.$func.' $_[0] }');		($op, eval 'sub { '.$func.' $_[0] }');
}		}
sub initialize {		sub initialize {
# Bless a null PDL into the supplied 1st arg package		# Bless a null PDL into the supplied 1st arg package
# If 1st arg is a ref, get the package from it		# If 1st arg is a ref, get the package from it
bless PDL->null, ref($_[0]) || $_[0];		bless PDL->null, ref($_[0]) || $_[0];
}		}
End of changes. 9 change blocks.
23 lines changed or deleted		15 lines changed or added

---