File:  [LON-CAPA] / loncom / xml / LCMathComplex.pm
Revision 1.2: download - view: text, annotated - select for diffs
Sun Nov 10 23:52:07 2019 UTC (4 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, HEAD
- Update to Math::Complex rev. 1.59_01 to eliminate warnings in perl > 5.26
  "Undefined value assigned to typeglob" then modify (and rename as:
  LONCAPA::LCMathComplex) to eliminate use of Config.pm and Scalar::Util.pm,
  when run in perl Safe container).

    1: #
    2: # Complex numbers and associated mathematical functions
    3: # -- Raphael Manfredi	Since Sep 1996
    4: # -- Jarkko Hietaniemi	Since Mar 1997
    5: # -- Daniel S. Lewart	Since Sep 1997
    6: #
    7: # -- Stuart Raeburn: renamed package (rev. 1.55) as LCMathComplex Oct 2013
    8: #                    renamed package (rev. 1.59_01) as LCMathComplex Nov 2019
    9: #    with minor changes to allow use in Safe Space
   10: #
   11: 
   12: package LONCAPA::LCMathComplex;
   13: 
   14: { use 5.006; }
   15: use strict;
   16: 
   17: our $VERSION = 1.59_01;
   18: 
   19: our ($Inf, $ExpInf);
   20: our ($vax_float, $has_inf, $has_nan);
   21: 
   22: BEGIN {
   23:     $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/);
   24:     $has_inf   = !$vax_float;
   25:     $has_nan   = !$vax_float;
   26: 
   27:     unless ($has_inf) {
   28:       # For example in vax, there is no Inf,
   29:       # and just mentioning the DBL_MAX (1.70141183460469229e+38)
   30:       # causes SIGFPE.
   31: 
   32:       # These are pretty useless without a real infinity,
   33:       # but setting them makes for less warnings about their
   34:       # undefined values.
   35:       $Inf = "Inf";
   36:       $ExpInf = "Inf";
   37:       return;
   38:     }
   39: 
   40:     my %DBL_MAX =  # These are IEEE 754 maxima.
   41: 	(
   42: 	  4  => '1.70141183460469229e+38',
   43: 	  8  => '1.7976931348623157e+308',
   44: 	 # AFAICT the 10, 12, and 16-byte long doubles
   45: 	 # all have the same maximum.
   46: 	 10 => '1.1897314953572317650857593266280070162E+4932',
   47: 	 12 => '1.1897314953572317650857593266280070162E+4932',
   48: 	 16 => '1.1897314953572317650857593266280070162E+4932',
   49: 	);
   50: 
   51:     my $nvsize = 8;
   52:     die "Math::Complex: Could not figure out nvsize\n"
   53: 	unless defined $nvsize;
   54:     die "LONCAPA::LCMathComplex: Cannot not figure out max nv (nvsize = $nvsize)\n"
   55: 	unless defined $DBL_MAX{$nvsize};
   56:     my $DBL_MAX = eval $DBL_MAX{$nvsize};
   57:     die "LONCAPA::LCMathComplex: Could not figure out max nv (nvsize = $nvsize)\n"
   58: 	unless defined $DBL_MAX;
   59:     my $BIGGER_THAN_THIS = 1e30;  # Must find something bigger than this.
   60:     if ($^O eq 'unicosmk') {
   61: 	$Inf = $DBL_MAX;
   62:     } else {
   63: 	local $SIG{FPE} = sub { };
   64:         local $!;
   65: 	# We do want an arithmetic overflow, Inf INF inf Infinity.
   66: 	for my $t (
   67: 	    'exp(99999)',  # Enough even with 128-bit long doubles.
   68: 	    'inf',
   69: 	    'Inf',
   70: 	    'INF',
   71: 	    'infinity',
   72: 	    'Infinity',
   73: 	    'INFINITY',
   74: 	    '1e99999',
   75: 	    ) {
   76: 	    local $^W = 0;
   77: 	    my $i = eval "$t+1.0";
   78: 	    if (defined $i && $i > $BIGGER_THAN_THIS) {
   79: 		$Inf = $i;
   80: 		last;
   81: 	    }
   82:           }
   83: 	$Inf = $DBL_MAX unless defined $Inf;  # Oh well, close enough.
   84: 	die "LONCAPA::LCMathComplex: Could not get Infinity"
   85: 	    unless $Inf > $BIGGER_THAN_THIS;
   86: 	$ExpInf = eval 'exp(99999)';
   87:       }
   88:     # print "# On this machine, Inf = '$Inf'\n";
   89: }
   90: 
   91: use warnings;
   92: no warnings 'syntax';  # To avoid the (_) warnings.
   93: 
   94: my $i;
   95: my %LOGN;
   96: 
   97: # Regular expression for floating point numbers.
   98: # These days we could use Scalar::Util::lln(), I guess.
   99: my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?))|inf)'i;
  100: 
  101: require Exporter;
  102: 
  103: our @ISA = qw(Exporter);
  104: 
  105: my @trig = qw(
  106: 	      pi
  107: 	      tan
  108: 	      csc cosec sec cot cotan
  109: 	      asin acos atan
  110: 	      acsc acosec asec acot acotan
  111: 	      sinh cosh tanh
  112: 	      csch cosech sech coth cotanh
  113: 	      asinh acosh atanh
  114: 	      acsch acosech asech acoth acotanh
  115: 	     );
  116: 
  117: our @EXPORT = (qw(
  118: 	     i Re Im rho theta arg
  119: 	     sqrt log ln
  120: 	     log10 logn cbrt root
  121: 	     cplx cplxe
  122: 	     atan2
  123: 	     ),
  124: 	   @trig);
  125: 
  126: my @pi = qw(pi pi2 pi4 pip2 pip4 Inf);
  127: 
  128: our @EXPORT_OK = @pi;
  129: 
  130: our %EXPORT_TAGS = (
  131:     'trig' => [@trig],
  132:     'pi' => [@pi],
  133: );
  134: 
  135: use overload
  136: 	'='	=> \&_copy,
  137: 	'+='	=> \&_plus,
  138: 	'+'	=> \&_plus,
  139: 	'-='	=> \&_minus,
  140: 	'-'	=> \&_minus,
  141: 	'*='	=> \&_multiply,
  142: 	'*'	=> \&_multiply,
  143: 	'/='	=> \&_divide,
  144: 	'/'	=> \&_divide,
  145: 	'**='	=> \&_power,
  146: 	'**'	=> \&_power,
  147: 	'=='	=> \&_numeq,
  148: 	'<=>'	=> \&_spaceship,
  149: 	'neg'	=> \&_negate,
  150: 	'~'	=> \&_conjugate,
  151: 	'abs'	=> \&abs,
  152: 	'sqrt'	=> \&sqrt,
  153: 	'exp'	=> \&exp,
  154: 	'log'	=> \&log,
  155: 	'sin'	=> \&sin,
  156: 	'cos'	=> \&cos,
  157: 	'atan2'	=> \&atan2,
  158:         '""'    => \&_stringify;
  159: 
  160: #
  161: # Package "privates"
  162: #
  163: 
  164: my %DISPLAY_FORMAT = ('style' => 'cartesian',
  165: 		      'polar_pretty_print' => 1);
  166: my $eps            = 1e-14;		# Epsilon
  167: 
  168: #
  169: # Object attributes (internal):
  170: #	cartesian	[real, imaginary] -- cartesian form
  171: #	polar		[rho, theta] -- polar form
  172: #	c_dirty		cartesian form not up-to-date
  173: #	p_dirty		polar form not up-to-date
  174: #	display		display format (package's global when not set)
  175: #
  176: 
  177: # Die on bad *make() arguments.
  178: 
  179: sub _cannot_make {
  180:     die "@{[(caller(1))[3]]}: Cannot take $_[0] of '$_[1]'.\n";
  181: }
  182: 
  183: sub _make {
  184:     my $arg = shift;
  185:     my ($p, $q);
  186: 
  187:     if ($arg =~ /^$gre$/) {
  188: 	($p, $q) = ($1, 0);
  189:     } elsif ($arg =~ /^(?:$gre)?$gre\s*i\s*$/) {
  190: 	($p, $q) = ($1 || 0, $2);
  191:     } elsif ($arg =~ /^\s*\(\s*$gre\s*(?:,\s*$gre\s*)?\)\s*$/) {
  192: 	($p, $q) = ($1, $2 || 0);
  193:     }
  194: 
  195:     if (defined $p) {
  196: 	$p =~ s/^\+//;
  197: 	$p =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf;
  198: 	$q =~ s/^\+//;
  199: 	$q =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf;
  200:     }
  201: 
  202:     return ($p, $q);
  203: }
  204: 
  205: sub _emake {
  206:     my $arg = shift;
  207:     my ($p, $q);
  208: 
  209:     if ($arg =~ /^\s*\[\s*$gre\s*(?:,\s*$gre\s*)?\]\s*$/) {
  210: 	($p, $q) = ($1, $2 || 0);
  211:     } elsif ($arg =~ m!^\s*\[\s*$gre\s*(?:,\s*([-+]?\d*\s*)?pi(?:/\s*(\d+))?\s*)?\]\s*$!) {
  212: 	($p, $q) = ($1, ($2 eq '-' ? -1 : ($2 || 1)) * pi() / ($3 || 1));
  213:     } elsif ($arg =~ /^\s*\[\s*$gre\s*\]\s*$/) {
  214: 	($p, $q) = ($1, 0);
  215:     } elsif ($arg =~ /^\s*$gre\s*$/) {
  216: 	($p, $q) = ($1, 0);
  217:     }
  218: 
  219:     if (defined $p) {
  220: 	$p =~ s/^\+//;
  221: 	$q =~ s/^\+//;
  222: 	$p =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf;
  223: 	$q =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf;
  224:     }
  225: 
  226:     return ($p, $q);
  227: }
  228: 
  229: sub _copy {
  230:     my $self = shift;
  231:     my $clone = {%$self};
  232:     if ($self->{'cartesian'}) {
  233: 	$clone->{'cartesian'} = [@{$self->{'cartesian'}}];
  234:     }
  235:     if ($self->{'polar'}) {
  236: 	$clone->{'polar'} = [@{$self->{'polar'}}];
  237:     }
  238:     bless $clone,__PACKAGE__;
  239:     return $clone;
  240: }
  241: 
  242: #
  243: # ->make
  244: #
  245: # Create a new complex number (cartesian form)
  246: #
  247: sub make {
  248:     my $self = bless {}, shift;
  249:     my ($re, $im);
  250:     if (@_ == 0) {
  251: 	($re, $im) = (0, 0);
  252:     } elsif (@_ == 1) {
  253: 	return (ref $self)->emake($_[0])
  254: 	    if ($_[0] =~ /^\s*\[/);
  255: 	($re, $im) = _make($_[0]);
  256:     } elsif (@_ == 2) {
  257: 	($re, $im) = @_;
  258:     }
  259:     if (defined $re) {
  260: 	_cannot_make("real part",      $re) unless $re =~ /^$gre$/;
  261:     }
  262:     $im ||= 0;
  263:     _cannot_make("imaginary part", $im) unless $im =~ /^$gre$/;
  264:     $self->_set_cartesian([$re, $im ]);
  265:     $self->display_format('cartesian');
  266: 
  267:     return $self;
  268: }
  269: 
  270: #
  271: # ->emake
  272: #
  273: # Create a new complex number (exponential form)
  274: #
  275: sub emake {
  276:     my $self = bless {}, shift;
  277:     my ($rho, $theta);
  278:     if (@_ == 0) {
  279: 	($rho, $theta) = (0, 0);
  280:     } elsif (@_ == 1) {
  281: 	return (ref $self)->make($_[0])
  282: 	    if ($_[0] =~ /^\s*\(/ || $_[0] =~ /i\s*$/);
  283: 	($rho, $theta) = _emake($_[0]);
  284:     } elsif (@_ == 2) {
  285: 	($rho, $theta) = @_;
  286:     }
  287:     if (defined $rho && defined $theta) {
  288: 	if ($rho < 0) {
  289: 	    $rho   = -$rho;
  290: 	    $theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
  291: 	}
  292:     }
  293:     if (defined $rho) {
  294: 	_cannot_make("rho",   $rho)   unless $rho   =~ /^$gre$/;
  295:     }
  296:     $theta ||= 0;
  297:     _cannot_make("theta", $theta) unless $theta =~ /^$gre$/;
  298:     $self->_set_polar([$rho, $theta]);
  299:     $self->display_format('polar');
  300: 
  301:     return $self;
  302: }
  303: 
  304: sub new { &make }		# For backward compatibility only.
  305: 
  306: #
  307: # cplx
  308: #
  309: # Creates a complex number from a (re, im) tuple.
  310: # This avoids the burden of writing LONCAPA::LCMathComplex->make(re, im).
  311: #
  312: sub cplx {
  313: 	return __PACKAGE__->make(@_);
  314: }
  315: 
  316: #
  317: # cplxe
  318: #
  319: # Creates a complex number from a (rho, theta) tuple.
  320: # This avoids the burden of writing LONCAPA::LCMathComplex->emake(rho, theta).
  321: #
  322: sub cplxe {
  323: 	return __PACKAGE__->emake(@_);
  324: }
  325: 
  326: #
  327: # pi
  328: #
  329: # The number defined as pi = 180 degrees
  330: #
  331: sub pi () { 4 * CORE::atan2(1, 1) }
  332: 
  333: #
  334: # pi2
  335: #
  336: # The full circle
  337: #
  338: sub pi2 () { 2 * pi }
  339: 
  340: #
  341: # pi4
  342: #
  343: # The full circle twice.
  344: #
  345: sub pi4 () { 4 * pi }
  346: 
  347: #
  348: # pip2
  349: #
  350: # The quarter circle
  351: #
  352: sub pip2 () { pi / 2 }
  353: 
  354: #
  355: # pip4
  356: #
  357: # The eighth circle.
  358: #
  359: sub pip4 () { pi / 4 }
  360: 
  361: #
  362: # _uplog10
  363: #
  364: # Used in log10().
  365: #
  366: sub _uplog10 () { 1 / CORE::log(10) }
  367: 
  368: #
  369: # i
  370: #
  371: # The number defined as i*i = -1;
  372: #
  373: sub i () {
  374:         return $i if ($i);
  375: 	$i = bless {};
  376: 	$i->{'cartesian'} = [0, 1];
  377: 	$i->{'polar'}     = [1, pip2];
  378: 	$i->{c_dirty} = 0;
  379: 	$i->{p_dirty} = 0;
  380: 	return $i;
  381: }
  382: 
  383: #
  384: # _ip2
  385: #
  386: # Half of i.
  387: #
  388: sub _ip2 () { i / 2 }
  389: 
  390: #
  391: # Attribute access/set routines
  392: #
  393: 
  394: sub _cartesian {$_[0]->{c_dirty} ?
  395: 		   $_[0]->_update_cartesian : $_[0]->{'cartesian'}}
  396: sub _polar     {$_[0]->{p_dirty} ?
  397: 		   $_[0]->_update_polar : $_[0]->{'polar'}}
  398: 
  399: sub _set_cartesian { $_[0]->{p_dirty}++; $_[0]->{c_dirty} = 0;
  400: 		     $_[0]->{'cartesian'} = $_[1] }
  401: sub _set_polar     { $_[0]->{c_dirty}++; $_[0]->{p_dirty} = 0;
  402: 		     $_[0]->{'polar'} = $_[1] }
  403: 
  404: #
  405: # ->_update_cartesian
  406: #
  407: # Recompute and return the cartesian form, given accurate polar form.
  408: #
  409: sub _update_cartesian {
  410: 	my $self = shift;
  411: 	my ($r, $t) = @{$self->{'polar'}};
  412: 	$self->{c_dirty} = 0;
  413: 	return $self->{'cartesian'} = [$r * CORE::cos($t), $r * CORE::sin($t)];
  414: }
  415: 
  416: #
  417: #
  418: # ->_update_polar
  419: #
  420: # Recompute and return the polar form, given accurate cartesian form.
  421: #
  422: sub _update_polar {
  423: 	my $self = shift;
  424: 	my ($x, $y) = @{$self->{'cartesian'}};
  425: 	$self->{p_dirty} = 0;
  426: 	return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0;
  427: 	return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y),
  428: 				   CORE::atan2($y, $x)];
  429: }
  430: 
  431: #
  432: # (_plus)
  433: #
  434: # Computes z1+z2.
  435: #
  436: sub _plus {
  437: 	my ($z1, $z2, $regular) = @_;
  438: 	my ($re1, $im1) = @{$z1->_cartesian};
  439: 	$z2 = cplx($z2) unless ref $z2;
  440: 	my ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
  441: 	unless (defined $regular) {
  442: 		$z1->_set_cartesian([$re1 + $re2, $im1 + $im2]);
  443: 		return $z1;
  444: 	}
  445: 	return (ref $z1)->make($re1 + $re2, $im1 + $im2);
  446: }
  447: 
  448: #
  449: # (_minus)
  450: #
  451: # Computes z1-z2.
  452: #
  453: sub _minus {
  454: 	my ($z1, $z2, $inverted) = @_;
  455: 	my ($re1, $im1) = @{$z1->_cartesian};
  456: 	$z2 = cplx($z2) unless ref $z2;
  457: 	my ($re2, $im2) = @{$z2->_cartesian};
  458: 	unless (defined $inverted) {
  459: 		$z1->_set_cartesian([$re1 - $re2, $im1 - $im2]);
  460: 		return $z1;
  461: 	}
  462: 	return $inverted ?
  463: 		(ref $z1)->make($re2 - $re1, $im2 - $im1) :
  464: 		(ref $z1)->make($re1 - $re2, $im1 - $im2);
  465: 
  466: }
  467: 
  468: #
  469: # (_multiply)
  470: #
  471: # Computes z1*z2.
  472: #
  473: sub _multiply {
  474:         my ($z1, $z2, $regular) = @_;
  475: 	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
  476: 	    # if both polar better use polar to avoid rounding errors
  477: 	    my ($r1, $t1) = @{$z1->_polar};
  478: 	    my ($r2, $t2) = @{$z2->_polar};
  479: 	    my $t = $t1 + $t2;
  480: 	    if    ($t >   pi()) { $t -= pi2 }
  481: 	    elsif ($t <= -pi()) { $t += pi2 }
  482: 	    unless (defined $regular) {
  483: 		$z1->_set_polar([$r1 * $r2, $t]);
  484: 		return $z1;
  485: 	    }
  486: 	    return (ref $z1)->emake($r1 * $r2, $t);
  487: 	} else {
  488: 	    my ($x1, $y1) = @{$z1->_cartesian};
  489: 	    if (ref $z2) {
  490: 		my ($x2, $y2) = @{$z2->_cartesian};
  491: 		return (ref $z1)->make($x1*$x2-$y1*$y2, $x1*$y2+$y1*$x2);
  492: 	    } else {
  493: 		return (ref $z1)->make($x1*$z2, $y1*$z2);
  494: 	    }
  495: 	}
  496: }
  497: 
  498: #
  499: # _divbyzero
  500: #
  501: # Die on division by zero.
  502: #
  503: sub _divbyzero {
  504:     my $mess = "$_[0]: Division by zero.\n";
  505: 
  506:     if (defined $_[1]) {
  507: 	$mess .= "(Because in the definition of $_[0], the divisor ";
  508: 	$mess .= "$_[1] " unless ("$_[1]" eq '0');
  509: 	$mess .= "is 0)\n";
  510:     }
  511: 
  512:     my @up = caller(1);
  513: 
  514:     $mess .= "Died at $up[1] line $up[2].\n";
  515: 
  516:     die $mess;
  517: }
  518: 
  519: #
  520: # (_divide)
  521: #
  522: # Computes z1/z2.
  523: #
  524: sub _divide {
  525: 	my ($z1, $z2, $inverted) = @_;
  526: 	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
  527: 	    # if both polar better use polar to avoid rounding errors
  528: 	    my ($r1, $t1) = @{$z1->_polar};
  529: 	    my ($r2, $t2) = @{$z2->_polar};
  530: 	    my $t;
  531: 	    if ($inverted) {
  532: 		_divbyzero "$z2/0" if ($r1 == 0);
  533: 		$t = $t2 - $t1;
  534: 		if    ($t >   pi()) { $t -= pi2 }
  535: 		elsif ($t <= -pi()) { $t += pi2 }
  536: 		return (ref $z1)->emake($r2 / $r1, $t);
  537: 	    } else {
  538: 		_divbyzero "$z1/0" if ($r2 == 0);
  539: 		$t = $t1 - $t2;
  540: 		if    ($t >   pi()) { $t -= pi2 }
  541: 		elsif ($t <= -pi()) { $t += pi2 }
  542: 		return (ref $z1)->emake($r1 / $r2, $t);
  543: 	    }
  544: 	} else {
  545: 	    my ($d, $x2, $y2);
  546: 	    if ($inverted) {
  547: 		($x2, $y2) = @{$z1->_cartesian};
  548: 		$d = $x2*$x2 + $y2*$y2;
  549: 		_divbyzero "$z2/0" if $d == 0;
  550: 		return (ref $z1)->make(($x2*$z2)/$d, -($y2*$z2)/$d);
  551: 	    } else {
  552: 		my ($x1, $y1) = @{$z1->_cartesian};
  553: 		if (ref $z2) {
  554: 		    ($x2, $y2) = @{$z2->_cartesian};
  555: 		    $d = $x2*$x2 + $y2*$y2;
  556: 		    _divbyzero "$z1/0" if $d == 0;
  557: 		    my $u = ($x1*$x2 + $y1*$y2)/$d;
  558: 		    my $v = ($y1*$x2 - $x1*$y2)/$d;
  559: 		    return (ref $z1)->make($u, $v);
  560: 		} else {
  561: 		    _divbyzero "$z1/0" if $z2 == 0;
  562: 		    return (ref $z1)->make($x1/$z2, $y1/$z2);
  563: 		}
  564: 	    }
  565: 	}
  566: }
  567: 
  568: #
  569: # (_power)
  570: #
  571: # Computes z1**z2 = exp(z2 * log z1)).
  572: #
  573: sub _power {
  574: 	my ($z1, $z2, $inverted) = @_;
  575: 	if ($inverted) {
  576: 	    return 1 if $z1 == 0 || $z2 == 1;
  577: 	    return 0 if $z2 == 0 && Re($z1) > 0;
  578: 	} else {
  579: 	    return 1 if $z2 == 0 || $z1 == 1;
  580: 	    return 0 if $z1 == 0 && Re($z2) > 0;
  581: 	}
  582: 	my $w = $inverted ? &exp($z1 * &log($z2))
  583: 	                  : &exp($z2 * &log($z1));
  584: 	# If both arguments cartesian, return cartesian, else polar.
  585: 	return $z1->{c_dirty} == 0 &&
  586: 	       (not ref $z2 or $z2->{c_dirty} == 0) ?
  587: 	       cplx(@{$w->_cartesian}) : $w;
  588: }
  589: 
  590: #
  591: # (_spaceship)
  592: #
  593: # Computes z1 <=> z2.
  594: # Sorts on the real part first, then on the imaginary part. Thus 2-4i < 3+8i.
  595: #
  596: sub _spaceship {
  597: 	my ($z1, $z2, $inverted) = @_;
  598: 	my ($re1, $im1) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
  599: 	my ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
  600: 	my $sgn = $inverted ? -1 : 1;
  601: 	return $sgn * ($re1 <=> $re2) if $re1 != $re2;
  602: 	return $sgn * ($im1 <=> $im2);
  603: }
  604: 
  605: #
  606: # (_numeq)
  607: #
  608: # Computes z1 == z2.
  609: #
  610: # (Required in addition to _spaceship() because of NaNs.)
  611: sub _numeq {
  612: 	my ($z1, $z2, $inverted) = @_;
  613: 	my ($re1, $im1) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
  614: 	my ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
  615: 	return $re1 == $re2 && $im1 == $im2 ? 1 : 0;
  616: }
  617: 
  618: #
  619: # (_negate)
  620: #
  621: # Computes -z.
  622: #
  623: sub _negate {
  624: 	my ($z) = @_;
  625: 	if ($z->{c_dirty}) {
  626: 		my ($r, $t) = @{$z->_polar};
  627: 		$t = ($t <= 0) ? $t + pi : $t - pi;
  628: 		return (ref $z)->emake($r, $t);
  629: 	}
  630: 	my ($re, $im) = @{$z->_cartesian};
  631: 	return (ref $z)->make(-$re, -$im);
  632: }
  633: 
  634: #
  635: # (_conjugate)
  636: #
  637: # Compute complex's _conjugate.
  638: #
  639: sub _conjugate {
  640: 	my ($z) = @_;
  641: 	if ($z->{c_dirty}) {
  642: 		my ($r, $t) = @{$z->_polar};
  643: 		return (ref $z)->emake($r, -$t);
  644: 	}
  645: 	my ($re, $im) = @{$z->_cartesian};
  646: 	return (ref $z)->make($re, -$im);
  647: }
  648: 
  649: #
  650: # (abs)
  651: #
  652: # Compute or set complex's norm (rho).
  653: #
  654: sub abs {
  655: 	my ($z, $rho) = @_ ? @_ : $_;
  656: 	unless (ref $z) {
  657: 	    if (@_ == 2) {
  658: 		$_[0] = $_[1];
  659: 	    } else {
  660: 		return CORE::abs($z);
  661: 	    }
  662: 	}
  663: 	if (defined $rho) {
  664: 	    $z->{'polar'} = [ $rho, ${$z->_polar}[1] ];
  665: 	    $z->{p_dirty} = 0;
  666: 	    $z->{c_dirty} = 1;
  667: 	    return $rho;
  668: 	} else {
  669: 	    return ${$z->_polar}[0];
  670: 	}
  671: }
  672: 
  673: sub _theta {
  674:     my $theta = $_[0];
  675: 
  676:     if    ($$theta >   pi()) { $$theta -= pi2 }
  677:     elsif ($$theta <= -pi()) { $$theta += pi2 }
  678: }
  679: 
  680: #
  681: # arg
  682: #
  683: # Compute or set complex's argument (theta).
  684: #
  685: sub arg {
  686: 	my ($z, $theta) = @_;
  687: 	return $z unless ref $z;
  688: 	if (defined $theta) {
  689: 	    _theta(\$theta);
  690: 	    $z->{'polar'} = [ ${$z->_polar}[0], $theta ];
  691: 	    $z->{p_dirty} = 0;
  692: 	    $z->{c_dirty} = 1;
  693: 	} else {
  694: 	    $theta = ${$z->_polar}[1];
  695: 	    _theta(\$theta);
  696: 	}
  697: 	return $theta;
  698: }
  699: 
  700: #
  701: # (sqrt)
  702: #
  703: # Compute sqrt(z).
  704: #
  705: # It is quite tempting to use wantarray here so that in list context
  706: # sqrt() would return the two solutions.  This, however, would
  707: # break things like
  708: #
  709: #	print "sqrt(z) = ", sqrt($z), "\n";
  710: #
  711: # The two values would be printed side by side without no intervening
  712: # whitespace, quite confusing.
  713: # Therefore if you want the two solutions use the root().
  714: #
  715: sub sqrt {
  716: 	my ($z) = @_ ? $_[0] : $_;
  717: 	my ($re, $im) = ref $z ? @{$z->_cartesian} : ($z, 0);
  718: 	return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re)
  719: 	    if $im == 0;
  720: 	my ($r, $t) = @{$z->_polar};
  721: 	return (ref $z)->emake(CORE::sqrt($r), $t/2);
  722: }
  723: 
  724: #
  725: # cbrt
  726: #
  727: # Compute cbrt(z) (cubic root).
  728: #
  729: # Why are we not returning three values?  The same answer as for sqrt().
  730: #
  731: sub cbrt {
  732: 	my ($z) = @_;
  733: 	return $z < 0 ?
  734: 	    -CORE::exp(CORE::log(-$z)/3) :
  735: 		($z > 0 ? CORE::exp(CORE::log($z)/3): 0)
  736: 	    unless ref $z;
  737: 	my ($r, $t) = @{$z->_polar};
  738: 	return 0 if $r == 0;
  739: 	return (ref $z)->emake(CORE::exp(CORE::log($r)/3), $t/3);
  740: }
  741: 
  742: #
  743: # _rootbad
  744: #
  745: # Die on bad root.
  746: #
  747: sub _rootbad {
  748:     my $mess = "Root '$_[0]' illegal, root rank must be positive integer.\n";
  749: 
  750:     my @up = caller(1);
  751: 
  752:     $mess .= "Died at $up[1] line $up[2].\n";
  753: 
  754:     die $mess;
  755: }
  756: 
  757: #
  758: # root
  759: #
  760: # Computes all nth root for z, returning an array whose size is n.
  761: # `n' must be a positive integer.
  762: #
  763: # The roots are given by (for k = 0..n-1):
  764: #
  765: # z^(1/n) = r^(1/n) (cos ((t+2 k pi)/n) + i sin ((t+2 k pi)/n))
  766: #
  767: sub root {
  768: 	my ($z, $n, $k) = @_;
  769: 	_rootbad($n) if ($n < 1 or int($n) != $n);
  770: 	my ($r, $t) = ref $z ?
  771: 	    @{$z->_polar} : (CORE::abs($z), $z >= 0 ? 0 : pi);
  772: 	my $theta_inc = pi2 / $n;
  773: 	my $rho = $r ** (1/$n);
  774: 	my $cartesian = ref $z && $z->{c_dirty} == 0;
  775: 	if (@_ == 2) {
  776: 	    my @root;
  777: 	    for (my $i = 0, my $theta = $t / $n;
  778: 		 $i < $n;
  779: 		 $i++, $theta += $theta_inc) {
  780: 		my $w = cplxe($rho, $theta);
  781: 		# Yes, $cartesian is loop invariant.
  782: 		push @root, $cartesian ? cplx(@{$w->_cartesian}) : $w;
  783: 	    }
  784: 	    return @root;
  785: 	} elsif (@_ == 3) {
  786: 	    my $w = cplxe($rho, $t / $n + $k * $theta_inc);
  787: 	    return $cartesian ? cplx(@{$w->_cartesian}) : $w;
  788: 	}
  789: }
  790: 
  791: #
  792: # Re
  793: #
  794: # Return or set Re(z).
  795: #
  796: sub Re {
  797: 	my ($z, $Re) = @_;
  798: 	return $z unless ref $z;
  799: 	if (defined $Re) {
  800: 	    $z->{'cartesian'} = [ $Re, ${$z->_cartesian}[1] ];
  801: 	    $z->{c_dirty} = 0;
  802: 	    $z->{p_dirty} = 1;
  803: 	} else {
  804: 	    return ${$z->_cartesian}[0];
  805: 	}
  806: }
  807: 
  808: #
  809: # Im
  810: #
  811: # Return or set Im(z).
  812: #
  813: sub Im {
  814: 	my ($z, $Im) = @_;
  815: 	return 0 unless ref $z;
  816: 	if (defined $Im) {
  817: 	    $z->{'cartesian'} = [ ${$z->_cartesian}[0], $Im ];
  818: 	    $z->{c_dirty} = 0;
  819: 	    $z->{p_dirty} = 1;
  820: 	} else {
  821: 	    return ${$z->_cartesian}[1];
  822: 	}
  823: }
  824: 
  825: #
  826: # rho
  827: #
  828: # Return or set rho(w).
  829: #
  830: sub rho {
  831:     LONCAPA::LCMathComplex::abs(@_);
  832: }
  833: 
  834: #
  835: # theta
  836: #
  837: # Return or set theta(w).
  838: #
  839: sub theta {
  840:     LONCAPA::LCMathComplex::arg(@_);
  841: }
  842: 
  843: #
  844: # (exp)
  845: #
  846: # Computes exp(z).
  847: #
  848: sub exp {
  849:     my ($z) = @_ ? @_ : $_;
  850:     return CORE::exp($z) unless ref $z;
  851:     my ($x, $y) = @{$z->_cartesian};
  852:     return (ref $z)->emake(CORE::exp($x), $y);
  853: }
  854: 
  855: #
  856: # _logofzero
  857: #
  858: # Die on logarithm of zero.
  859: #
  860: sub _logofzero {
  861:     my $mess = "$_[0]: Logarithm of zero.\n";
  862: 
  863:     if (defined $_[1]) {
  864: 	$mess .= "(Because in the definition of $_[0], the argument ";
  865: 	$mess .= "$_[1] " unless ($_[1] eq '0');
  866: 	$mess .= "is 0)\n";
  867:     }
  868: 
  869:     my @up = caller(1);
  870: 
  871:     $mess .= "Died at $up[1] line $up[2].\n";
  872: 
  873:     die $mess;
  874: }
  875: 
  876: #
  877: # (log)
  878: #
  879: # Compute log(z).
  880: #
  881: sub log {
  882: 	my ($z) = @_ ? @_ : $_;
  883: 	unless (ref $z) {
  884: 	    _logofzero("log") if $z == 0;
  885: 	    return $z > 0 ? CORE::log($z) : cplx(CORE::log(-$z), pi);
  886: 	}
  887: 	my ($r, $t) = @{$z->_polar};
  888: 	_logofzero("log") if $r == 0;
  889: 	if    ($t >   pi()) { $t -= pi2 }
  890: 	elsif ($t <= -pi()) { $t += pi2 }
  891: 	return (ref $z)->make(CORE::log($r), $t);
  892: }
  893: 
  894: #
  895: # ln
  896: #
  897: # Alias for log().
  898: #
  899: sub ln { LONCAPA::LCMathComplex::log(@_) }
  900: 
  901: #
  902: # log10
  903: #
  904: # Compute log10(z).
  905: #
  906: 
  907: sub log10 {
  908: 	return LONCAPA::LCMathComplex::log($_[0]) * _uplog10;
  909: }
  910: 
  911: #
  912: # logn
  913: #
  914: # Compute logn(z,n) = log(z) / log(n)
  915: #
  916: sub logn {
  917: 	my ($z, $n) = @_;
  918: 	$z = cplx($z, 0) unless ref $z;
  919: 	my $logn = $LOGN{$n};
  920: 	$logn = $LOGN{$n} = CORE::log($n) unless defined $logn;	# Cache log(n)
  921: 	return &log($z) / $logn;
  922: }
  923: 
  924: #
  925: # (cos)
  926: #
  927: # Compute cos(z) = (exp(iz) + exp(-iz))/2.
  928: #
  929: sub cos {
  930: 	my ($z) = @_ ? @_ : $_;
  931: 	return CORE::cos($z) unless ref $z;
  932: 	my ($x, $y) = @{$z->_cartesian};
  933: 	my $ey = CORE::exp($y);
  934: 	my $sx = CORE::sin($x);
  935: 	my $cx = CORE::cos($x);
  936: 	my $ey_1 = $ey ? 1 / $ey : Inf();
  937: 	return (ref $z)->make($cx * ($ey + $ey_1)/2,
  938: 			      $sx * ($ey_1 - $ey)/2);
  939: }
  940: 
  941: #
  942: # (sin)
  943: #
  944: # Compute sin(z) = (exp(iz) - exp(-iz))/2.
  945: #
  946: sub sin {
  947: 	my ($z) = @_ ? @_ : $_;
  948: 	return CORE::sin($z) unless ref $z;
  949: 	my ($x, $y) = @{$z->_cartesian};
  950: 	my $ey = CORE::exp($y);
  951: 	my $sx = CORE::sin($x);
  952: 	my $cx = CORE::cos($x);
  953: 	my $ey_1 = $ey ? 1 / $ey : Inf();
  954: 	return (ref $z)->make($sx * ($ey + $ey_1)/2,
  955: 			      $cx * ($ey - $ey_1)/2);
  956: }
  957: 
  958: #
  959: # tan
  960: #
  961: # Compute tan(z) = sin(z) / cos(z).
  962: #
  963: sub tan {
  964: 	my ($z) = @_;
  965: 	my $cz = &cos($z);
  966: 	_divbyzero "tan($z)", "cos($z)" if $cz == 0;
  967: 	return &sin($z) / $cz;
  968: }
  969: 
  970: #
  971: # sec
  972: #
  973: # Computes the secant sec(z) = 1 / cos(z).
  974: #
  975: sub sec {
  976: 	my ($z) = @_;
  977: 	my $cz = &cos($z);
  978: 	_divbyzero "sec($z)", "cos($z)" if ($cz == 0);
  979: 	return 1 / $cz;
  980: }
  981: 
  982: #
  983: # csc
  984: #
  985: # Computes the cosecant csc(z) = 1 / sin(z).
  986: #
  987: sub csc {
  988: 	my ($z) = @_;
  989: 	my $sz = &sin($z);
  990: 	_divbyzero "csc($z)", "sin($z)" if ($sz == 0);
  991: 	return 1 / $sz;
  992: }
  993: 
  994: #
  995: # cosec
  996: #
  997: # Alias for csc().
  998: #
  999: sub cosec { LONCAPA::LCMathComplex::csc(@_) }
 1000: 
 1001: #
 1002: # cot
 1003: #
 1004: # Computes cot(z) = cos(z) / sin(z).
 1005: #
 1006: sub cot {
 1007: 	my ($z) = @_;
 1008: 	my $sz = &sin($z);
 1009: 	_divbyzero "cot($z)", "sin($z)" if ($sz == 0);
 1010: 	return &cos($z) / $sz;
 1011: }
 1012: 
 1013: #
 1014: # cotan
 1015: #
 1016: # Alias for cot().
 1017: #
 1018: sub cotan { LONCAPA::LCMathComplex::cot(@_) }
 1019: 
 1020: #
 1021: # acos
 1022: #
 1023: # Computes the arc cosine acos(z) = -i log(z + sqrt(z*z-1)).
 1024: #
 1025: sub acos {
 1026: 	my $z = $_[0];
 1027: 	return CORE::atan2(CORE::sqrt(1-$z*$z), $z)
 1028: 	    if (! ref $z) && CORE::abs($z) <= 1;
 1029: 	$z = cplx($z, 0) unless ref $z;
 1030: 	my ($x, $y) = @{$z->_cartesian};
 1031: 	return 0 if $x == 1 && $y == 0;
 1032: 	my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y);
 1033: 	my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y);
 1034: 	my $alpha = ($t1 + $t2)/2;
 1035: 	my $beta  = ($t1 - $t2)/2;
 1036: 	$alpha = 1 if $alpha < 1;
 1037: 	if    ($beta >  1) { $beta =  1 }
 1038: 	elsif ($beta < -1) { $beta = -1 }
 1039: 	my $u = CORE::atan2(CORE::sqrt(1-$beta*$beta), $beta);
 1040: 	my $v = CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
 1041: 	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
 1042: 	return (ref $z)->make($u, $v);
 1043: }
 1044: 
 1045: #
 1046: # asin
 1047: #
 1048: # Computes the arc sine asin(z) = -i log(iz + sqrt(1-z*z)).
 1049: #
 1050: sub asin {
 1051: 	my $z = $_[0];
 1052: 	return CORE::atan2($z, CORE::sqrt(1-$z*$z))
 1053: 	    if (! ref $z) && CORE::abs($z) <= 1;
 1054: 	$z = cplx($z, 0) unless ref $z;
 1055: 	my ($x, $y) = @{$z->_cartesian};
 1056: 	return 0 if $x == 0 && $y == 0;
 1057: 	my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y);
 1058: 	my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y);
 1059: 	my $alpha = ($t1 + $t2)/2;
 1060: 	my $beta  = ($t1 - $t2)/2;
 1061: 	$alpha = 1 if $alpha < 1;
 1062: 	if    ($beta >  1) { $beta =  1 }
 1063: 	elsif ($beta < -1) { $beta = -1 }
 1064: 	my $u =  CORE::atan2($beta, CORE::sqrt(1-$beta*$beta));
 1065: 	my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
 1066: 	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
 1067: 	return (ref $z)->make($u, $v);
 1068: }
 1069: 
 1070: #
 1071: # atan
 1072: #
 1073: # Computes the arc tangent atan(z) = i/2 log((i+z) / (i-z)).
 1074: #
 1075: sub atan {
 1076: 	my ($z) = @_;
 1077: 	return CORE::atan2($z, 1) unless ref $z;
 1078: 	my ($x, $y) = ref $z ? @{$z->_cartesian} : ($z, 0);
 1079: 	return 0 if $x == 0 && $y == 0;
 1080: 	_divbyzero "atan(i)"  if ( $z == i);
 1081: 	_logofzero "atan(-i)" if (-$z == i); # -i is a bad file test...
 1082: 	my $log = &log((i + $z) / (i - $z));
 1083: 	return _ip2 * $log;
 1084: }
 1085: 
 1086: #
 1087: # asec
 1088: #
 1089: # Computes the arc secant asec(z) = acos(1 / z).
 1090: #
 1091: sub asec {
 1092: 	my ($z) = @_;
 1093: 	_divbyzero "asec($z)", $z if ($z == 0);
 1094: 	return acos(1 / $z);
 1095: }
 1096: 
 1097: #
 1098: # acsc
 1099: #
 1100: # Computes the arc cosecant acsc(z) = asin(1 / z).
 1101: #
 1102: sub acsc {
 1103: 	my ($z) = @_;
 1104: 	_divbyzero "acsc($z)", $z if ($z == 0);
 1105: 	return asin(1 / $z);
 1106: }
 1107: 
 1108: #
 1109: # acosec
 1110: #
 1111: # Alias for acsc().
 1112: #
 1113: sub acosec { LONCAPA::LCMathComplex::acsc(@_) }
 1114: 
 1115: #
 1116: # acot
 1117: #
 1118: # Computes the arc cotangent acot(z) = atan(1 / z)
 1119: #
 1120: sub acot {
 1121: 	my ($z) = @_;
 1122: 	_divbyzero "acot(0)"  if $z == 0;
 1123: 	return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z)
 1124: 	    unless ref $z;
 1125: 	_divbyzero "acot(i)"  if ($z - i == 0);
 1126: 	_logofzero "acot(-i)" if ($z + i == 0);
 1127: 	return atan(1 / $z);
 1128: }
 1129: 
 1130: #
 1131: # acotan
 1132: #
 1133: # Alias for acot().
 1134: #
 1135: sub acotan { LONCAPA::LCMathComplex::acot(@_) }
 1136: 
 1137: #
 1138: # cosh
 1139: #
 1140: # Computes the hyperbolic cosine cosh(z) = (exp(z) + exp(-z))/2.
 1141: #
 1142: sub cosh {
 1143: 	my ($z) = @_;
 1144: 	my $ex;
 1145: 	unless (ref $z) {
 1146: 	    $ex = CORE::exp($z);
 1147:             return $ex ? ($ex == $ExpInf ? Inf() : ($ex + 1/$ex)/2) : Inf();
 1148: 	}
 1149: 	my ($x, $y) = @{$z->_cartesian};
 1150: 	$ex = CORE::exp($x);
 1151: 	my $ex_1 = $ex ? 1 / $ex : Inf();
 1152: 	return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2,
 1153: 			      CORE::sin($y) * ($ex - $ex_1)/2);
 1154: }
 1155: 
 1156: #
 1157: # sinh
 1158: #
 1159: # Computes the hyperbolic sine sinh(z) = (exp(z) - exp(-z))/2.
 1160: #
 1161: sub sinh {
 1162: 	my ($z) = @_;
 1163: 	my $ex;
 1164: 	unless (ref $z) {
 1165: 	    return 0 if $z == 0;
 1166: 	    $ex = CORE::exp($z);
 1167:             return $ex ? ($ex == $ExpInf ? Inf() : ($ex - 1/$ex)/2) : -Inf();
 1168: 	}
 1169: 	my ($x, $y) = @{$z->_cartesian};
 1170: 	my $cy = CORE::cos($y);
 1171: 	my $sy = CORE::sin($y);
 1172: 	$ex = CORE::exp($x);
 1173: 	my $ex_1 = $ex ? 1 / $ex : Inf();
 1174: 	return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2,
 1175: 			      CORE::sin($y) * ($ex + $ex_1)/2);
 1176: }
 1177: 
 1178: #
 1179: # tanh
 1180: #
 1181: # Computes the hyperbolic tangent tanh(z) = sinh(z) / cosh(z).
 1182: #
 1183: sub tanh {
 1184: 	my ($z) = @_;
 1185: 	my $cz = cosh($z);
 1186: 	_divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
 1187: 	my $sz = sinh($z);
 1188: 	return  1 if $cz ==  $sz;
 1189: 	return -1 if $cz == -$sz;
 1190: 	return $sz / $cz;
 1191: }
 1192: 
 1193: #
 1194: # sech
 1195: #
 1196: # Computes the hyperbolic secant sech(z) = 1 / cosh(z).
 1197: #
 1198: sub sech {
 1199: 	my ($z) = @_;
 1200: 	my $cz = cosh($z);
 1201: 	_divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
 1202: 	return 1 / $cz;
 1203: }
 1204: 
 1205: #
 1206: # csch
 1207: #
 1208: # Computes the hyperbolic cosecant csch(z) = 1 / sinh(z).
 1209: #
 1210: sub csch {
 1211: 	my ($z) = @_;
 1212: 	my $sz = sinh($z);
 1213: 	_divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
 1214: 	return 1 / $sz;
 1215: }
 1216: 
 1217: #
 1218: # cosech
 1219: #
 1220: # Alias for csch().
 1221: #
 1222: sub cosech { LONCAPA::LCMathComplex::csch(@_) }
 1223: 
 1224: #
 1225: # coth
 1226: #
 1227: # Computes the hyperbolic cotangent coth(z) = cosh(z) / sinh(z).
 1228: #
 1229: sub coth {
 1230: 	my ($z) = @_;
 1231: 	my $sz = sinh($z);
 1232: 	_divbyzero "coth($z)", "sinh($z)" if $sz == 0;
 1233: 	my $cz = cosh($z);
 1234: 	return  1 if $cz ==  $sz;
 1235: 	return -1 if $cz == -$sz;
 1236: 	return $cz / $sz;
 1237: }
 1238: 
 1239: #
 1240: # cotanh
 1241: #
 1242: # Alias for coth().
 1243: #
 1244: sub cotanh { LONCAPA::LCMathComplex::coth(@_) }
 1245: 
 1246: #
 1247: # acosh
 1248: #
 1249: # Computes the area/inverse hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)).
 1250: #
 1251: sub acosh {
 1252: 	my ($z) = @_;
 1253: 	unless (ref $z) {
 1254: 	    $z = cplx($z, 0);
 1255: 	}
 1256: 	my ($re, $im) = @{$z->_cartesian};
 1257: 	if ($im == 0) {
 1258: 	    return CORE::log($re + CORE::sqrt($re*$re - 1))
 1259: 		if $re >= 1;
 1260: 	    return cplx(0, CORE::atan2(CORE::sqrt(1 - $re*$re), $re))
 1261: 		if CORE::abs($re) < 1;
 1262: 	}
 1263: 	my $t = &sqrt($z * $z - 1) + $z;
 1264: 	# Try Taylor if looking bad (this usually means that
 1265: 	# $z was large negative, therefore the sqrt is really
 1266: 	# close to abs(z), summing that with z...)
 1267: 	$t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7)
 1268: 	    if $t == 0;
 1269: 	my $u = &log($t);
 1270: 	$u->Im(-$u->Im) if $re < 0 && $im == 0;
 1271: 	return $re < 0 ? -$u : $u;
 1272: }
 1273: 
 1274: #
 1275: # asinh
 1276: #
 1277: # Computes the area/inverse hyperbolic sine asinh(z) = log(z + sqrt(z*z+1))
 1278: #
 1279: sub asinh {
 1280: 	my ($z) = @_;
 1281: 	unless (ref $z) {
 1282: 	    my $t = $z + CORE::sqrt($z*$z + 1);
 1283: 	    return CORE::log($t) if $t;
 1284: 	}
 1285: 	my $t = &sqrt($z * $z + 1) + $z;
 1286: 	# Try Taylor if looking bad (this usually means that
 1287: 	# $z was large negative, therefore the sqrt is really
 1288: 	# close to abs(z), summing that with z...)
 1289: 	$t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7)
 1290: 	    if $t == 0;
 1291: 	return &log($t);
 1292: }
 1293: 
 1294: #
 1295: # atanh
 1296: #
 1297: # Computes the area/inverse hyperbolic tangent atanh(z) = 1/2 log((1+z) / (1-z)).
 1298: #
 1299: sub atanh {
 1300: 	my ($z) = @_;
 1301: 	unless (ref $z) {
 1302: 	    return CORE::log((1 + $z)/(1 - $z))/2 if CORE::abs($z) < 1;
 1303: 	    $z = cplx($z, 0);
 1304: 	}
 1305: 	_divbyzero 'atanh(1)',  "1 - $z" if (1 - $z == 0);
 1306: 	_logofzero 'atanh(-1)'           if (1 + $z == 0);
 1307: 	return 0.5 * &log((1 + $z) / (1 - $z));
 1308: }
 1309: 
 1310: #
 1311: # asech
 1312: #
 1313: # Computes the area/inverse hyperbolic secant asech(z) = acosh(1 / z).
 1314: #
 1315: sub asech {
 1316: 	my ($z) = @_;
 1317: 	_divbyzero 'asech(0)', "$z" if ($z == 0);
 1318: 	return acosh(1 / $z);
 1319: }
 1320: 
 1321: #
 1322: # acsch
 1323: #
 1324: # Computes the area/inverse hyperbolic cosecant acsch(z) = asinh(1 / z).
 1325: #
 1326: sub acsch {
 1327: 	my ($z) = @_;
 1328: 	_divbyzero 'acsch(0)', $z if ($z == 0);
 1329: 	return asinh(1 / $z);
 1330: }
 1331: 
 1332: #
 1333: # acosech
 1334: #
 1335: # Alias for acosh().
 1336: #
 1337: sub acosech { LONCAPA::LCMathComplex::acsch(@_) }
 1338: 
 1339: #
 1340: # acoth
 1341: #
 1342: # Computes the area/inverse hyperbolic cotangent acoth(z) = 1/2 log((1+z) / (z-1)).
 1343: #
 1344: sub acoth {
 1345: 	my ($z) = @_;
 1346: 	_divbyzero 'acoth(0)'            if ($z == 0);
 1347: 	unless (ref $z) {
 1348: 	    return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1;
 1349: 	    $z = cplx($z, 0);
 1350: 	}
 1351: 	_divbyzero 'acoth(1)',  "$z - 1" if ($z - 1 == 0);
 1352: 	_logofzero 'acoth(-1)', "1 + $z" if (1 + $z == 0);
 1353: 	return &log((1 + $z) / ($z - 1)) / 2;
 1354: }
 1355: 
 1356: #
 1357: # acotanh
 1358: #
 1359: # Alias for acot().
 1360: #
 1361: sub acotanh { LONCAPA::LCMathComplex::acoth(@_) }
 1362: 
 1363: #
 1364: # (atan2)
 1365: #
 1366: # Compute atan(z1/z2), minding the right quadrant.
 1367: #
 1368: sub atan2 {
 1369: 	my ($z1, $z2, $inverted) = @_;
 1370: 	my ($re1, $im1, $re2, $im2);
 1371: 	if ($inverted) {
 1372: 	    ($re1, $im1) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
 1373: 	    ($re2, $im2) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
 1374: 	} else {
 1375: 	    ($re1, $im1) = ref $z1 ? @{$z1->_cartesian} : ($z1, 0);
 1376: 	    ($re2, $im2) = ref $z2 ? @{$z2->_cartesian} : ($z2, 0);
 1377: 	}
 1378: 	if ($im1 || $im2) {
 1379: 	    # In MATLAB the imaginary parts are ignored.
 1380: 	    # warn "atan2: Imaginary parts ignored";
 1381: 	    # http://documents.wolfram.com/mathematica/functions/ArcTan
 1382: 	    # NOTE: Mathematica ArcTan[x,y] while atan2(y,x)
 1383: 	    my $s = $z1 * $z1 + $z2 * $z2;
 1384: 	    _divbyzero("atan2") if $s == 0;
 1385: 	    my $i = &i;
 1386: 	    my $r = $z2 + $z1 * $i;
 1387: 	    return -$i * &log($r / &sqrt( $s ));
 1388: 	}
 1389: 	return CORE::atan2($re1, $re2);
 1390: }
 1391: 
 1392: #
 1393: # display_format
 1394: # ->display_format
 1395: #
 1396: # Set (get if no argument) the display format for all complex numbers that
 1397: # don't happen to have overridden it via ->display_format
 1398: #
 1399: # When called as an object method, this actually sets the display format for
 1400: # the current object.
 1401: #
 1402: # Valid object formats are 'c' and 'p' for cartesian and polar. The first
 1403: # letter is used actually, so the type can be fully spelled out for clarity.
 1404: #
 1405: sub display_format {
 1406: 	my $self  = shift;
 1407: 	my %display_format = %DISPLAY_FORMAT;
 1408: 
 1409: 	if (ref $self) {			# Called as an object method
 1410: 	    if (exists $self->{display_format}) {
 1411: 		my %obj = %{$self->{display_format}};
 1412: 		@display_format{keys %obj} = values %obj;
 1413: 	    }
 1414: 	}
 1415: 	if (@_ == 1) {
 1416: 	    $display_format{style} = shift;
 1417: 	} else {
 1418: 	    my %new = @_;
 1419: 	    @display_format{keys %new} = values %new;
 1420: 	}
 1421: 
 1422: 	if (ref $self) { # Called as an object method
 1423: 	    $self->{display_format} = { %display_format };
 1424: 	    return
 1425: 		wantarray ?
 1426: 		    %{$self->{display_format}} :
 1427: 		    $self->{display_format}->{style};
 1428: 	}
 1429: 
 1430:         # Called as a class method
 1431: 	%DISPLAY_FORMAT = %display_format;
 1432: 	return
 1433: 	    wantarray ?
 1434: 		%DISPLAY_FORMAT :
 1435: 		    $DISPLAY_FORMAT{style};
 1436: }
 1437: 
 1438: #
 1439: # (_stringify)
 1440: #
 1441: # Show nicely formatted complex number under its cartesian or polar form,
 1442: # depending on the current display format:
 1443: #
 1444: # . If a specific display format has been recorded for this object, use it.
 1445: # . Otherwise, use the generic current default for all complex numbers,
 1446: #   which is a package global variable.
 1447: #
 1448: sub _stringify {
 1449: 	my ($z) = shift;
 1450: 
 1451: 	my $style = $z->display_format;
 1452: 
 1453: 	$style = $DISPLAY_FORMAT{style} unless defined $style;
 1454: 
 1455: 	return $z->_stringify_polar if $style =~ /^p/i;
 1456: 	return $z->_stringify_cartesian;
 1457: }
 1458: 
 1459: #
 1460: # ->_stringify_cartesian
 1461: #
 1462: # Stringify as a cartesian representation 'a+bi'.
 1463: #
 1464: sub _stringify_cartesian {
 1465: 	my $z  = shift;
 1466: 	my ($x, $y) = @{$z->_cartesian};
 1467: 	my ($re, $im);
 1468: 
 1469: 	my %format = $z->display_format;
 1470: 	my $format = $format{format};
 1471: 
 1472: 	if ($x) {
 1473: 	    if ($x =~ /^NaN[QS]?$/i) {
 1474: 		$re = $x;
 1475: 	    } else {
 1476: 		if ($x =~ /^-?\Q$Inf\E$/oi) {
 1477: 		    $re = $x;
 1478: 		} else {
 1479: 		    $re = defined $format ? sprintf($format, $x) : $x;
 1480: 		}
 1481: 	    }
 1482: 	} else {
 1483: 	    undef $re;
 1484: 	}
 1485: 
 1486: 	if ($y) {
 1487: 	    if ($y =~ /^(NaN[QS]?)$/i) {
 1488: 		$im = $y;
 1489: 	    } else {
 1490: 		if ($y =~ /^-?\Q$Inf\E$/oi) {
 1491: 		    $im = $y;
 1492: 		} else {
 1493: 		    $im =
 1494: 			defined $format ?
 1495: 			    sprintf($format, $y) :
 1496: 			    ($y == 1 ? "" : ($y == -1 ? "-" : $y));
 1497: 		}
 1498: 	    }
 1499: 	    $im .= "i";
 1500: 	} else {
 1501: 	    undef $im;
 1502: 	}
 1503: 
 1504: 	my $str = $re;
 1505: 
 1506: 	if (defined $im) {
 1507: 	    if ($y < 0) {
 1508: 		$str .= $im;
 1509: 	    } elsif ($y > 0 || $im =~ /^NaN[QS]?i$/i)  {
 1510: 		$str .= "+" if defined $re;
 1511: 		$str .= $im;
 1512: 	    }
 1513: 	} elsif (!defined $re) {
 1514: 	    $str = "0";
 1515: 	}
 1516: 
 1517: 	return $str;
 1518: }
 1519: 
 1520: 
 1521: #
 1522: # ->_stringify_polar
 1523: #
 1524: # Stringify as a polar representation '[r,t]'.
 1525: #
 1526: sub _stringify_polar {
 1527: 	my $z  = shift;
 1528: 	my ($r, $t) = @{$z->_polar};
 1529: 	my $theta;
 1530: 
 1531: 	my %format = $z->display_format;
 1532: 	my $format = $format{format};
 1533: 
 1534: 	if ($t =~ /^NaN[QS]?$/i || $t =~ /^-?\Q$Inf\E$/oi) {
 1535: 	    $theta = $t; 
 1536: 	} elsif ($t == pi) {
 1537: 	    $theta = "pi";
 1538: 	} elsif ($r == 0 || $t == 0) {
 1539: 	    $theta = defined $format ? sprintf($format, $t) : $t;
 1540: 	}
 1541: 
 1542: 	return "[$r,$theta]" if defined $theta;
 1543: 
 1544: 	#
 1545: 	# Try to identify pi/n and friends.
 1546: 	#
 1547: 
 1548: 	$t -= int(CORE::abs($t) / pi2) * pi2;
 1549: 
 1550: 	if ($format{polar_pretty_print} && $t) {
 1551: 	    my ($a, $b);
 1552: 	    for $a (2..9) {
 1553: 		$b = $t * $a / pi;
 1554: 		if ($b =~ /^-?\d+$/) {
 1555: 		    $b = $b < 0 ? "-" : "" if CORE::abs($b) == 1;
 1556: 		    $theta = "${b}pi/$a";
 1557: 		    last;
 1558: 		}
 1559: 	    }
 1560: 	}
 1561: 
 1562:         if (defined $format) {
 1563: 	    $r     = sprintf($format, $r);
 1564: 	    $theta = sprintf($format, $t) unless defined $theta;
 1565: 	} else {
 1566: 	    $theta = $t unless defined $theta;
 1567: 	}
 1568: 
 1569: 	return "[$r,$theta]";
 1570: }
 1571: 
 1572: sub Inf {
 1573:     return $Inf;
 1574: }
 1575: 
 1576: 1;
 1577: __END__
 1578: 
 1579: =pod
 1580: 
 1581: =head1 NAME
 1582: 
 1583: LONCAPA::LCMathComplex - complex numbers and associated mathematical functions
 1584: 
 1585: =head1 SYNOPSIS
 1586: 
 1587: 	use LONCAPA::LCMathComplex;
 1588: 
 1589: 	$z = LONCAPA::LCMathComplex->make(5, 6);
 1590: 	$t = 4 - 3*i + $z;
 1591: 	$j = cplxe(1, 2*pi/3);
 1592: 
 1593: =head1 DESCRIPTION
 1594: 
 1595: Derived from Math::Complex.
 1596: 
 1597: Modified for use in Safe Space in LON-CAPA by removing the dependency on
 1598: Config.pm introduced in rev. 1.51 (which contains calls that are disallowed
 1599: in Safe Space).  In addition, Scalar::Util::set_prototype() is not used for
 1600: abs(), cos(), exp(), log(), sin(), and sqrt(), to avoid warnings in logs:
 1601: of type: "Use of uninitialized value" (Config.pm line 62).
 1602: 
 1603: In this LON-CAPA-specific version, the following code changes were made.
 1604: 
 1605: 15,16d17
 1606: < use Config;
 1607: < 
 1608: 49,51c50
 1609: <     my $nvsize = $Config{nvsize} ||
 1610: <               ($Config{uselongdouble} && $Config{longdblsize}) ||
 1611: <                  $Config{doublesize};
 1612: ---
 1613: >     my $nvsize = 8;
 1614: 
 1615: 91,92d89
 1616: < use Scalar::Util qw(set_prototype);
 1617: < 
 1618: 96,109d92
 1619: < BEGIN {
 1620: <     # For certain functions that we override, in 5.10 or better
 1621: <     # we can set a smarter prototype that will handle the lexical $_
 1622: <     # (also a 5.10+ feature).
 1623: <     if ($] >= 5.010000) {
 1624: <         set_prototype \&abs, '_';
 1625: <         set_prototype \&cos, '_';
 1626: <         set_prototype \&exp, '_';
 1627: <         set_prototype \&log, '_';
 1628: <         set_prototype \&sin, '_';
 1629: <         set_prototype \&sqrt, '_';
 1630: <     }
 1631: < }
 1632: 
 1633: Note: the value assigned to $nvsize is 8 by default.
 1634: 
 1635: Whenever ./UPDATE is run to install or update LON-CAPA, the code which
 1636: sets $nvsize in the standard Math::Complex script will be run in
 1637: LCMathComplex_check.piml and the value of $nvsize will be set to the
 1638: appropriate value: 4, 8, 10, 12 or 16.
 1639: 
 1640: In addition all instances referring to Math::Complex were changed to
 1641: refer to LONCAPA::LCMathComplex instead.
 1642: 
 1643: This package lets you create and manipulate complex numbers. By default,
 1644: I<Perl> limits itself to real numbers, but an extra C<use> statement brings
 1645: full complex support, along with a full set of mathematical functions
 1646: typically associated with and/or extended to complex numbers.
 1647: 
 1648: If you wonder what complex numbers are, they were invented to be able to solve
 1649: the following equation:
 1650: 
 1651: 	x*x = -1
 1652: 
 1653: and by definition, the solution is noted I<i> (engineers use I<j> instead since
 1654: I<i> usually denotes an intensity, but the name does not matter). The number
 1655: I<i> is a pure I<imaginary> number.
 1656: 
 1657: The arithmetics with pure imaginary numbers works just like you would expect
 1658: it with real numbers... you just have to remember that
 1659: 
 1660: 	i*i = -1
 1661: 
 1662: so you have:
 1663: 
 1664: 	5i + 7i = i * (5 + 7) = 12i
 1665: 	4i - 3i = i * (4 - 3) = i
 1666: 	4i * 2i = -8
 1667: 	6i / 2i = 3
 1668: 	1 / i = -i
 1669: 
 1670: Complex numbers are numbers that have both a real part and an imaginary
 1671: part, and are usually noted:
 1672: 
 1673: 	a + bi
 1674: 
 1675: where C<a> is the I<real> part and C<b> is the I<imaginary> part. The
 1676: arithmetic with complex numbers is straightforward. You have to
 1677: keep track of the real and the imaginary parts, but otherwise the
 1678: rules used for real numbers just apply:
 1679: 
 1680: 	(4 + 3i) + (5 - 2i) = (4 + 5) + i(3 - 2) = 9 + i
 1681: 	(2 + i) * (4 - i) = 2*4 + 4i -2i -i*i = 8 + 2i + 1 = 9 + 2i
 1682: 
 1683: A graphical representation of complex numbers is possible in a plane
 1684: (also called the I<complex plane>, but it's really a 2D plane).
 1685: The number
 1686: 
 1687: 	z = a + bi
 1688: 
 1689: is the point whose coordinates are (a, b). Actually, it would
 1690: be the vector originating from (0, 0) to (a, b). It follows that the addition
 1691: of two complex numbers is a vectorial addition.
 1692: 
 1693: Since there is a bijection between a point in the 2D plane and a complex
 1694: number (i.e. the mapping is unique and reciprocal), a complex number
 1695: can also be uniquely identified with polar coordinates:
 1696: 
 1697: 	[rho, theta]
 1698: 
 1699: where C<rho> is the distance to the origin, and C<theta> the angle between
 1700: the vector and the I<x> axis. There is a notation for this using the
 1701: exponential form, which is:
 1702: 
 1703: 	rho * exp(i * theta)
 1704: 
 1705: where I<i> is the famous imaginary number introduced above. Conversion
 1706: between this form and the cartesian form C<a + bi> is immediate:
 1707: 
 1708: 	a = rho * cos(theta)
 1709: 	b = rho * sin(theta)
 1710: 
 1711: which is also expressed by this formula:
 1712: 
 1713: 	z = rho * exp(i * theta) = rho * (cos theta + i * sin theta)
 1714: 
 1715: In other words, it's the projection of the vector onto the I<x> and I<y>
 1716: axes. Mathematicians call I<rho> the I<norm> or I<modulus> and I<theta>
 1717: the I<argument> of the complex number. The I<norm> of C<z> is
 1718: marked here as C<abs(z)>.
 1719: 
 1720: The polar notation (also known as the trigonometric representation) is
 1721: much more handy for performing multiplications and divisions of
 1722: complex numbers, whilst the cartesian notation is better suited for
 1723: additions and subtractions. Real numbers are on the I<x> axis, and
 1724: therefore I<y> or I<theta> is zero or I<pi>.
 1725: 
 1726: All the common operations that can be performed on a real number have
 1727: been defined to work on complex numbers as well, and are merely
 1728: I<extensions> of the operations defined on real numbers. This means
 1729: they keep their natural meaning when there is no imaginary part, provided
 1730: the number is within their definition set.
 1731: 
 1732: For instance, the C<sqrt> routine which computes the square root of
 1733: its argument is only defined for non-negative real numbers and yields a
 1734: non-negative real number (it is an application from B<R+> to B<R+>).
 1735: If we allow it to return a complex number, then it can be extended to
 1736: negative real numbers to become an application from B<R> to B<C> (the
 1737: set of complex numbers):
 1738: 
 1739: 	sqrt(x) = x >= 0 ? sqrt(x) : sqrt(-x)*i
 1740: 
 1741: It can also be extended to be an application from B<C> to B<C>,
 1742: whilst its restriction to B<R> behaves as defined above by using
 1743: the following definition:
 1744: 
 1745: 	sqrt(z = [r,t]) = sqrt(r) * exp(i * t/2)
 1746: 
 1747: Indeed, a negative real number can be noted C<[x,pi]> (the modulus
 1748: I<x> is always non-negative, so C<[x,pi]> is really C<-x>, a negative
 1749: number) and the above definition states that
 1750: 
 1751: 	sqrt([x,pi]) = sqrt(x) * exp(i*pi/2) = [sqrt(x),pi/2] = sqrt(x)*i
 1752: 
 1753: which is exactly what we had defined for negative real numbers above.
 1754: The C<sqrt> returns only one of the solutions: if you want the both,
 1755: use the C<root> function.
 1756: 
 1757: All the common mathematical functions defined on real numbers that
 1758: are extended to complex numbers share that same property of working
 1759: I<as usual> when the imaginary part is zero (otherwise, it would not
 1760: be called an extension, would it?).
 1761: 
 1762: A I<new> operation possible on a complex number that is
 1763: the identity for real numbers is called the I<conjugate>, and is noted
 1764: with a horizontal bar above the number, or C<~z> here.
 1765: 
 1766: 	 z = a + bi
 1767: 	~z = a - bi
 1768: 
 1769: Simple... Now look:
 1770: 
 1771: 	z * ~z = (a + bi) * (a - bi) = a*a + b*b
 1772: 
 1773: We saw that the norm of C<z> was noted C<abs(z)> and was defined as the
 1774: distance to the origin, also known as:
 1775: 
 1776: 	rho = abs(z) = sqrt(a*a + b*b)
 1777: 
 1778: so
 1779: 
 1780: 	z * ~z = abs(z) ** 2
 1781: 
 1782: If z is a pure real number (i.e. C<b == 0>), then the above yields:
 1783: 
 1784: 	a * a = abs(a) ** 2
 1785: 
 1786: which is true (C<abs> has the regular meaning for real number, i.e. stands
 1787: for the absolute value). This example explains why the norm of C<z> is
 1788: noted C<abs(z)>: it extends the C<abs> function to complex numbers, yet
 1789: is the regular C<abs> we know when the complex number actually has no
 1790: imaginary part... This justifies I<a posteriori> our use of the C<abs>
 1791: notation for the norm.
 1792: 
 1793: =head1 OPERATIONS
 1794: 
 1795: Given the following notations:
 1796: 
 1797: 	z1 = a + bi = r1 * exp(i * t1)
 1798: 	z2 = c + di = r2 * exp(i * t2)
 1799: 	z = <any complex or real number>
 1800: 
 1801: the following (overloaded) operations are supported on complex numbers:
 1802: 
 1803: 	z1 + z2 = (a + c) + i(b + d)
 1804: 	z1 - z2 = (a - c) + i(b - d)
 1805: 	z1 * z2 = (r1 * r2) * exp(i * (t1 + t2))
 1806: 	z1 / z2 = (r1 / r2) * exp(i * (t1 - t2))
 1807: 	z1 ** z2 = exp(z2 * log z1)
 1808: 	~z = a - bi
 1809: 	abs(z) = r1 = sqrt(a*a + b*b)
 1810: 	sqrt(z) = sqrt(r1) * exp(i * t/2)
 1811: 	exp(z) = exp(a) * exp(i * b)
 1812: 	log(z) = log(r1) + i*t
 1813: 	sin(z) = 1/2i (exp(i * z1) - exp(-i * z))
 1814: 	cos(z) = 1/2 (exp(i * z1) + exp(-i * z))
 1815: 	atan2(y, x) = atan(y / x) # Minding the right quadrant, note the order.
 1816: 
 1817: The definition used for complex arguments of atan2() is
 1818: 
 1819:        -i log((x + iy)/sqrt(x*x+y*y))
 1820: 
 1821: Note that atan2(0, 0) is not well-defined.
 1822: 
 1823: The following extra operations are supported on both real and complex
 1824: numbers:
 1825: 
 1826: 	Re(z) = a
 1827: 	Im(z) = b
 1828: 	arg(z) = t
 1829: 	abs(z) = r
 1830: 
 1831: 	cbrt(z) = z ** (1/3)
 1832: 	log10(z) = log(z) / log(10)
 1833: 	logn(z, n) = log(z) / log(n)
 1834: 
 1835: 	tan(z) = sin(z) / cos(z)
 1836: 
 1837: 	csc(z) = 1 / sin(z)
 1838: 	sec(z) = 1 / cos(z)
 1839: 	cot(z) = 1 / tan(z)
 1840: 
 1841: 	asin(z) = -i * log(i*z + sqrt(1-z*z))
 1842: 	acos(z) = -i * log(z + i*sqrt(1-z*z))
 1843: 	atan(z) = i/2 * log((i+z) / (i-z))
 1844: 
 1845: 	acsc(z) = asin(1 / z)
 1846: 	asec(z) = acos(1 / z)
 1847: 	acot(z) = atan(1 / z) = -i/2 * log((i+z) / (z-i))
 1848: 
 1849: 	sinh(z) = 1/2 (exp(z) - exp(-z))
 1850: 	cosh(z) = 1/2 (exp(z) + exp(-z))
 1851: 	tanh(z) = sinh(z) / cosh(z) = (exp(z) - exp(-z)) / (exp(z) + exp(-z))
 1852: 
 1853: 	csch(z) = 1 / sinh(z)
 1854: 	sech(z) = 1 / cosh(z)
 1855: 	coth(z) = 1 / tanh(z)
 1856: 
 1857: 	asinh(z) = log(z + sqrt(z*z+1))
 1858: 	acosh(z) = log(z + sqrt(z*z-1))
 1859: 	atanh(z) = 1/2 * log((1+z) / (1-z))
 1860: 
 1861: 	acsch(z) = asinh(1 / z)
 1862: 	asech(z) = acosh(1 / z)
 1863: 	acoth(z) = atanh(1 / z) = 1/2 * log((1+z) / (z-1))
 1864: 
 1865: I<arg>, I<abs>, I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>,
 1866: I<coth>, I<acosech>, I<acotanh>, have aliases I<rho>, I<theta>, I<ln>,
 1867: I<cosec>, I<cotan>, I<acosec>, I<acotan>, I<cosech>, I<cotanh>,
 1868: I<acosech>, I<acotanh>, respectively.  C<Re>, C<Im>, C<arg>, C<abs>,
 1869: C<rho>, and C<theta> can be used also as mutators.  The C<cbrt>
 1870: returns only one of the solutions: if you want all three, use the
 1871: C<root> function.
 1872: 
 1873: The I<root> function is available to compute all the I<n>
 1874: roots of some complex, where I<n> is a strictly positive integer.
 1875: There are exactly I<n> such roots, returned as a list. Getting the
 1876: number mathematicians call C<j> such that:
 1877: 
 1878: 	1 + j + j*j = 0;
 1879: 
 1880: is a simple matter of writing:
 1881: 
 1882: 	$j = ((root(1, 3))[1];
 1883: 
 1884: The I<k>th root for C<z = [r,t]> is given by:
 1885: 
 1886: 	(root(z, n))[k] = r**(1/n) * exp(i * (t + 2*k*pi)/n)
 1887: 
 1888: You can return the I<k>th root directly by C<root(z, n, k)>,
 1889: indexing starting from I<zero> and ending at I<n - 1>.
 1890: 
 1891: The I<spaceship> numeric comparison operator, E<lt>=E<gt>, is also
 1892: defined. In order to ensure its restriction to real numbers is conform
 1893: to what you would expect, the comparison is run on the real part of
 1894: the complex number first, and imaginary parts are compared only when
 1895: the real parts match.
 1896: 
 1897: =head1 CREATION
 1898: 
 1899: To create a complex number, use either:
 1900: 
 1901: 	$z = LONCAPA::LCMathComplex->make(3, 4);
 1902: 	$z = cplx(3, 4);
 1903: 
 1904: if you know the cartesian form of the number, or
 1905: 
 1906: 	$z = 3 + 4*i;
 1907: 
 1908: if you like. To create a number using the polar form, use either:
 1909: 
 1910: 	$z = LONCAPA::LCMathComplex->emake(5, pi/3);
 1911: 	$x = cplxe(5, pi/3);
 1912: 
 1913: instead. The first argument is the modulus, the second is the angle
 1914: (in radians, the full circle is 2*pi).  (Mnemonic: C<e> is used as a
 1915: notation for complex numbers in the polar form).
 1916: 
 1917: It is possible to write:
 1918: 
 1919: 	$x = cplxe(-3, pi/4);
 1920: 
 1921: but that will be silently converted into C<[3,-3pi/4]>, since the
 1922: modulus must be non-negative (it represents the distance to the origin
 1923: in the complex plane).
 1924: 
 1925: It is also possible to have a complex number as either argument of the
 1926: C<make>, C<emake>, C<cplx>, and C<cplxe>: the appropriate component of
 1927: the argument will be used.
 1928: 
 1929: 	$z1 = cplx(-2,  1);
 1930: 	$z2 = cplx($z1, 4);
 1931: 
 1932: The C<new>, C<make>, C<emake>, C<cplx>, and C<cplxe> will also
 1933: understand a single (string) argument of the forms
 1934: 
 1935:     	2-3i
 1936:     	-3i
 1937: 	[2,3]
 1938: 	[2,-3pi/4]
 1939: 	[2]
 1940: 
 1941: in which case the appropriate cartesian and exponential components
 1942: will be parsed from the string and used to create new complex numbers.
 1943: The imaginary component and the theta, respectively, will default to zero.
 1944: 
 1945: The C<new>, C<make>, C<emake>, C<cplx>, and C<cplxe> will also
 1946: understand the case of no arguments: this means plain zero or (0, 0).
 1947: 
 1948: =head1 DISPLAYING
 1949: 
 1950: When printed, a complex number is usually shown under its cartesian
 1951: style I<a+bi>, but there are legitimate cases where the polar style
 1952: I<[r,t]> is more appropriate.  The process of converting the complex
 1953: number into a string that can be displayed is known as I<stringification>.
 1954: 
 1955: By calling the class method C<LONCAPA::LCMathComplex::display_format> and
 1956: supplying either C<"polar"> or C<"cartesian"> as an argument, you
 1957: override the default display style, which is C<"cartesian">. Not
 1958: supplying any argument returns the current settings.
 1959: 
 1960: This default can be overridden on a per-number basis by calling the
 1961: C<display_format> method instead. As before, not supplying any argument
 1962: returns the current display style for this number. Otherwise whatever you
 1963: specify will be the new display style for I<this> particular number.
 1964: 
 1965: For instance:
 1966: 
 1967: 	use LONCAPA::LCMathComplex;
 1968: 
 1969: 	LONCAPA::LCMathComplex::display_format('polar');
 1970: 	$j = (root(1, 3))[1];
 1971: 	print "j = $j\n";		# Prints "j = [1,2pi/3]"
 1972: 	$j->display_format('cartesian');
 1973: 	print "j = $j\n";		# Prints "j = -0.5+0.866025403784439i"
 1974: 
 1975: The polar style attempts to emphasize arguments like I<k*pi/n>
 1976: (where I<n> is a positive integer and I<k> an integer within [-9, +9]),
 1977: this is called I<polar pretty-printing>.
 1978: 
 1979: For the reverse of stringifying, see the C<make> and C<emake>.
 1980: 
 1981: =head2 CHANGED IN PERL 5.6
 1982: 
 1983: The C<display_format> class method and the corresponding
 1984: C<display_format> object method can now be called using
 1985: a parameter hash instead of just a one parameter.
 1986: 
 1987: The old display format style, which can have values C<"cartesian"> or
 1988: C<"polar">, can be changed using the C<"style"> parameter.
 1989: 
 1990: 	$j->display_format(style => "polar");
 1991: 
 1992: The one parameter calling convention also still works.
 1993: 
 1994: 	$j->display_format("polar");
 1995: 
 1996: There are two new display parameters.
 1997: 
 1998: The first one is C<"format">, which is a sprintf()-style format string
 1999: to be used for both numeric parts of the complex number(s).  The is
 2000: somewhat system-dependent but most often it corresponds to C<"%.15g">.
 2001: You can revert to the default by setting the C<format> to C<undef>.
 2002: 
 2003: 	# the $j from the above example
 2004: 
 2005: 	$j->display_format('format' => '%.5f');
 2006: 	print "j = $j\n";		# Prints "j = -0.50000+0.86603i"
 2007: 	$j->display_format('format' => undef);
 2008: 	print "j = $j\n";		# Prints "j = -0.5+0.86603i"
 2009: 
 2010: Notice that this affects also the return values of the
 2011: C<display_format> methods: in list context the whole parameter hash
 2012: will be returned, as opposed to only the style parameter value.
 2013: This is a potential incompatibility with earlier versions if you
 2014: have been calling the C<display_format> method in list context.
 2015: 
 2016: The second new display parameter is C<"polar_pretty_print">, which can
 2017: be set to true or false, the default being true.  See the previous
 2018: section for what this means.
 2019: 
 2020: =head1 USAGE
 2021: 
 2022: Thanks to overloading, the handling of arithmetics with complex numbers
 2023: is simple and almost transparent.
 2024: 
 2025: Here are some examples:
 2026: 
 2027: 	use LONCAPA::LCMathComplex;
 2028: 
 2029: 	$j = cplxe(1, 2*pi/3);	# $j ** 3 == 1
 2030: 	print "j = $j, j**3 = ", $j ** 3, "\n";
 2031: 	print "1 + j + j**2 = ", 1 + $j + $j**2, "\n";
 2032: 
 2033: 	$z = -16 + 0*i;			# Force it to be a complex
 2034: 	print "sqrt($z) = ", sqrt($z), "\n";
 2035: 
 2036: 	$k = exp(i * 2*pi/3);
 2037: 	print "$j - $k = ", $j - $k, "\n";
 2038: 
 2039: 	$z->Re(3);			# Re, Im, arg, abs,
 2040: 	$j->arg(2);			# (the last two aka rho, theta)
 2041: 					# can be used also as mutators.
 2042: 
 2043: =head1 CONSTANTS
 2044: 
 2045: =head2 PI
 2046: 
 2047: The constant C<pi> and some handy multiples of it (pi2, pi4,
 2048: and pip2 (pi/2) and pip4 (pi/4)) are also available if separately
 2049: exported:
 2050: 
 2051:     use LONCAPA::LCMathComplex ':pi'; 
 2052:     $third_of_circle = pi2 / 3;
 2053: 
 2054: =head2 Inf
 2055: 
 2056: The floating point infinity can be exported as a subroutine Inf():
 2057: 
 2058:     use LONCAPA::LCMathComplex qw(Inf sinh);
 2059:     my $AlsoInf = Inf() + 42;
 2060:     my $AnotherInf = sinh(1e42);
 2061:     print "$AlsoInf is $AnotherInf\n" if $AlsoInf == $AnotherInf;
 2062: 
 2063: Note that the stringified form of infinity varies between platforms:
 2064: it can be for example any of
 2065: 
 2066:    inf
 2067:    infinity
 2068:    INF
 2069:    1.#INF
 2070: 
 2071: or it can be something else. 
 2072: 
 2073: Also note that in some platforms trying to use the infinity in
 2074: arithmetic operations may result in Perl crashing because using
 2075: an infinity causes SIGFPE or its moral equivalent to be sent.
 2076: The way to ignore this is
 2077: 
 2078:   local $SIG{FPE} = sub { };
 2079: 
 2080: =head1 ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO
 2081: 
 2082: The division (/) and the following functions
 2083: 
 2084: 	log	ln	log10	logn
 2085: 	tan	sec	csc	cot
 2086: 	atan	asec	acsc	acot
 2087: 	tanh	sech	csch	coth
 2088: 	atanh	asech	acsch	acoth
 2089: 
 2090: cannot be computed for all arguments because that would mean dividing
 2091: by zero or taking logarithm of zero. These situations cause fatal
 2092: runtime errors looking like this
 2093: 
 2094: 	cot(0): Division by zero.
 2095: 	(Because in the definition of cot(0), the divisor sin(0) is 0)
 2096: 	Died at ...
 2097: 
 2098: or
 2099: 
 2100: 	atanh(-1): Logarithm of zero.
 2101: 	Died at...
 2102: 
 2103: For the C<csc>, C<cot>, C<asec>, C<acsc>, C<acot>, C<csch>, C<coth>,
 2104: C<asech>, C<acsch>, the argument cannot be C<0> (zero).  For the
 2105: logarithmic functions and the C<atanh>, C<acoth>, the argument cannot
 2106: be C<1> (one).  For the C<atanh>, C<acoth>, the argument cannot be
 2107: C<-1> (minus one).  For the C<atan>, C<acot>, the argument cannot be
 2108: C<i> (the imaginary unit).  For the C<atan>, C<acoth>, the argument
 2109: cannot be C<-i> (the negative imaginary unit).  For the C<tan>,
 2110: C<sec>, C<tanh>, the argument cannot be I<pi/2 + k * pi>, where I<k>
 2111: is any integer.  atan2(0, 0) is undefined, and if the complex arguments
 2112: are used for atan2(), a division by zero will happen if z1**2+z2**2 == 0.
 2113: 
 2114: Note that because we are operating on approximations of real numbers,
 2115: these errors can happen when merely `too close' to the singularities
 2116: listed above.
 2117: 
 2118: =head1 ERRORS DUE TO INDIGESTIBLE ARGUMENTS
 2119: 
 2120: The C<make> and C<emake> accept both real and complex arguments.
 2121: When they cannot recognize the arguments they will die with error
 2122: messages like the following
 2123: 
 2124:     LONCAPA::LCMathComplex::make: Cannot take real part of ...
 2125:     LONCAPA::LCMathComplex::make: Cannot take real part of ...
 2126:     LONCAPA::LCMathComplex::emake: Cannot take rho of ...
 2127:     LONCAPA::LCMathComplex::emake: Cannot take theta of ...
 2128: 
 2129: =head1 BUGS
 2130: 
 2131: Saying C<use LONCAPA::LCMathComplex;> exports many mathematical routines in the
 2132: caller environment and even overrides some (C<sqrt>, C<log>, C<atan2>).
 2133: This is construed as a feature by the Authors, actually... ;-)
 2134: 
 2135: All routines expect to be given real or complex numbers. Don't attempt to
 2136: use BigFloat, since Perl has currently no rule to disambiguate a '+'
 2137: operation (for instance) between two overloaded entities.
 2138: 
 2139: In Cray UNICOS there is some strange numerical instability that results
 2140: in root(), cos(), sin(), cosh(), sinh(), losing accuracy fast.  Beware.
 2141: The bug may be in UNICOS math libs, in UNICOS C compiler, in LONCAPA::LCMathComplex.
 2142: Whatever it is, it does not manifest itself anywhere else where Perl runs.
 2143: 
 2144: =head1 SEE ALSO
 2145: 
 2146: L<Math::Trig>
 2147: 
 2148: =head1 AUTHORS
 2149: 
 2150: Daniel S. Lewart <F<lewart!at!uiuc.edu>>,
 2151: Jarkko Hietaniemi <F<jhi!at!iki.fi>>,
 2152: Raphael Manfredi <F<Raphael_Manfredi!at!pobox.com>>,
 2153: Zefram <zefram@fysh.org>
 2154: 
 2155: =head1 LICENSE
 2156: 
 2157: This library is free software; you can redistribute it and/or modify
 2158: it under the same terms as Perl itself. 
 2159: 
 2160: =cut
 2161: 
 2162: 1;
 2163: 
 2164: # eof

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>