cpx.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
partial class CPX{STP < $REAL{STP}, ATP}
partial class CPX{STP < $REAL{STP}, ATP} is
-- This class implements the mathematical notion of a complex number
-- within the constraints of the parameter type.
-- Some of the algorithms are taken from:
--
-- Press, Flannery, Teukolsky, and Vettering, "Numerical Recipes in C",
-- 2nd ed, CUP, 1993.
--
-- Some of the choices of branch cut were chosen to be consistent with:
--
-- Guy L. Steele, "Common Lisp, The Language", 2nd ed, Digital 1990
-- Version 1.2 March 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 8 Aug 97 kh Original from Sather 1.1 Dist
-- 7 Dec 00 kh included is_lt based on magnitude.
-- 18 Mar 01 djw Fixed bug in div, added routine
-- is_similar, and fixed/added numerous
-- pre and post conditions
include COMPARABLE ;
include BINARY ;
include COMPLEX_STR{STP} ;
include CPX_FUNCTIONS ; -- include if desired!
const negatable : BOOL := true ;
const is_exact : BOOL := false ;
const is_limited : BOOL := true ;
const is_signed : BOOL := true ;
attr re,
im : STP ; -- Real and imaginary parts.
stub log : SAME ;
-- This routine returns the complex logarithm of self.
create_real(
val : STP
) : SAME is
-- This routine creates a complex number which has a zero imaginary
-- component.
return create(val,STP::create(0.0))
end ;
build(
cursor : BIN_CURSOR
) : SAME
pre ~void(cursor)
and ~cursor.is_done
post true
is
-- This routine returns the complex number contained in the indicated
-- string at the current position.
return create(STP::build(cursor),STP::build(cursor))
end ;
create(
val : CARD
) : SAME is
-- This version of create produces one which has an integral real part
-- but zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : FIELD
) : SAME is
-- This version of create produces one which has an integral real part
-- but zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : INT
) : SAME is
-- This version of create produces one which has an integral real part
-- but zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : INTI
) : SAME
pre true
post (result.re = STP::create(val))
and (result.im = STP::zero)
is
-- This version of create produces one which has an integral real part
-- but zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : RAT
) : SAME
pre true
post (result.re = STP::create(val))
and (result.im = STP::zero)
is
-- This version of create produces one which has an integral real part
-- but zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : FLT
) : SAME is
-- This routine creates a complex number with a real part val and
-- zero imaginary part.
return create_real(STP::create(val))
end ;
create(
val : FLTD
) : SAME
pre (STP::maxval.fltd >= val)
and (val >= -STP::maxval.fltd)
post true
is
-- This routine creates a complex number with a real part val and
-- zero imaginary part.
return create_real(STP::create(val))
end ;
zero : SAME is
-- This routine provides a complex zero value.
return create(STP::zero,STP::zero)
end ;
one : SAME is
-- This routine provides a complex number with unit real part and zero
-- imaginary part.
return create(STP::one,STP::zero)
end ;
maxval : SAME is
-- This routine creates a complex number which has the maximum
-- representable real and imaginary parts.
return create(STP::maxval,STP::maxval)
end ;
minval : SAME is
-- This routine creates a complex number which has the minimum
-- representable real and imaginary parts.
return create(STP::minval,STP::minval)
end ;
nil : SAME is
-- This predicate returns a nil complex value.
return create(re.nil,im.nil)
end ;
private absolute : STP
pre true
post create(result.square).is_similar(create(self.magnitude_squared))
is
-- This private routine returns the absolute magnitude of self which is
-- calculated using the algorithm in 'Numerical Recipes in C' p949.
loc_re : STP := re.abs ;
loc_im : STP := im.abs ;
temp : STP ;
if loc_re = STP::zero then
return loc_im
elsif loc_im = STP::zero then
return loc_re
elsif loc_re > loc_im then
temp := loc_im / loc_re ;
return loc_re * (STP::one + temp * temp).sqrt
else
temp := loc_re / loc_im ;
return loc_im * (STP::one + temp * temp).sqrt
end
end ;
abs : SAME
pre true
post (result.re = absolute)
and (result.im = STP::zero)
is
-- This routine returns the absolute value of self. It is here to
-- conform to the interface of $NFE.
return create_real(absolute)
end ;
magnitude : STP
pre true
post result = absolute
is
-- This routine returns the absolute magnitude of self.
return absolute
end ;
magnitude_squared : STP
pre (re / STP::maxval)*re + (im / STP::maxval)*im < STP::one
post true
is
-- This routine returns the square of the absolute magnitude of self.
return re * re + im * im
end ;
conjugate : SAME
pre true
post (self*result).is_similar(create(self.magnitude_squared))
is
-- This routine returns the complex conjugate of self.
return create(re,-im)
end ;
is_eq(
other : SAME
) : BOOL is
-- This predicate returns true if and only if self and other have
-- identical values of real and imaginary parts.
return re = other.re
and im = other.im
end ;
is_lt(
other : SAME
) : BOOL is
-- This predicate returns true if and only if the magnitude of self is
-- less than that of other, otherwise false
return magnitude < other.magnitude
end ;
is_nil : BOOL is
-- This predicate returns true if either component of the number is nil.
return re.is_nil
or im.is_nil
end ;
is_neg : BOOL is
-- This routine returns true if and only if both components are negative.
return (re < STP::zero)
and (im < STP::zero)
end ;
is_zero : BOOL is
-- This routine returns true if and only if both components are zero.
return (re = STP::zero)
and (im = STP::zero)
end ;
is_pos : BOOL is
-- This routine returns true if and only if both components are positive.
return (re > STP::zero)
and (im > STP::zero)
end ;
is_within(
radius : STP,
other : SAME
) : BOOL is
-- This predicate returns true if and only if self is within the given
-- radius of other.
return (self - other).magnitude_squared <= radius*radius
end ;
private is_similar(
other : SAME
) : BOOL is
-- This routine tests if self and other are within one model number
-- of each other.
tolerance : STP := STP::epsilon.sqrt ;
return is_within(tolerance,other)
end ;
sign : NUM_SIGNS is
-- This routine returns the sign of self which is negative if either
-- component is negative, zero if both are zero - otherwise positive..
if (re < STP::zero)
or (im < STP::zero) then
return NUM_SIGNS::Negative
elsif self = zero then
return NUM_SIGNS::Zero
else
return NUM_SIGNS::Positive
end
end ;
plus(
other : SAME
) : SAME
pre ( ((re / STP::maxval) + (other.re / STP::maxval) < STP::one)
and ((re / STP::maxval) + (other.re / STP::maxval) > -STP::one)
and ((im / STP::maxval) + (other.im / STP::maxval) < STP::one)
and ((im / STP::maxval) + (other.im / STP::maxval) > -STP::one) )
post self.is_similar(result - other)
is
-- This routine returns the sum of self and other.
return create(re + other.re,im + other.im)
end ;
minus(
other : SAME
) : SAME
pre ((self.re.sign = other.re.sign)
or ((STP::maxval - self.re.abs) >= other.re.abs))
and ((self.im.sign = other.im.sign)
or ((STP::maxval - self.im.abs) >= other.im.abs))
post true
is
-- This routine returns the complex difference of subtracting other from
-- self.
return create(re - other.re,im - other.im)
end ;
negate : SAME
pre true
post zero.is_similar(self + result)
is
-- This routine returns the additive inverse of self.
return create(-re,-im)
end ;
times(
other : SAME
) : SAME
pre (
((re / STP::maxval) * other.re -
(im / STP::maxval) * other.im < STP::one)
and ((re / STP::maxval) * other.re -
(im / STP::maxval) * other.im > -STP::one)
and ((re / STP::maxval) * other.im +
(im / STP::maxval) * other.re < STP::one)
and ((re / STP::maxval) * other.im +
(im / STP::maxval)*other.re > -STP::one)
)
post true
is
-- This routine returns the complex product of self and other.
return create(re * other.re - im * other.im,
re * other.im + im * other.re)
end ;
div(
other : SAME
) : SAME
pre true
post self.is_similar(result * other)
is
-- This routine returns the result of complex division of self by other.
denom,
res : STP ;
if other.re.abs >= other.im.abs then
res := other.im/other.re ;
denom := other.re + res * other.im ;
res := res / denom ; -- to make sure no overflow!
return create((re/denom) + (res * im),(im/denom) - (res * re))
else
res := other.re/other.im ;
denom := other.im + res * other.re ;
res := res / denom ; -- to make sure no overflow!
return create((im/denom) + (res * re), (res * im) - (re/denom))
end
end ;
mod(
other : SAME
) : SAME is
-- This routine returns the remainder of the result of dividing self by
-- other. This is zero for a complex number.
return create(0)
end ;
times(
factor : STP
) : SAME
pre (((factor.abs > STP::one)
and ((STP::maxval / factor.abs) <= re.abs))
or ((STP::maxval * factor.abs) >= re.abs))
and (((factor.abs > STP::one)
and ((STP::maxval / factor.abs) <= im.abs))
or ((STP::maxval * factor.abs) >= im.abs))
post result.is_similar(self * create(factor))
is
-- This routine scales both real and imaginary components of self by
-- the given factor.
return create(re * factor,im * factor)
end ;
div(
divisor : STP
) : SAME
pre (divisor.abs >= STP::one)
or (((divisor.abs * STP::maxval) <= re.abs)
and ((divisor.abs * STP::maxval) <= im.abs))
post result.is_similar(self / create(divisor))
is
-- This routine divides both components of self by the given divisor.
return create(re / divisor, im /divisor)
end ;
pow(
other : SAME
) : SAME
pre ~((re = STP::zero)
and (im = STP::zero))
is
-- This routine returns the result of raising self to the power of other.
return (log * other).exp
end ;
reciprocal : SAME
pre true
post one.is_similar(self * result)
is
-- This routine returns the multiplicative inverse of self.
denom,
res : STP ;
if re.abs >= im.abs then
res := im/re ;
denom := re + res * im ;
return create(STP::one/denom,-res/denom)
else
res := re/im ;
denom := im + res * re ;
return create(res/denom,(-STP::one)/denom)
end
end ;
exp : SAME is
-- This routine returns the complex exponential `e^self'.
real_part : STP := re.exp ;
phase : ATP := ATP::radians(im) ;
return create(real_part * phase.cos,real_part * phase.sin)
end ;
sqrt : SAME
pre true
post self.is_similar(result.square)
is
-- This routine returns the complex square root of self. The algorithm
-- is taken from 'Numerical Recipes in C' p949, choosing the branch cut by
--
-- e^((log z)/2)
if re = STP::create(STP::zero) -- zero is special case.
and im = STP::create(STP::zero) then
return create(STP::create(STP::zero),STP::create(STP::zero))
end ;
loc_re : STP := re.abs ;
loc_im : STP := im.abs ;
trial_val : STP ;
loc_half : STP := STP::one / (STP::one + STP::one) ;
if loc_re >= loc_im then
tmp : STP := loc_im / loc_re ;
trial_val := loc_re.sqrt * (loc_half * STP::one) +
(STP::one + tmp * tmp).sqrt.sqrt
else
tmp : STP := loc_re / loc_im ;
trial_val := loc_im.sqrt * (loc_half *
(tmp + (STP::one + tmp * tmp).sqrt)).sqrt
end ;
loc_two : STP := STP::one + STP::one ;
if re >= STP::zero then
return create(trial_val,im / (loc_two * trial_val))
elsif im >= STP::zero then
return create(im / (loc_two * trial_val),trial_val)
else
return create(-im / (loc_two * trial_val),-trial_val)
end
end ;
cube_root : SAME
pre true
post self.is_similar(result.cube)
is
-- This routine returns the complex cube root of self using a preliminary
-- algorithm.
loc_three : STP := STP::one + STP::one + STP::one ;
return self.pow(create_real(STP::one/loc_three))
end ;
square : SAME
-- pre (STP::maxval / re.square < im.square)
post result.is_similar(self.pow(one+one))
is
-- This routine returns the square of self.
return self * self
end ;
cube : SAME
pre (STP::maxval / (re.square * re) < (im.square * im))
post result.is_similar(self.pow(one+one+one))
is
-- This routine returns the cube of self.
return self * self * self
end ;
binstr : BINSTR
pre true
post build(result.cursor) = self
is
-- This routine returns a binary representation of self.
return re.binstr + im.binstr
end ;
end ; -- CPX{T}
immutable class CPX < $COMPLEX{FLT,CPX}, $OPTION, $FLT_FMT
immutable class CPX < $COMPLEX{FLT,CPX}, $OPTION, $FLT_FMT is
-- This class implements the class of complex numbers which have real
-- components (of FLT class).
-- Version 1.1 March 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 8 Aug 97 kh Original from Sather 1.1 Dist
-- 18 Mar 01 djw Fixed bug in log, and added
-- post condition to log.
include CPX{FLT,ANGLE} ;
create(
real,
imaginary : FLT
) : SAME is
-- This routine creates a complex number with a real part `re' and
-- imaginary part `im'.
me : SAME ;
return me.re(real).im(imaginary)
end ;
log : CPX
post self.is_similar(result.exp)
is
-- This routine returns the complex logarithm of self. The chosen
-- branch is
--
-- log |self| + i phase(self). See Steele p302.
phase : ANGLE := ANGLE::atan2(im,re) ;
magnitude : FLT := (re * re + im * im).sqrt.log ;
return create(magnitude , phase.radians)
end ;
end ; -- CPX