From cfd61389210dc0455c539ef13ee2f972850196f0 Mon Sep 17 00:00:00 2001 From: "Trevor L. McDonell" Date: Mon, 8 Sep 2014 17:43:15 -0400 Subject: [PATCH] move Data.Complex instance to the base package AccelerateHS/accelerate#197 AccelerateHS/accelerate-fft#1 ekmett/linear-accelerate#1 --- Data/Array/Accelerate/Math/Complex.hs | 142 ----------------------- Data/Array/Accelerate/Math/DFT.hs | 2 +- Data/Array/Accelerate/Math/DFT/Centre.hs | 2 +- Data/Array/Accelerate/Math/DFT/Roots.hs | 2 +- Data/Array/Accelerate/Math/FFT.hs | 2 +- accelerate-fft.cabal | 3 +- 6 files changed, 5 insertions(+), 148 deletions(-) delete mode 100644 Data/Array/Accelerate/Math/Complex.hs diff --git a/Data/Array/Accelerate/Math/Complex.hs b/Data/Array/Accelerate/Math/Complex.hs deleted file mode 100644 index 95bcf39..0000000 --- a/Data/Array/Accelerate/Math/Complex.hs +++ /dev/null @@ -1,142 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE IncoherentInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS -fno-warn-orphans #-} - -module Data.Array.Accelerate.Math.Complex ( - - Complex(..), - magnitude, phase, real, imag, conj, - -) where - -import Prelude -import Data.Complex ( Complex(..) ) -import Data.Array.Accelerate -import Data.Array.Accelerate.Smart -import Data.Array.Accelerate.Tuple -import Data.Array.Accelerate.Array.Sugar - - -type instance EltRepr (Complex a) = (EltRepr a, EltRepr' a) -type instance EltRepr' (Complex a) = (EltRepr a, EltRepr' a) - -instance Elt a => Elt (Complex a) where - eltType (_::Complex a) = eltType (undefined :: (a,a)) - toElt (a,b) = toElt a :+ toElt' b - fromElt (a :+ b) = (fromElt a, fromElt' b) - - eltType' (_::Complex a) = eltType' (undefined :: (a,a)) - toElt' (a,b) = toElt a :+ toElt' b - fromElt' (a :+ b) = (fromElt a, fromElt' b) - -instance IsTuple (Complex a) where - type TupleRepr (Complex a) = (((), a), a) - fromTuple (x :+ y) = (((), x), y) - toTuple (((), x), y) = (x :+ y) - -instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Complex a) where - type Plain (Complex a) = Complex (Plain a) - lift (x1 :+ x2) = Exp $ Tuple (NilTup `SnocTup` lift x1 `SnocTup` lift x2) - -instance Elt a => Unlift Exp (Complex (Exp a)) where - unlift e - = let x = Exp $ SuccTupIdx ZeroTupIdx `Prj` e - y = Exp $ ZeroTupIdx `Prj` e - in - x :+ y - -instance (Elt a, IsFloating a) => Num (Exp (Complex a)) where - (+) = lift2 ((+) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a)) - (-) = lift2 ((-) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a)) - (*) = lift2 ((*) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a)) - negate = lift1 (negate :: Complex (Exp a) -> Complex (Exp a)) - signum = lift1 (signum :: Complex (Exp a) -> Complex (Exp a)) - abs = lift1 (abs :: Complex (Exp a) -> Complex (Exp a)) - fromInteger n = lift (constant (fromInteger n) :+ 0) - - -instance (Elt a, IsFloating a) => Fractional (Exp (Complex a)) where - c / c' - = let x :+ y = unlift c - x' :+ y' = unlift c' :: Complex (Exp a) - den = x'^(2 :: Int) + y'^(2 :: Int) - re = (x * x' + y * y') / den - im = (y * x' - x * y') / den - in - lift (re :+ im) - - fromRational x - = lift (constant (fromRational x) :+ constant 0) - - -instance (Elt a, IsFloating a, RealFloat a) => Floating (Exp (Complex a)) where - sqrt z - = let - x :+ y = unlift z - v' = abs y / (u'*2) - u' = sqrt ((magnitude z + abs x) / 2) - (u, v) = unlift ( x <* 0 ? ( lift (v',u'), lift (u',v') ) ) - in - x ==* 0 &&* y ==* 0 ? - {- then -} ( 0 - {- else -} , lift (u :+ (y <* 0 ? (-v,v))) ) - - pi = lift (pi :+ constant 0) - log z = lift (log (magnitude z) :+ phase z) - exp = lift1 (exp :: Complex (Exp a) -> Complex (Exp a)) - sin = lift1 (sin :: Complex (Exp a) -> Complex (Exp a)) - cos = lift1 (cos :: Complex (Exp a) -> Complex (Exp a)) - tan = lift1 (tan :: Complex (Exp a) -> Complex (Exp a)) - sinh = lift1 (sinh :: Complex (Exp a) -> Complex (Exp a)) - cosh = lift1 (cosh :: Complex (Exp a) -> Complex (Exp a)) - tanh = lift1 (tanh :: Complex (Exp a) -> Complex (Exp a)) - asin = lift1 (asin :: Complex (Exp a) -> Complex (Exp a)) - acos = lift1 (acos :: Complex (Exp a) -> Complex (Exp a)) - atan = lift1 (atan :: Complex (Exp a) -> Complex (Exp a)) - asinh = lift1 (asinh :: Complex (Exp a) -> Complex (Exp a)) - acosh = lift1 (acosh :: Complex (Exp a) -> Complex (Exp a)) - atanh = lift1 (atanh :: Complex (Exp a) -> Complex (Exp a)) - - --- | Non-negative magnitude of a complex number --- -magnitude :: (Elt a, IsFloating a) => Exp (Complex a) -> Exp a -magnitude c = - let r :+ i = unlift c - in sqrt (r*r + i*i) - --- | The phase of a complex number, in the range (-pi, pi]. If the magnitude is --- zero, then so is the phase. --- -phase :: (Elt a, IsFloating a) => Exp (Complex a) -> Exp a -phase c = - let x :+ y = unlift c - in atan2 y x - - --- | Return the real part of a complex number --- -real :: Elt a => Exp (Complex a) -> Exp a -real c = - let r :+ _ = unlift c - in r - --- | Return the imaginary part of a complex number --- -imag :: Elt a => Exp (Complex a) -> Exp a -imag c = - let _ :+ i = unlift c - in i - --- | Return the complex conjugate of a complex number, defined as --- --- > conj(Z) = X - iY --- -conj :: (Elt a, IsNum a) => Exp (Complex a) -> Exp (Complex a) -conj z = lift $ real z :+ (- imag z) - diff --git a/Data/Array/Accelerate/Math/DFT.hs b/Data/Array/Accelerate/Math/DFT.hs index 56148c1..5ec7642 100644 --- a/Data/Array/Accelerate/Math/DFT.hs +++ b/Data/Array/Accelerate/Math/DFT.hs @@ -32,7 +32,7 @@ module Data.Array.Accelerate.Math.DFT ( import Prelude as P hiding ((!!)) import Data.Array.Accelerate as A import Data.Array.Accelerate.Math.DFT.Roots -import Data.Array.Accelerate.Math.Complex +import Data.Array.Accelerate.Data.Complex -- | Compute the DFT along the low order dimension of an array diff --git a/Data/Array/Accelerate/Math/DFT/Centre.hs b/Data/Array/Accelerate/Math/DFT/Centre.hs index 3d6a8df..e5f9768 100644 --- a/Data/Array/Accelerate/Math/DFT/Centre.hs +++ b/Data/Array/Accelerate/Math/DFT/Centre.hs @@ -25,7 +25,7 @@ module Data.Array.Accelerate.Math.DFT.Centre ( import Prelude as P import Data.Array.Accelerate as A -import Data.Array.Accelerate.Math.Complex +import Data.Array.Accelerate.Data.Complex -- | Apply the centring transform to a vector diff --git a/Data/Array/Accelerate/Math/DFT/Roots.hs b/Data/Array/Accelerate/Math/DFT/Roots.hs index 6297d25..434fe59 100644 --- a/Data/Array/Accelerate/Math/DFT/Roots.hs +++ b/Data/Array/Accelerate/Math/DFT/Roots.hs @@ -16,7 +16,7 @@ module Data.Array.Accelerate.Math.DFT.Roots ( import Prelude as P import Data.Array.Accelerate as A -import Data.Array.Accelerate.Math.Complex +import Data.Array.Accelerate.Data.Complex -- | Calculate the roots of unity for the forward transform diff --git a/Data/Array/Accelerate/Math/FFT.hs b/Data/Array/Accelerate/Math/FFT.hs index 361de29..a8afb9f 100644 --- a/Data/Array/Accelerate/Math/FFT.hs +++ b/Data/Array/Accelerate/Math/FFT.hs @@ -34,7 +34,7 @@ module Data.Array.Accelerate.Math.FFT ( import Prelude as P import Data.Array.Accelerate as A import Data.Array.Accelerate.Array.Sugar ( showShape ) -import Data.Array.Accelerate.Math.Complex +import Data.Array.Accelerate.Data.Complex #ifdef ACCELERATE_CUDA_BACKEND import Data.Array.Accelerate.CUDA.Foreign diff --git a/accelerate-fft.cabal b/accelerate-fft.cabal index 4d27937..c274374 100644 --- a/accelerate-fft.cabal +++ b/accelerate-fft.cabal @@ -34,8 +34,7 @@ Library Build-depends: accelerate == 0.15.*, base >= 4.6 && < 4.8 - Exposed-modules: Data.Array.Accelerate.Math.Complex - Data.Array.Accelerate.Math.FFT + Exposed-modules: Data.Array.Accelerate.Math.FFT Data.Array.Accelerate.Math.DFT Data.Array.Accelerate.Math.DFT.Centre Data.Array.Accelerate.Math.DFT.Roots