ghc/lib/required/Complex.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1997
   3 %
   4
   5 \section[Complex]{Module @Complex@}
   6
   7 \begin{code}
   8 module Complex (
   9         Complex((:+)),
  10
  11         realPart, imagPart, conjugate, mkPolar,
  12         cis, polar, magnitude, phase
  13     )  where
  14
  15 import Prelude
  16
  17 infix  6  :+
  18 \end{code}
  19
  20 %*********************************************************
  21 %*                                                      *
  22 \subsection{The @Complex@ type}
  23 %*                                                      *
  24 %*********************************************************
  25
  26 \begin{code}
  27 data  (RealFloat a)     => Complex a = !a :+ !a  deriving (Eq,Read,Show)
  28 \end{code}
  29
  30
  31 %*********************************************************
  32 %*                                                      *
  33 \subsection{Functions over @Complex@}
  34 %*                                                      *
  35 %*********************************************************
  36
  37 \begin{code}
  38 realPart, imagPart :: (RealFloat a) => Complex a -> a
  39 realPart (x:+y)  =  x
  40 imagPart (x:+y)  =  y
  41
  42 conjugate        :: (RealFloat a) => Complex a -> Complex a
  43 conjugate (x:+y) =  x :+ (-y)
  44
  45 mkPolar          :: (RealFloat a) => a -> a -> Complex a
  46 mkPolar r theta  =  r * cos theta :+ r * sin theta
  47
  48 cis              :: (RealFloat a) => a -> Complex a
  49 cis theta        =  cos theta :+ sin theta
  50
  51 polar            :: (RealFloat a) => Complex a -> (a,a)
  52 polar z          =  (magnitude z, phase z)
  53
  54 magnitude, phase :: (RealFloat a) => Complex a -> a
  55 magnitude (x:+y) =  scaleFloat k
  56                      (sqrt ((scaleFloat mk x)^2 + (scaleFloat mk y)^2))
  57                     where k  = max (exponent x) (exponent y)
  58                           mk = - k
  59
  60 phase (0 :+ 0)   = 0            -- SLPJ July 97 from John Peterson
  61 phase (x:+y)     =  atan2 y x
  62 \end{code}
  63
  64
  65 %*********************************************************
  66 %*                                                      *
  67 \subsection{Instances of @Complex@}
  68 %*                                                      *
  69 %*********************************************************
  70
  71 \begin{code}
  72 instance  (RealFloat a) => Num (Complex a)  where
  73     (x:+y) + (x':+y')   =  (x+x') :+ (y+y')
  74     (x:+y) - (x':+y')   =  (x-x') :+ (y-y')
  75     (x:+y) * (x':+y')   =  (x*x'-y*y') :+ (x*y'+y*x')
  76     negate (x:+y)       =  negate x :+ negate y
  77     abs z               =  magnitude z :+ 0
  78     signum 0            =  0
  79     signum z@(x:+y)     =  x/r :+ y/r  where r = magnitude z
  80     fromInteger n       =  fromInteger n :+ 0
  81
  82 instance  (RealFloat a) => Fractional (Complex a)  where
  83     (x:+y) / (x':+y')   =  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d
  84                            where x'' = scaleFloat k x'
  85                                  y'' = scaleFloat k y'
  86                                  k   = - max (exponent x') (exponent y')
  87                                  d   = x'*x'' + y'*y''
  88
  89     fromRational a      =  fromRational a :+ 0
  90
  91 instance  (RealFloat a) => Floating (Complex a) where
  92     pi             =  pi :+ 0
  93     exp (x:+y)     =  expx * cos y :+ expx * sin y
  94                       where expx = exp x
  95     log z          =  log (magnitude z) :+ phase z
  96
  97     sqrt 0         =  0
  98     sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)
  99                       where (u,v) = if x < 0 then (v',u') else (u',v')
 100                             v'    = abs y / (u'*2)
 101                             u'    = sqrt ((magnitude z + abs x) / 2)
 102
 103     sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y
 104     cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)
 105     tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))
 106                       where sinx  = sin x
 107                             cosx  = cos x
 108                             sinhy = sinh y
 109                             coshy = cosh y
 110
 111     sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x
 112     cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x
 113     tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)
 114                       where siny  = sin y
 115                             cosy  = cos y
 116                             sinhx = sinh x
 117                             coshx = cosh x
 118
 119     asin z@(x:+y)  =  y':+(-x')
 120                       where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))
 121     acos z@(x:+y)  =  y'':+(-x'')
 122                       where (x'':+y'') = log (z + ((-y'):+x'))
 123                             (x':+y')   = sqrt (1 - z*z)
 124     atan z@(x:+y)  =  y':+(-x')
 125                       where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))
 126
 127     asinh z        =  log (z + sqrt (1+z*z))
 128     acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))
 129     atanh z        =  log ((1+z) / sqrt (1-z*z))
 130 \end{code}