diff --git a/Justfile b/Justfile new file mode 100644 --- /dev/null +++ b/Justfile @@ -0,0 +1,9 @@ +run-test: update-test + runhaskell Setup.lhs configure --user --enable-tests + runhaskell Setup.lhs build + ./dist/build/accelerate-fftw-test/accelerate-fftw-test + +update-test: + doctest-extract-0.1 -i src/ -o test/ \ + --import-tested --module-prefix Test --executable-main=Test.hs \ + Data.Array.Accelerate.FFTW.Manifest diff --git a/accelerate-fftw.cabal b/accelerate-fftw.cabal --- a/accelerate-fftw.cabal +++ b/accelerate-fftw.cabal @@ -1,36 +1,39 @@ +Cabal-Version: 2.2 Name: accelerate-fftw -Version: 0.0 -License: BSD3 +Version: 1.1 +License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann -Homepage: http://code.haskell.org/~thielema/accelerate-fftw/ +Homepage: https://hub.darcs.net/thielema/accelerate-fftw/ Category: Math Synopsis: Accelerate frontend to the FFTW library (Fourier transform) Description: An interface to the Fastest Fourier Transform in the West (FFTW) for the @accelerate@ framework. -Tested-With: GHC==7.8.3 -Cabal-Version: >=1.14 +Tested-With: GHC==9.2.8, GHC==9.12.4 Build-Type: Simple +Extra-Source-Files: + Justfile Source-Repository this - Tag: 0.0 + Tag: 1.1 Type: darcs - Location: http://code.haskell.org/~thielema/accelerate-fftw/ + Location: https://hub.darcs.net/thielema/accelerate-fftw/ Source-Repository head Type: darcs - Location: http://code.haskell.org/~thielema/accelerate-fftw/ + Location: https://hub.darcs.net/thielema/accelerate-fftw/ Library Build-Depends: - fft >=0.1.7 && <0.2, - carray >=0.1.5 && <0.2, + comfort-fftw >=0.0 && <0.1, + comfort-array >=0.5.5 && <0.6, + netlib-ffi >=0.1 && <0.2, storable-complex >=0.2.1 && <0.3, - accelerate-io >=0.15 && <0.16, - accelerate >=0.15 && <0.16, - base >=4.5 && <4.8 + accelerate-io >=1.3 && <1.5, + accelerate >=1.3 && <1.5, + base >=4.5 && <5 GHC-Options: -Wall -fwarn-missing-import-lists Hs-Source-Dirs: src @@ -38,4 +41,22 @@ Exposed-Modules: Data.Array.Accelerate.FFTW.Manifest Other-Modules: + Data.Array.Accelerate.FFTW.Private Data.Array.Accelerate.CArray.Conversion + +Test-Suite accelerate-fftw-test + Type: exitcode-stdio-1.0 + Build-Depends: + doctest-exitcode-stdio >=0.0 && <0.1, + doctest-lib >=0.1.1 && <0.2, + accelerate-fftw, + accelerate-utility >=1.1 && <1.2, + accelerate >=1.3 && <1.5, + base >=4.5 && <5 + + GHC-Options: -Wall + Hs-Source-Dirs: test + Default-Language: Haskell98 + Main-Is: Test.hs + Other-Modules: + Test.Data.Array.Accelerate.FFTW.Manifest diff --git a/src/Data/Array/Accelerate/CArray/Conversion.hs b/src/Data/Array/Accelerate/CArray/Conversion.hs --- a/src/Data/Array/Accelerate/CArray/Conversion.hs +++ b/src/Data/Array/Accelerate/CArray/Conversion.hs @@ -1,156 +1,145 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ConstraintKinds #-} +-- ToDo: extract to a separate package module Data.Array.Accelerate.CArray.Conversion where -import qualified Data.Array.Accelerate.IO as AIO +import qualified Data.Array.Accelerate.IO.Foreign.ForeignPtr as AIO +import qualified Data.Array.Accelerate.Sugar.Shape as Shape import qualified Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Sugar (EltRepr, EltRepr') +import Data.Array.Accelerate.Sugar.Elt (EltR) import Data.Array.Accelerate (Array, DIM1, DIM2, Z(Z), (:.)((:.))) -import qualified Data.Array.CArray as CArray -import Data.Array.CArray (CArray, createCArray, withCArray, rangeSize) -import Data.Ix (Ix) +import qualified Data.Array.Comfort.Storable.Private as CArray +import qualified Data.Array.Comfort.Shape as CShape import Foreign.Storable.Complex () import Data.Array.Accelerate.Data.Complex (Complex) -import qualified Data.Complex as Complex -import System.IO.Unsafe (unsafePerformIO) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr (Ptr) +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) import Foreign.Storable (Storable) -import Control.Monad ((<=<)) -import Data.IORef (newIORef, writeIORef, readIORef) +type CArray = CArray.Array +type ShapeInt = CShape.ZeroBased Int +type RealElement a = + (A.Elt a, Storable a, AIO.ForeignPtrs (EltR a) ~ ForeignPtr a) + +type ComplexElement a ac = + (Storable a, RealFloat a, Complex a ~ ac, A.Elt ac, + AIO.ForeignPtrs (EltR ac) ~ ForeignPtr a) + + accFromCArrayReal1D :: - (A.Elt a, Storable a, AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a)) => - CArray Int a -> Array DIM1 a + (RealElement a) => + CArray ShapeInt a -> Array DIM1 a accFromCArrayReal1D arr = - let (len, fptr) = CArray.toForeignPtr arr - in unsafePerformIO $ - withForeignPtr fptr $ \ptr -> AIO.fromPtr (Z :. len) ((), ptr) + AIO.fromForeignPtrs + (accDimsFromArrayBounds1D $ CArray.shape arr) + (CArray.buffer arr) accFromCArrayReal2D :: - (A.Elt a, Storable a, AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a)) => - CArray (Int, Int) a -> Array DIM2 a + (RealElement a) => + CArray (ShapeInt, ShapeInt) a -> Array DIM2 a accFromCArrayReal2D arr = - unsafePerformIO $ - withCArray arr $ \ptr -> - AIO.fromPtr (accDimsFromArrayBounds2D $ CArray.bounds arr) ((), ptr) + AIO.fromForeignPtrs + (accDimsFromArrayBounds2D $ CArray.shape arr) + (CArray.buffer arr) accFromCArrayComplex1D :: - (A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - CArray Int (Complex a) -> Array DIM1 (Complex a) + (ComplexElement a ac) => + CArray ShapeInt (Complex a) -> Array DIM1 (Complex a) accFromCArrayComplex1D arr = - accFromCArrayComplex (accDimsFromArrayBounds1D $ CArray.bounds arr) arr + accFromCArrayComplex (accDimsFromArrayBounds1D $ CArray.shape arr) arr accFromCArrayComplex2D :: - (A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - CArray (Int, Int) (Complex a) -> Array DIM2 (Complex a) + (ComplexElement a ac) => + CArray (ShapeInt, ShapeInt) (Complex a) -> Array DIM2 (Complex a) accFromCArrayComplex2D arr = - accFromCArrayComplex (accDimsFromArrayBounds2D $ CArray.bounds arr) arr + accFromCArrayComplex (accDimsFromArrayBounds2D $ CArray.shape arr) arr accFromCArrayComplex :: - (Ix i, A.Shape sh, - A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - sh -> CArray i (Complex a) -> Array sh (Complex a) + (A.Shape sh, ComplexElement a ac) => + sh -> CArray csh ac -> Array sh ac accFromCArrayComplex sh arr = - unsafePerformIO $ - withCArray (CArray.amap Complex.realPart arr) $ \ptrReal -> - withCArray (CArray.amap Complex.imagPart arr) $ \ptrImag -> - AIO.fromPtr sh (((), ptrReal), ptrImag) + AIO.fromForeignPtrs sh $ castForeignPtrFromComplex $ CArray.buffer arr +castForeignPtrFromComplex :: ForeignPtr (Complex a) -> ForeignPtr a +castForeignPtrFromComplex = castForeignPtr -accDimsFromArrayBounds1D :: (CArray.Ix i) => (i, i) -> DIM1 -accDimsFromArrayBounds1D bnds = Z :. rangeSize bnds + +accDimsFromArrayBounds1D :: (CShape.C sh) => sh -> DIM1 +accDimsFromArrayBounds1D sh = Z :. CShape.size sh + accDimsFromArrayBounds2D :: - (CArray.Ix i, CArray.Ix j) => ((i, j), (i, j)) -> DIM2 -accDimsFromArrayBounds2D ((li,lj), (ri,rj)) = - Z :. rangeSize (li,ri) :. rangeSize (lj,rj) + (CShape.C sh0, CShape.C sh1) => (sh0, sh1) -> DIM2 +accDimsFromArrayBounds2D (sh0, sh1) = + Z :. CShape.size sh0 :. CShape.size sh1 cArrayFromAccReal1D :: - (A.Elt a, Storable a, AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a)) => - Array DIM1 a -> CArray Int a + (RealElement a) => + Array DIM1 a -> CArray ShapeInt a cArrayFromAccReal1D arr = - let (Z:.len) = A.arrayShape arr - in unsafePerformIO $ - createCArray (0,len-1) $ \ptr -> AIO.toPtr arr ((), ptr) + CArray.Array + (arrayBounds1DFromAccDims $ A.arrayShape arr) + (AIO.toForeignPtrs arr) cArrayFromAccReal2D :: - (A.Elt a, Storable a, AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a)) => - Array DIM2 a -> CArray (Int, Int) a + (RealElement a) => + Array DIM2 a -> CArray (ShapeInt, ShapeInt) a cArrayFromAccReal2D arr = - unsafePerformIO $ - createCArray (arrayBounds2DFromAccDims $ A.arrayShape arr) $ \ptr -> - AIO.toPtr arr ((), ptr) + CArray.Array + (arrayBounds2DFromAccDims $ A.arrayShape arr) + (AIO.toForeignPtrs arr) cArrayFromAccComplex1D :: - (A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - Array DIM1 (Complex a) -> CArray Int (Complex a) + (ComplexElement a ac) => + Array DIM1 ac -> CArray ShapeInt ac cArrayFromAccComplex1D arr = cArrayFromAccComplex (arrayBounds1DFromAccDims $ A.arrayShape arr) arr cArrayFromAccComplex2D :: - (A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - Array DIM2 (Complex a) -> CArray (Int,Int) (Complex a) + (ComplexElement a ac) => + Array DIM2 ac -> CArray (ShapeInt,ShapeInt) ac cArrayFromAccComplex2D arr = cArrayFromAccComplex (arrayBounds2DFromAccDims $ A.arrayShape arr) arr cArrayFromAccComplex :: - (Ix i, A.Shape sh, - A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - (i,i) -> Array sh (Complex a) -> CArray i (Complex a) -cArrayFromAccComplex bnds arr = unsafePerformIO $ do - fmap (uncurry (CArray.liftArray2 (Complex.:+))) $ - createCArrayAdd bnds $ \ptrReal -> - createCArray bnds $ \ptrImag -> - AIO.toPtr arr (((), ptrReal), ptrImag) + (CShape.C csh, A.Shape sh, ComplexElement a ac) => + csh -> Array sh ac -> CArray csh ac +cArrayFromAccComplex bnds arr = + CArray.Array bnds (castForeignPtrToComplex $ AIO.toForeignPtrs arr) +castForeignPtrToComplex :: ForeignPtr a -> ForeignPtr (Complex a) +castForeignPtrToComplex = castForeignPtr + withCArrayComplex :: - (Ix i, A.Shape sh, - A.Elt a, Storable a, RealFloat a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) => - (sh -> (i,i)) -> - (CArray i (Complex a) -> CArray i (Complex a)) -> - Array sh (Complex a) -> Array sh (Complex a) + (CShape.C csh, A.Shape sh, ComplexElement a ac) => + (sh -> csh) -> + (CArray csh ac -> CArray csh ac) -> + Array sh ac -> Array sh ac withCArrayComplex bndsFromSh f arr = let sh = A.arrayShape arr in accFromCArrayComplex sh $ f $ cArrayFromAccComplex (bndsFromSh sh) arr -createCArrayAdd :: - (Ix i, Storable e) => - (i,i) -> (Ptr e -> IO a) -> IO (CArray i e, a) -createCArrayAdd bnds create = do - ref <- newIORef (error "uninitialized inner value") - arr <- createCArray bnds $ writeIORef ref <=< create - fmap ((,) arr) $ readIORef ref +arrayBounds1DFromAccDims :: DIM1 -> ShapeInt +arrayBounds1DFromAccDims (Z :. i) = CShape.ZeroBased i +arrayBounds2DFromAccDims :: DIM2 -> (ShapeInt, ShapeInt) +arrayBounds2DFromAccDims (Z :. i :. j) = + (CShape.ZeroBased i, CShape.ZeroBased j) -arrayBounds1DFromAccDims :: DIM1 -> (Int, Int) -arrayBounds1DFromAccDims (Z :. i) = (0, i-1) -arrayBounds2DFromAccDims :: DIM2 -> ((Int, Int), (Int, Int)) -arrayBounds2DFromAccDims (Z :. i :. j) = ((0,0), (i-1,j-1)) +newtype Cube sh = Cube sh + +instance (A.Shape sh) => CShape.C (Cube sh) where + size (Cube sh) = Shape.size sh diff --git a/src/Data/Array/Accelerate/FFTW/Manifest.hs b/src/Data/Array/Accelerate/FFTW/Manifest.hs --- a/src/Data/Array/Accelerate/FFTW/Manifest.hs +++ b/src/Data/Array/Accelerate/FFTW/Manifest.hs @@ -1,66 +1,99 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ConstraintKinds #-} module Data.Array.Accelerate.FFTW.Manifest ( Transform, - Element, dft, idft, dft2d, idft2d, ) where -import qualified Math.FFT as FFT -import Math.FFT.Base (FFTWReal) - -import qualified Data.Array.Accelerate.CArray.Conversion as Conv - -import qualified Data.Array.Accelerate.IO as AIO +import qualified Data.Array.Accelerate.FFTW.Private as Batch import qualified Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Sugar (EltRepr, EltRepr') -import Data.Array.Accelerate (Array, (:.)((:.))) +import Data.Array.Accelerate.FFTW.Private (Transform) +import Data.Array.Accelerate ((:.)) +import Data.Array.Accelerate.Data.Complex (Complex) import Foreign.Storable.Complex () -import Data.Array.Accelerate.Data.Complex (Complex) +import qualified Numeric.Netlib.Class as Class -import Foreign.Ptr (Ptr) +{- $setup +>>> import qualified Data.Array.Accelerate.Utility.Lift.Exp as Exp +>>> import qualified Data.Array.Accelerate.Interpreter as AI +>>> import qualified Data.Array.Accelerate as A +>>> import Data.Array.Accelerate.Utility.Lift.Exp (expr) +>>> import Data.Array.Accelerate.Data.Complex (Complex((:+))) +>>> import Data.Array.Accelerate ((:.)((:.))) +>>> +>>> roundComplex :: A.Exp (Complex Float) -> A.Exp (Complex Int) +>>> roundComplex = +>>> Exp.modify (expr:+expr) $ \(r:+i) -> A.round r :+ (A.round i :: A.Exp Int) +>>> +>>> roundComplexArray :: +>>> (A.Shape sh) => A.Array sh (Complex Float) -> A.Array sh (Complex Int) +>>> roundComplexArray = AI.run1 (A.map roundComplex) +-} -type Bounds i = (i,i) -type Transform sh a = Array sh a -> Array sh a - -type Element a = - (FFTWReal a, A.Elt a, - AIO.BlockPtrs (EltRepr a) ~ ((), Ptr a), - AIO.BlockPtrs (EltRepr' a) ~ Ptr a) - +{- | +>>> roundComplexArray $ dft (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) +Matrix (Z :. 3 :. 3) + [ 1000 :+ 0, 1000 :+ 0, 1000 :+ 0, + 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866, + 1000 :+ 0, (-500) :+ 866, (-500) :+ (-866)] +-} dft :: - (A.Shape sh, Element a) => + (A.Shape sh, Class.Real a) => Transform (sh:.Int) (Complex a) -dft = Conv.withCArrayComplex bnds1 $ FFT.dftN [1] +dft = Batch.runComplexTransform $ Class.switchReal Batch.dft Batch.dft +{- | +>>> roundComplexArray $ idft $ dft (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) +Matrix (Z :. 3 :. 3) + [ 3000 :+ 0, 0 :+ 0, 0 :+ 0, + 0 :+ 0, 3000 :+ 0, 0 :+ 0, + 0 :+ 0, 0 :+ 0, 3000 :+ 0] +-} idft :: - (A.Shape sh, Element a) => + (A.Shape sh, Class.Real a) => Transform (sh:.Int) (Complex a) -idft = Conv.withCArrayComplex bnds1 $ FFT.dftN [1] +idft = Batch.runComplexTransform $ Class.switchReal Batch.idft Batch.idft -bnds1 :: (A.Shape sh) => sh:.Int -> Bounds (Int,Int) -bnds1 (sh:.n) = ((0,0), (A.arraySize sh-1, n-1)) +{- | +>>> roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,0,0, 0,0,0]) +Matrix (Z :. 3 :. 3) + [ 1000 :+ 0, 1000 :+ 0, 1000 :+ 0, + 1000 :+ 0, 1000 :+ 0, 1000 :+ 0, + 1000 :+ 0, 1000 :+ 0, 1000 :+ 0] +>>> roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [0,1000,0, 0,0,0, 0,0,0]) +Matrix (Z :. 3 :. 3) + [ 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866, + 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866, + 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866] + +>>> roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) +Matrix (Z :. 3 :. 3) + [ 3000 :+ 0, 0 :+ 0, 0 :+ 0, + 0 :+ 0, 0 :+ 0, 3000 :+ 0, + 0 :+ 0, 3000 :+ 0, 0 :+ 0] +-} dft2d :: - (A.Shape sh, Element a) => + (A.Shape sh, Class.Real a) => Transform (sh:.Int:.Int) (Complex a) -dft2d = - Conv.withCArrayComplex bnds2 $ FFT.dftN [1,2] +dft2d = Batch.runComplexTransform $ Class.switchReal Batch.dft2d Batch.dft2d +{- | +>>> roundComplexArray $ idft2d $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) +Matrix (Z :. 3 :. 3) + [ 9000 :+ 0, 0 :+ 0, 0 :+ 0, + 0 :+ 0, 9000 :+ 0, 0 :+ 0, + 0 :+ 0, 0 :+ 0, 9000 :+ 0] +-} idft2d :: - (A.Shape sh, Element a) => + (A.Shape sh, Class.Real a) => Transform (sh:.Int:.Int) (Complex a) -idft2d = - Conv.withCArrayComplex bnds2 $ FFT.idftN [1,2] - -bnds2 :: (A.Shape sh) => sh:.Int:.Int -> Bounds (Int,Int,Int) -bnds2 (sh:.n:.m) = ((0,0,0), (A.arraySize sh-1, n-1, m-1)) +idft2d = Batch.runComplexTransform $ Class.switchReal Batch.idft2d Batch.idft2d diff --git a/src/Data/Array/Accelerate/FFTW/Private.hs b/src/Data/Array/Accelerate/FFTW/Private.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/FFTW/Private.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ConstraintKinds #-} +module Data.Array.Accelerate.FFTW.Private where + +import qualified Numeric.FFTW.Batch as Batch +import qualified Numeric.FFTW.Shape as Spectrum +import qualified Numeric.Netlib.Class as Class + +import qualified Data.Array.Accelerate.CArray.Conversion as Conv +import qualified Data.Array.Accelerate as A +import Data.Array.Accelerate (Array, (:.)((:.))) + +import qualified Data.Array.Comfort.Shape as CShape + +import Foreign.Storable.Complex () + +import Data.Array.Accelerate.Data.Complex (Complex) + + +type ShapeCyclic = CShape.Cyclic Int + +type Transform sh a = Array sh a -> Array sh a + +newtype ComplexTransform sh a = + ComplexTransform {runComplexTransform :: Transform sh (Complex a)} + +type Element a ac = (Class.Real a, Conv.ComplexElement a ac) + +complexTransform :: + (A.Shape sh, CShape.C loop, Spectrum.MultiCyclic csh, Element a ac) => + (sh -> (loop, csh)) -> Batch.Sign -> ComplexTransform sh a +complexTransform bnds sign = + ComplexTransform $ Conv.withCArrayComplex bnds $ Batch.fourier sign + + +dft :: + (A.Shape sh, Element a ac) => + ComplexTransform (sh:.Int) a +dft = complexTransform bnds1 Batch.Forward + +idft :: + (A.Shape sh, Element a ac) => + ComplexTransform (sh:.Int) a +idft = complexTransform bnds1 Batch.Backward + +bnds1 :: (A.Shape sh) => sh:.Int -> (Conv.Cube sh, ShapeCyclic) +bnds1 (sh:.n) = (Conv.Cube sh, CShape.Cyclic n) + + +dft2d :: + (A.Shape sh, Element a ac) => + ComplexTransform (sh:.Int:.Int) a +dft2d = complexTransform bnds2 Batch.Forward + +idft2d :: + (A.Shape sh, Element a ac) => + ComplexTransform (sh:.Int:.Int) a +idft2d = complexTransform bnds2 Batch.Backward + +bnds2 :: + (A.Shape sh) => sh:.Int:.Int -> (Conv.Cube sh, (ShapeCyclic,ShapeCyclic)) +bnds2 (sh:.n:.m) = (Conv.Cube sh, (CShape.Cyclic n, CShape.Cyclic m)) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,10 @@ +-- Do not edit! Automatically created with doctest-extract. +module Main where + +import qualified Test.Data.Array.Accelerate.FFTW.Manifest + +import qualified Test.DocTest.Driver as DocTest + +main :: IO () +main = DocTest.run $ do + Test.Data.Array.Accelerate.FFTW.Manifest.test diff --git a/test/Test/Data/Array/Accelerate/FFTW/Manifest.hs b/test/Test/Data/Array/Accelerate/FFTW/Manifest.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Array/Accelerate/FFTW/Manifest.hs @@ -0,0 +1,69 @@ +-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Accelerate/FFTW/Manifest.hs +{-# LINE 22 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + +module Test.Data.Array.Accelerate.FFTW.Manifest where + +import Data.Array.Accelerate.FFTW.Manifest +import Test.DocTest.Base +import qualified Test.DocTest.Driver as DocTest + +{-# LINE 23 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} +import qualified Data.Array.Accelerate.Utility.Lift.Exp as Exp +import qualified Data.Array.Accelerate.Interpreter as AI +import qualified Data.Array.Accelerate as A +import Data.Array.Accelerate.Utility.Lift.Exp (expr) +import Data.Array.Accelerate.Data.Complex (Complex((:+))) +import Data.Array.Accelerate ((:.)((:.))) + +roundComplex :: A.Exp (Complex Float) -> A.Exp (Complex Int) +roundComplex = + Exp.modify (expr:+expr) $ \(r:+i) -> A.round r :+ (A.round i :: A.Exp Int) + +roundComplexArray :: + (A.Shape sh) => A.Array sh (Complex Float) -> A.Array sh (Complex Int) +roundComplexArray = AI.run1 (A.map roundComplex) + +test :: DocTest.T () +test = do + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:41: " +{-# LINE 41 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 41 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ dft (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 1000 :+ 0, 1000 :+ 0, 1000 :+ 0,"],ExpectedLine [LineChunk " 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866,"],ExpectedLine [LineChunk " 1000 :+ 0, (-500) :+ 866, (-500) :+ (-866)]"]] + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:53: " +{-# LINE 53 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 53 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ idft $ dft (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 3000 :+ 0, 0 :+ 0, 0 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 3000 :+ 0, 0 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 0 :+ 0, 3000 :+ 0]"]] + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:66: " +{-# LINE 66 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 66 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,0,0, 0,0,0]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 1000 :+ 0, 1000 :+ 0, 1000 :+ 0,"],ExpectedLine [LineChunk " 1000 :+ 0, 1000 :+ 0, 1000 :+ 0,"],ExpectedLine [LineChunk " 1000 :+ 0, 1000 :+ 0, 1000 :+ 0]"]] + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:72: " +{-# LINE 72 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 72 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [0,1000,0, 0,0,0, 0,0,0]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866,"],ExpectedLine [LineChunk " 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866,"],ExpectedLine [LineChunk " 1000 :+ 0, (-500) :+ (-866), (-500) :+ 866]"]] + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:78: " +{-# LINE 78 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 78 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 3000 :+ 0, 0 :+ 0, 0 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 0 :+ 0, 3000 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 3000 :+ 0, 0 :+ 0]"]] + DocTest.printPrefix "Data.Array.Accelerate.FFTW.Manifest:90: " +{-# LINE 90 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + DocTest.example( +{-# LINE 90 "src/Data/Array/Accelerate/FFTW/Manifest.hs" #-} + roundComplexArray $ idft2d $ dft2d (A.fromList (A.Z:.3:.3) [1000,0,0, 0,1000,0, 0,0,1000]) + ) + [ExpectedLine [LineChunk "Matrix (Z :. 3 :. 3)"],ExpectedLine [LineChunk " [ 9000 :+ 0, 0 :+ 0, 0 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 9000 :+ 0, 0 :+ 0,"],ExpectedLine [LineChunk " 0 :+ 0, 0 :+ 0, 9000 :+ 0]"]]