complex.pm

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

#
sub atan {
	my ($z) = @_;
	return CORE::atan2($z, 1) unless ref $z;
	my ($x, $y) = ref $z ? @{$z->_cartesian} : ($z, 0);
	return 0 if $x == 0 && $y == 0;
	_divbyzero "atan(i)"  if ( $z == i);
	_logofzero "atan(-i)" if (-$z == i); # -i is a bad file test...
	my $log = &log((i + $z) / (i - $z));
	return _ip2 * $log;
}

#
# asec
#
# Computes the arc secant asec(z) = acos(1 / z).
#
sub asec {
	my ($z) = @_;
	_divbyzero "asec($z)", $z if ($z == 0);
	return acos(1 / $z);
}

#
# acsc
#
# Computes the arc cosecant acsc(z) = asin(1 / z).
#
sub acsc {
	my ($z) = @_;
	_divbyzero "acsc($z)", $z if ($z == 0);
	return asin(1 / $z);
}

#
# acosec
#
# Alias for acsc().
#
sub acosec { Math::Complex::acsc(@_) }

#
# acot
#
# Computes the arc cotangent acot(z) = atan(1 / z)
#
sub acot {
	my ($z) = @_;
	_divbyzero "acot(0)"  if $z == 0;
	return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z)
	    unless ref $z;
	_divbyzero "acot(i)"  if ($z - i == 0);
	_logofzero "acot(-i)" if ($z + i == 0);
	return atan(1 / $z);
}

#
# acotan
#
# Alias for acot().
#
sub acotan { Math::Complex::acot(@_) }

#
# cosh
#
# Computes the hyperbolic cosine cosh(z) = (exp(z) + exp(-z))/2.
#
sub cosh {
	my ($z) = @_;
	my $ex;
	unless (ref $z) {
	    $ex = CORE::exp($z);
	    return $ex ? ($ex + 1/$ex)/2 : $Inf;
	}
	my ($x, $y) = @{$z->_cartesian};
	$ex = CORE::exp($x);
	my $ex_1 = $ex ? 1 / $ex : $Inf;
	return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2,
			      CORE::sin($y) * ($ex - $ex_1)/2);
}

#
# sinh
#
# Computes the hyperbolic sine sinh(z) = (exp(z) - exp(-z))/2.
#
sub sinh {
	my ($z) = @_;
	my $ex;
	unless (ref $z) {
	    return 0 if $z == 0;
	    $ex = CORE::exp($z);
	    return $ex ? ($ex - 1/$ex)/2 : "-$Inf";
	}
	my ($x, $y) = @{$z->_cartesian};
	my $cy = CORE::cos($y);
	my $sy = CORE::sin($y);
	$ex = CORE::exp($x);
	my $ex_1 = $ex ? 1 / $ex : $Inf;
	return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2,
			      CORE::sin($y) * ($ex + $ex_1)/2);
}

#
# tanh
#
# Computes the hyperbolic tangent tanh(z) = sinh(z) / cosh(z).
#
sub tanh {
	my ($z) = @_;
	my $cz = cosh($z);
	_divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
	return sinh($z) / $cz;
}

#
# sech
#
# Computes the hyperbolic secant sech(z) = 1 / cosh(z).
#
sub sech {
	my ($z) = @_;
	my $cz = cosh($z);
	_divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
	return 1 / $cz;
}

#
# csch
#
# Computes the hyperbolic cosecant csch(z) = 1 / sinh(z).
#
sub csch {
	my ($z) = @_;
	my $sz = sinh($z);
	_divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
	return 1 / $sz;
}

#
# cosech
#
# Alias for csch().
#
sub cosech { Math::Complex::csch(@_) }

#
# coth
#
# Computes the hyperbolic cotangent coth(z) = cosh(z) / sinh(z).
#
sub coth {
	my ($z) = @_;
	my $sz = sinh($z);
	_divbyzero "coth($z)", "sinh($z)" if $sz == 0;
	return cosh($z) / $sz;
}

#
# cotanh
#
# Alias for coth().
#
sub cotanh { Math::Complex::coth(@_) }

#
# acosh
#
# Computes the arc hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)).
#
sub acosh {
	my ($z) = @_;
	unless (ref $z) {
	    $z = cplx($z, 0);
	}
	my ($re, $im) = @{$z->_cartesian};
	if ($im == 0) {
	    return CORE::log($re + CORE::sqrt($re*$re - 1))
		if $re >= 1;
	    return cplx(0, CORE::atan2(CORE::sqrt(1 - $re*$re), $re))
		if CORE::abs($re) < 1;
	}
	my $t = &sqrt($z * $z - 1) + $z;
	# Try Taylor if looking bad (this usually means that
	# $z was large negative, therefore the sqrt is really
	# close to abs(z), summing that with z...)
	$t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7)
	    if $t == 0;
	my $u = &log($t);
	$u->Im(-$u->Im) if $re < 0 && $im == 0;
	return $re < 0 ? -$u : $u;
}

#
# asinh
#
# Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z+1))
#
sub asinh {
	my ($z) = @_;
	unless (ref $z) {
	    my $t = $z + CORE::sqrt($z*$z + 1);
	    return CORE::log($t) if $t;
	}
	my $t = &sqrt($z * $z + 1) + $z;
	# Try Taylor if looking bad (this usually means that
	# $z was large negative, therefore the sqrt is really
	# close to abs(z), summing that with z...)
	$t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7)
	    if $t == 0;
	return &log($t);
}

#
# atanh
#
# Computes the arc hyperbolic tangent atanh(z) = 1/2 log((1+z) / (1-z)).
#
sub atanh {
	my ($z) = @_;
	unless (ref $z) {
	    return CORE::log((1 + $z)/(1 - $z))/2 if CORE::abs($z) < 1;
	    $z = cplx($z, 0);
	}
	_divbyzero 'atanh(1)',  "1 - $z" if (1 - $z == 0);
	_logofzero 'atanh(-1)'           if (1 + $z == 0);
	return 0.5 * &log((1 + $z) / (1 - $z));
}

#
# asech
#
# Computes the hyperbolic arc secant asech(z) = acosh(1 / z).
#
sub asech {
	my ($z) = @_;
	_divbyzero 'asech(0)', "$z" if ($z == 0);
	return acosh(1 / $z);
}

#
# acsch
#
# Computes the hyperbolic arc cosecant acsch(z) = asinh(1 / z).
#
sub acsch {
	my ($z) = @_;
	_divbyzero 'acsch(0)', $z if ($z == 0);
	return asinh(1 / $z);
}

#
# acosech
#
# Alias for acosh().
#
sub acosech { Math::Complex::acsch(@_) }

#
# acoth
#
# Computes the arc hyperbolic cotangent acoth(z) = 1/2 log((1+z) / (z-1)).
#
sub acoth {
	my ($z) = @_;
	_divbyzero 'acoth(0)'            if ($z == 0);
	unless (ref $z) {
	    return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1;
	    $z = cplx($z, 0);
	}
	_divbyzero 'acoth(1)',  "$z - 1" if ($z - 1 == 0);
	_logofzero 'acoth(-1)', "1 + $z" if (1 + $z == 0);
	return &log((1 + $z) / ($z - 1)) / 2;
}

#
# acotanh
#
# Alias for acot().
#
sub acotanh { Math::Complex::acoth(@_) }

#
# (atan2)
#
# Compute atan(z1/z2), minding the right quadrant.
#
sub atan2 {
	my ($z1, $z2, $inverted) = @_;
	my ($re1, $im1, $re2, $im2);
	if ($inverted) {
	    ($re1, $im1) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
	    ($re2, $im2) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
	} else {
	    ($re1, $im1) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
	    ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
	}
	if ($im1 || $im2) {
	    # In MATLAB the imaginary parts are ignored.
	    # warn "atan2: Imaginary parts ignored";
	    # http://documents.wolfram.com/mathematica/functions/ArcTan
	    # NOTE: Mathematica ArcTan[x,y] while atan2(y,x)
	    my $s = $z1 * $z1 + $z2 * $z2;
	    _divbyzero("atan2") if $s == 0;
	    my $i = &i;
	    my $r = $z2 + $z1 * $i;
	    return -$i * &log($r / &sqrt( $s ));
	}
	return CORE::atan2($re1, $re2);
}

#
# display_format
# ->display_format
#
# Set (get if no argument) the display format for all complex numbers that
# don't happen to have overridden it via ->display_format
#
# When called as an object method, this actually sets the display format for
# the current object.
#
# Valid object formats are 'c' and 'p' for cartesian and polar. The first
# letter is used actually, so the type can be fully spelled out for clarity.
#
sub display_format {
	my $self  = shift;
	my %display_format = %DISPLAY_FORMAT;

	if (ref $self) {			# Called as an object method
	    if (exists $self->{display_format}) {
		my %obj = %{$self->{display_format}};
		@display_format{keys %obj} = values %obj;
	    }
	}
	if (@_ == 1) {
	    $display_format{style} = shift;
	} else {
	    my %new = @_;
	    @display_format{keys %new} = values %new;
	}

	if (ref $self) { # Called as an object method
	    $self->{display_format} = { %display_format };
	    return
		wantarray ?
		    %{$self->{display_format}} :
		    $self->{display_format}->{style};
	}

        # Called as a class method
	%DISPLAY_FORMAT = %display_format;
	return
	    wantarray ?
		%DISPLAY_FORMAT :
		    $DISPLAY_FORMAT{style};
}

#
# (_stringify)
#
# Show nicely formatted complex number under its cartesian or polar form,
# depending on the current display format:
#
# . If a specific display format has been recorded for this object, use it.
# . Otherwise, use the generic current default for all complex numbers,
#   which is a package global variable.
#
sub _stringify {
	my ($z) = shift;

	my $style = $z->display_format;

	$style = $DISPLAY_FORMAT{style} unless defined $style;

	return $z->_stringify_polar if $style =~ /^p/i;
	return $z->_stringify_cartesian;
}

#
# ->_stringify_cartesian
#
# Stringify as a cartesian representation 'a+bi'.
#
sub _stringify_cartesian {
	my $z  = shift;
	my ($x, $y) = @{$z->_cartesian};
	my ($re, $im);

	my %format = $z->display_format;
	my $format = $format{format};

	if ($x) {
	    if ($x =~ /^NaN[QS]?$/i) {
		$re = $x;
	    } else {
		if ($x =~ /^-?$Inf$/oi) {
		    $re = $x;
		} else {
		    $re = defined $format ? sprintf($format, $x) : $x;
		}
	    }
	} else {
	    undef $re;
	}

	if ($y) {
	    if ($y =~ /^(NaN[QS]?)$/i) {
		$im = $y;
	    } else {
		if ($y =~ /^-?$Inf$/oi) {
		    $im = $y;
		} else {
		    $im =
			defined $format ?
			    sprintf($format, $y) :
			    ($y == 1 ? "" : ($y == -1 ? "-" : $y));
		}
	    }
	    $im .= "i";
	} else {
	    undef $im;
	}

	my $str = $re;

	if (defined $im) {
	    if ($y < 0) {
		$str .= $im;
	    } elsif ($y > 0 || $im =~ /^NaN[QS]?i$/i)  {
		$str .= "+" if defined $re;
		$str .= $im;
	    }
	} elsif (!defined $re) {
	    $str = "0";
	}

	return $str;
}


#
# ->_stringify_polar
#
# Stringify as a polar representation '[r,t]'.
#
sub _stringify_polar {
	my $z  = shift;
	my ($r, $t) = @{$z->_polar};
	my $theta;

	my %format = $z->display_format;
	my $format = $format{format};

	if ($t =~ /^NaN[QS]?$/i || $t =~ /^-?$Inf$/oi) {
	    $theta = $t; 
	} elsif ($t == pi) {
	    $theta = "pi";
	} elsif ($r == 0 || $t == 0) {
	    $theta = defined $format ? sprintf($format, $t) : $t;
	}

	return "[$r,$theta]" if defined $theta;

	#
	# Try to identify pi/n and friends.
	#

	$t -= int(CORE::abs($t) / pi2) * pi2;

	if ($format{polar_pretty_print} && $t) {
	    my ($a, $b);
	    for $a (2..9) {
		$b = $t * $a / pi;
		if ($b =~ /^-?\d+$/) {
		    $b = $b < 0 ? "-" : "" if CORE::abs($b) == 1;
		    $theta = "${b}pi/$a";
		    last;
		}
	    }
	}

        if (defined $format) {
	    $r     = sprintf($format, $r);
	    $theta = sprintf($format, $theta) unless defined $theta;
	} else {
	    $theta = $t unless defined $theta;
	}

	return "[$r,$theta]";
}

1;
__END__

=pod

=head1 NAME