{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
module NumHask.Data.Complex where
import Data.Data (Data)
import GHC.Generics (Generic, Generic1)
import NumHask.Algebra.Abstract.Additive
import NumHask.Algebra.Abstract.Field
import NumHask.Algebra.Abstract.Lattice
import NumHask.Algebra.Abstract.Multiplicative
import NumHask.Algebra.Abstract.Ring
import NumHask.Analysis.Metric
import NumHask.Data.Integral
import Prelude
hiding (Num(..), (/), atan, cos, exp, log, negate, pi, recip, sin, sqrt)
import qualified Prelude as P (Ord(..), (&&), (<), (<=), (==), (>), otherwise)
infix 6 :+
data Complex a =
!a :+ !a
deriving ( Eq
, Show
, Read
, Data
, Generic
, Generic1
, Functor
, Foldable
, Traversable
)
realPart :: Complex a -> a
realPart (x :+ _) = x
imagPart :: Complex a -> a
imagPart (_ :+ y) = y
instance (Additive a) => Additive (Complex a) where
(rx :+ ix) + (ry :+ iy) = (rx + ry) :+ (ix + iy)
zero = zero :+ zero
instance (Subtractive a) => Subtractive (Complex a) where
negate (rx :+ ix) = negate rx :+ negate ix
instance (Distributive a, Subtractive a) =>
Distributive (Complex a)
instance (Subtractive a, Multiplicative a) =>
Multiplicative (Complex a) where
(rx :+ ix) * (ry :+ iy) =
(rx * ry - ix * iy) :+ (ix * ry + iy * rx)
one = one :+ zero
instance (Subtractive a, Divisive a) =>
Divisive (Complex a) where
recip (rx :+ ix) = (rx * d) :+ (negate ix * d)
where
d = recip ((rx * rx) + (ix * ix))
instance (Additive a, FromIntegral a b) =>
FromIntegral (Complex a) b where
fromIntegral_ x = fromIntegral_ x :+ zero
instance (Multiplicative a, ExpField a, Normed a a) =>
Normed (Complex a) a where
normL1 (rx :+ ix) = normL1 rx + normL1 ix
normL2 (rx :+ ix) = sqrt (rx * rx + ix * ix)
instance (Multiplicative a, Subtractive a, ExpField a, Normed a a) =>
Metric (Complex a) a where
distanceL1 a b = normL1 (a - b)
distanceL2 a b = normL2 (a - b)
instance (Ord a, Signed a, Subtractive a, Epsilon a)
=> Epsilon (Complex a) where
epsilon = epsilon :+ epsilon
nearZero (a :+ b) = nearZero a && nearZero b
instance (IntegralDomain a, Subtractive a) => IntegralDomain (Complex a)
instance (Field a, Subtractive a) => Field (Complex a)
instance (Ord a, TrigField a, ExpField a, Subtractive a) => ExpField (Complex a) where
exp (rx :+ ix) = (exp rx * cos ix) :+ (exp rx * sin ix)
log (rx :+ ix) = log (sqrt (rx * rx + ix * ix)) :+ atan2' ix rx
where
atan2' y x
| x P.> zero = atan (y / x)
| x P.== zero P.&& y P.> zero = pi / (one + one)
| x P.< one P.&& y P.> one = pi + atan (y / x)
| (x P.<= zero P.&& y P.< zero) || (x P.< zero) =
negate (atan2' (negate y) x)
| y P.== zero = pi
| x P.== zero P.&& y P.== zero = y
| P.otherwise = x + y
instance (Distributive a, Subtractive a) => InvolutiveRing (Complex a) where
adj (a :+ b) = a :+ negate b
instance (UpperBoundedField a, IntegralDomain a, Subtractive a) => UpperBoundedField (Complex a)
instance (LowerBoundedField a) => LowerBoundedField (Complex a)
instance (JoinSemiLattice a) => JoinSemiLattice (Complex a) where
(\/) (ar :+ ai) (br :+ bi) = (ar \/ br) :+ (ai \/ bi)
instance (MeetSemiLattice a) => MeetSemiLattice (Complex a) where
(/\) (ar :+ ai) (br :+ bi) = (ar /\ br) :+ (ai /\ bi)
instance (BoundedJoinSemiLattice a) => BoundedJoinSemiLattice (Complex a) where
bottom = bottom :+ bottom
instance (BoundedMeetSemiLattice a) => BoundedMeetSemiLattice (Complex a) where
top = top :+ top
mkPolar :: TrigField a => a -> a -> Complex a
mkPolar r theta = (r * cos theta) :+ (r * sin theta)
{-# SPECIALISE cis :: Double -> Complex Double #-}
cis :: TrigField a => a -> Complex a
cis theta = cos theta :+ sin theta
{-# SPECIALISE polar :: Complex Double -> (Double, Double) #-}
polar :: (RealFloat a, ExpField a) => Complex a -> (a, a)
polar z = (magnitude z, phase z)
{-# SPECIALISE magnitude :: Complex Double -> Double #-}
magnitude :: (ExpField a, RealFloat a) => Complex a -> a
magnitude (x :+ y) = scaleFloat
k
(sqrt (sqr (scaleFloat mk x) + sqr (scaleFloat mk y)))
where
k = max (exponent x) (exponent y)
mk = -k
sqr z = z * z
{-# SPECIALISE phase :: Complex Double -> Double #-}
phase :: (RealFloat a) => Complex a -> a
phase (0 :+ 0) = 0
phase (x :+ y) = atan2 y x