complex.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

#
# Complex numbers and associated mathematical functions
# -- Raphael Manfredi	Since Sep 1996
# -- Jarkko Hietaniemi	Since Mar 1997
# -- Daniel S. Lewart	Since Sep 1997
#

package Math::Complex;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $Inf);

$VERSION = 1.37;

BEGIN {
    unless ($^O eq 'unicosmk') {
        local $!;
	# We do want an arithmetic overflow, Inf INF inf Infinity:.
        undef $Inf unless eval <<'EOE' and $Inf =~ /^inf(?:inity)?$/i;
	  local $SIG{FPE} = sub {die};
	  my $t = CORE::exp 30;
	  $Inf = CORE::exp $t;
EOE
	if (!defined $Inf) {		# Try a different method
	  undef $Inf unless eval <<'EOE' and $Inf =~ /^inf(?:inity)?$/i;
	    local $SIG{FPE} = sub {die};
	    my $t = 1;
	    $Inf = $t + "1e99999999999999999999999999999999";
EOE
	}
    }
    $Inf = "Inf" if !defined $Inf || !($Inf > 0); # Desperation.
}

use strict;

my $i;
my %LOGN;

# Regular expression for floating point numbers.
# These days we could use Scalar::Util::lln(), I guess.
my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?))|inf)'i;

require Exporter;

@ISA = qw(Exporter);

my @trig = qw(
	      pi
	      tan
	      csc cosec sec cot cotan
	      asin acos atan
	      acsc acosec asec acot acotan
	      sinh cosh tanh
	      csch cosech sech coth cotanh
	      asinh acosh atanh
	      acsch acosech asech acoth acotanh
	     );

@EXPORT = (qw(
	     i Re Im rho theta arg
	     sqrt log ln
	     log10 logn cbrt root
	     cplx cplxe
	     atan2
	     ),
	   @trig);

my @pi = qw(pi pi2 pi4 pip2 pip4);

@EXPORT_OK = @pi;

%EXPORT_TAGS = (
    'trig' => [@trig],
    'pi' => [@pi],
);

use overload
	'+'	=> \&_plus,
	'-'	=> \&_minus,
	'*'	=> \&_multiply,
	'/'	=> \&_divide,
	'**'	=> \&_power,
	'=='	=> \&_numeq,
	'<=>'	=> \&_spaceship,
	'neg'	=> \&_negate,
	'~'	=> \&_conjugate,
	'abs'	=> \&abs,
	'sqrt'	=> \&sqrt,
	'exp'	=> \&exp,
	'log'	=> \&log,
	'sin'	=> \&sin,
	'cos'	=> \&cos,
	'tan'	=> \&tan,
	'atan2'	=> \&atan2,
        '""'    => \&_stringify;

#
# Package "privates"
#

my %DISPLAY_FORMAT = ('style' => 'cartesian',
		      'polar_pretty_print' => 1);
my $eps            = 1e-14;		# Epsilon

#
# Object attributes (internal):
#	cartesian	[real, imaginary] -- cartesian form
#	polar		[rho, theta] -- polar form
#	c_dirty		cartesian form not up-to-date
#	p_dirty		polar form not up-to-date
#	display		display format (package's global when not set)
#	bn_cartesian
#       bnc_dirty
#

# Die on bad *make() arguments.

sub _cannot_make {
    die "@{[(caller(1))[3]]}: Cannot take $_[0] of '$_[1]'.\n";
}

sub _make {
    my $arg = shift;
    my ($p, $q);

    if ($arg =~ /^$gre$/) {
	($p, $q) = ($1, 0);
    } elsif ($arg =~ /^(?:$gre)?$gre\s*i\s*$/) {
	($p, $q) = ($1 || 0, $2);
    } elsif ($arg =~ /^\s*\(\s*$gre\s*(?:,\s*$gre\s*)?\)\s*$/) {
	($p, $q) = ($1, $2 || 0);
    }

    if (defined $p) {
	$p =~ s/^\+//;
	$p =~ s/^(-?)inf$/"${1}9**9**9"/e;
	$q =~ s/^\+//;
	$q =~ s/^(-?)inf$/"${1}9**9**9"/e;
    }

    return ($p, $q);
}

sub _emake {
    my $arg = shift;
    my ($p, $q);

    if ($arg =~ /^\s*\[\s*$gre\s*(?:,\s*$gre\s*)?\]\s*$/) {
	($p, $q) = ($1, $2 || 0);
    } elsif ($arg =~ m!^\s*\[\s*$gre\s*(?:,\s*([-+]?\d*\s*)?pi(?:/\s*(\d+))?\s*)?\]\s*$!) {
	($p, $q) = ($1, ($2 eq '-' ? -1 : ($2 || 1)) * pi() / ($3 || 1));
    } elsif ($arg =~ /^\s*\[\s*$gre\s*\]\s*$/) {
	($p, $q) = ($1, 0);
    } elsif ($arg =~ /^\s*$gre\s*$/) {
	($p, $q) = ($1, 0);
    }

    if (defined $p) {
	$p =~ s/^\+//;
	$q =~ s/^\+//;
	$p =~ s/^(-?)inf$/"${1}9**9**9"/e;
	$q =~ s/^(-?)inf$/"${1}9**9**9"/e;
    }

    return ($p, $q);
}

#
# ->make
#
# Create a new complex number (cartesian form)
#
sub make {
    my $self = bless {}, shift;
    my ($re, $im);
    if (@_ == 0) {
	($re, $im) = (0, 0);
    } elsif (@_ == 1) {
	return (ref $self)->emake($_[0])
	    if ($_[0] =~ /^\s*\[/);
	($re, $im) = _make($_[0]);
    } elsif (@_ == 2) {
	($re, $im) = @_;
    }
    if (defined $re) {
	_cannot_make("real part",      $re) unless $re =~ /^$gre$/;
    }
    $im ||= 0;
    _cannot_make("imaginary part", $im) unless $im =~ /^$gre$/;
    $self->_set_cartesian([$re, $im ]);
    $self->display_format('cartesian');

    return $self;
}

#
# ->emake
#
# Create a new complex number (exponential form)
#
sub emake {
    my $self = bless {}, shift;
    my ($rho, $theta);
    if (@_ == 0) {
	($rho, $theta) = (0, 0);
    } elsif (@_ == 1) {
	return (ref $self)->make($_[0])
	    if ($_[0] =~ /^\s*\(/ || $_[0] =~ /i\s*$/);
	($rho, $theta) = _emake($_[0]);
    } elsif (@_ == 2) {
	($rho, $theta) = @_;
    }
    if (defined $rho && defined $theta) {
	if ($rho < 0) {
	    $rho   = -$rho;
	    $theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
	}
    }
    if (defined $rho) {
	_cannot_make("rho",   $rho)   unless $rho   =~ /^$gre$/;
    }
    $theta ||= 0;
    _cannot_make("theta", $theta) unless $theta =~ /^$gre$/;
    $self->_set_polar([$rho, $theta]);
    $self->display_format('polar');

    return $self;
}

sub new { &make }		# For backward compatibility only.

#
# cplx
#
# Creates a complex number from a (re, im) tuple.
# This avoids the burden of writing Math::Complex->make(re, im).
#
sub cplx {
	return __PACKAGE__->make(@_);
}

#
# cplxe
#
# Creates a complex number from a (rho, theta) tuple.
# This avoids the burden of writing Math::Complex->emake(rho, theta).
#
sub cplxe {
	return __PACKAGE__->emake(@_);
}

#
# pi
#
# The number defined as pi = 180 degrees
#
sub pi () { 4 * CORE::atan2(1, 1) }

#
# pi2
#
# The full circle
#
sub pi2 () { 2 * pi }

#
# pi4
#
# The full circle twice.
#
sub pi4 () { 4 * pi }

#
# pip2
#
# The quarter circle
#
sub pip2 () { pi / 2 }

#
# pip4
#
# The eighth circle.
#
sub pip4 () { pi / 4 }

#
# _uplog10
#
# Used in log10().
#
sub _uplog10 () { 1 / CORE::log(10) }

#
# i
#
# The number defined as i*i = -1;
#
sub i () {
        return $i if ($i);
	$i = bless {};
	$i->{'cartesian'} = [0, 1];
	$i->{'polar'}     = [1, pip2];
	$i->{c_dirty} = 0;
	$i->{p_dirty} = 0;
	return $i;
}

#
# _ip2
#
# Half of i.
#
sub _ip2 () { i / 2 }

#
# Attribute access/set routines
#

sub _cartesian {$_[0]->{c_dirty} ?
		   $_[0]->_update_cartesian : $_[0]->{'cartesian'}}
sub _polar     {$_[0]->{p_dirty} ?
		   $_[0]->_update_polar : $_[0]->{'polar'}}

sub _set_cartesian { $_[0]->{p_dirty}++; $_[0]->{c_dirty} = 0;
		     $_[0]->{'cartesian'} = $_[1] }
sub _set_polar     { $_[0]->{c_dirty}++; $_[0]->{p_dirty} = 0;
		     $_[0]->{'polar'} = $_[1] }

#
# ->_update_cartesian
#
# Recompute and return the cartesian form, given accurate polar form.
#
sub _update_cartesian {
	my $self = shift;
	my ($r, $t) = @{$self->{'polar'}};
	$self->{c_dirty} = 0;
	return $self->{'cartesian'} = [$r * CORE::cos($t), $r * CORE::sin($t)];
}

#
#
# ->_update_polar
#
# Recompute and return the polar form, given accurate cartesian form.
#
sub _update_polar {
	my $self = shift;
	my ($x, $y) = @{$self->{'cartesian'}};
	$self->{p_dirty} = 0;
	return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0;
	return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y),
				   CORE::atan2($y, $x)];
}

#
# (_plus)
#
# Computes z1+z2.
#
sub _plus {
	my ($z1, $z2, $regular) = @_;
	my ($re1, $im1) = @{$z1->_cartesian};
	$z2 = cplx($z2) unless ref $z2;
	my ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
	unless (defined $regular) {
		$z1->_set_cartesian([$re1 + $re2, $im1 + $im2]);
		return $z1;
	}
	return (ref $z1)->make($re1 + $re2, $im1 + $im2);
}

#
# (_minus)
#
# Computes z1-z2.
#
sub _minus {
	my ($z1, $z2, $inverted) = @_;
	my ($re1, $im1) = @{$z1->_cartesian};
	$z2 = cplx($z2) unless ref $z2;
	my ($re2, $im2) = @{$z2->_cartesian};
	unless (defined $inverted) {
		$z1->_set_cartesian([$re1 - $re2, $im1 - $im2]);
		return $z1;
	}
	return $inverted ?
		(ref $z1)->make($re2 - $re1, $im2 - $im1) :
		(ref $z1)->make($re1 - $re2, $im1 - $im2);

}

#
# (_multiply)
#
# Computes z1*z2.
#
sub _multiply {
        my ($z1, $z2, $regular) = @_;
	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
	    # if both polar better use polar to avoid rounding errors
	    my ($r1, $t1) = @{$z1->_polar};
	    my ($r2, $t2) = @{$z2->_polar};
	    my $t = $t1 + $t2;
	    if    ($t >   pi()) { $t -= pi2 }
	    elsif ($t <= -pi()) { $t += pi2 }
	    unless (defined $regular) {
		$z1->_set_polar([$r1 * $r2, $t]);
		return $z1;
	    }
	    return (ref $z1)->emake($r1 * $r2, $t);
	} else {
	    my ($x1, $y1) = @{$z1->_cartesian};
	    if (ref $z2) {
		my ($x2, $y2) = @{$z2->_cartesian};
		return (ref $z1)->make($x1*$x2-$y1*$y2, $x1*$y2+$y1*$x2);
	    } else {
		return (ref $z1)->make($x1*$z2, $y1*$z2);
	    }
	}
}

#
# _divbyzero
#
# Die on division by zero.
#
sub _divbyzero {
    my $mess = "$_[0]: Division by zero.\n";

    if (defined $_[1]) {
	$mess .= "(Because in the definition of $_[0], the divisor ";
	$mess .= "$_[1] " unless ("$_[1]" eq '0');
	$mess .= "is 0)\n";
    }

    my @up = caller(1);

    $mess .= "Died at $up[1] line $up[2].\n";

    die $mess;
}

#
# (_divide)
#
# Computes z1/z2.
#
sub _divide {
	my ($z1, $z2, $inverted) = @_;
	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
	    # if both polar better use polar to avoid rounding errors
	    my ($r1, $t1) = @{$z1->_polar};
	    my ($r2, $t2) = @{$z2->_polar};
	    my $t;
	    if ($inverted) {
		_divbyzero "$z2/0" if ($r1 == 0);
		$t = $t2 - $t1;
		if    ($t >   pi()) { $t -= pi2 }
		elsif ($t <= -pi()) { $t += pi2 }
		return (ref $z1)->emake($r2 / $r1, $t);
	    } else {
		_divbyzero "$z1/0" if ($r2 == 0);
		$t = $t1 - $t2;
		if    ($t >   pi()) { $t -= pi2 }
		elsif ($t <= -pi()) { $t += pi2 }
		return (ref $z1)->emake($r1 / $r2, $t);
	    }
	} else {
	    my ($d, $x2, $y2);
	    if ($inverted) {
		($x2, $y2) = @{$z1->_cartesian};
		$d = $x2*$x2 + $y2*$y2;
		_divbyzero "$z2/0" if $d == 0;
		return (ref $z1)->make(($x2*$z2)/$d, -($y2*$z2)/$d);
	    } else {
		my ($x1, $y1) = @{$z1->_cartesian};
		if (ref $z2) {
		    ($x2, $y2) = @{$z2->_cartesian};
		    $d = $x2*$x2 + $y2*$y2;
		    _divbyzero "$z1/0" if $d == 0;
		    my $u = ($x1*$x2 + $y1*$y2)/$d;
		    my $v = ($y1*$x2 - $x1*$y2)/$d;
		    return (ref $z1)->make($u, $v);
		} else {
		    _divbyzero "$z1/0" if $z2 == 0;
		    return (ref $z1)->make($x1/$z2, $y1/$z2);
		}
	    }
	}
}

#
# (_power)
#
# Computes z1**z2 = exp(z2 * log z1)).
#
sub _power {