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