{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module NumHask.Data.Complex where
import GHC.Generics (Generic, Generic1)
import Data.Data (Data)
import NumHask.Algebra.Additive
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import NumHask.Algebra.Distribution
import NumHask.Algebra.Field
import NumHask.Algebra.Metric
import Prelude hiding (Num(..), negate, sin, cos, sqrt, (/), atan, pi, exp, log, recip, (**))
import qualified Prelude as P ( (&&), (>), (<=), (<), (==), otherwise, Ord(..) )
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 (AdditiveMagma a) => AdditiveMagma (Complex a) where
(rx :+ ix) `plus` (ry :+ iy) = (rx `plus` ry) :+ (ix `plus` iy)
instance (AdditiveUnital a) => AdditiveUnital (Complex a) where
zero = zero :+ zero
instance (AdditiveAssociative a) => AdditiveAssociative (Complex a)
instance (AdditiveCommutative a) => AdditiveCommutative (Complex a)
instance (Additive a) => Additive (Complex a)
instance (AdditiveInvertible a) => AdditiveInvertible (Complex a) where
negate (rx :+ ix) = negate rx :+ negate ix
instance (AdditiveGroup a) => AdditiveGroup (Complex a)
instance (Distribution a, AdditiveGroup a) => Distribution (Complex a)
instance (AdditiveUnital a, AdditiveGroup a, MultiplicativeUnital a) => MultiplicativeUnital (Complex a) where
one = one :+ zero
instance (MultiplicativeMagma a, AdditiveGroup a) => MultiplicativeMagma (Complex a) where
(rx :+ ix) `times` (ry :+ iy) =
(rx `times` ry - ix `times` iy) :+ (ix `times` ry + iy `times` rx)
instance (MultiplicativeMagma a, AdditiveGroup a) => MultiplicativeCommutative (Complex a)
instance (MultiplicativeUnital a, MultiplicativeAssociative a, AdditiveGroup a) => Multiplicative (Complex a)
instance (AdditiveGroup a, MultiplicativeInvertible a) => MultiplicativeInvertible (Complex a) where
recip (rx :+ ix) = (rx `times` d) :+ (negate ix `times` d)
where
d = recip ((rx `times` rx) `plus` (ix `times` ix))
instance (MultiplicativeUnital a, MultiplicativeAssociative a, MultiplicativeInvertible a, AdditiveGroup a) => MultiplicativeGroup (Complex a)
instance (AdditiveGroup a, MultiplicativeAssociative a) =>
MultiplicativeAssociative (Complex a)
instance (Semiring a, AdditiveGroup a) => Semiring (Complex a)
instance (Semiring a, AdditiveGroup a) => Ring (Complex a)
instance (Semiring a, AdditiveGroup a) => InvolutiveRing (Complex a)
instance (MultiplicativeAssociative a, MultiplicativeUnital a, AdditiveGroup a, Semiring a) =>
CRing (Complex a)
instance (MultiplicativeGroup a, AdditiveGroup a, Semiring a) => Field (Complex a)
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)
normLp p (rx :+ ix) = (normL1 rx ** p + normL1 ix ** p) ** (one / p)
instance (Multiplicative a, ExpField a, Normed a a) => Metric (Complex a) a where
distanceL1 a b = normL1 (a - b)
distanceL2 a b = normL2 (a - b)
distanceLp p a b = normLp p (a - b)
instance (P.Ord a, TrigField a, ExpField 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
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