{-# LINE 1 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
module Numeric.FFT.Vector.Unnormalized(
run,
plan,
execute,
dft,
idft,
dftR2C,
dftC2R,
dct1,
dct2,
dct3,
dct4,
dst1,
dst2,
dst3,
dst4,
) where
import Numeric.FFT.Vector.Base
import Foreign
import Foreign.C
import Data.Complex
type CDirection = CInt
type CKind = (Word32)
{-# LINE 47 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
foreign import ccall unsafe fftw_plan_dft_1d
:: CInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> CDirection
-> CFlags -> IO (Ptr CPlan)
foreign import ccall unsafe fftw_plan_dft_r2c_1d
:: CInt -> Ptr Double -> Ptr (Complex Double) -> CFlags -> IO (Ptr CPlan)
foreign import ccall unsafe fftw_plan_dft_c2r_1d
:: CInt -> Ptr (Complex Double) -> Ptr Double -> CFlags -> IO (Ptr CPlan)
foreign import ccall unsafe fftw_plan_r2r_1d
:: CInt -> Ptr Double -> Ptr Double -> CKind -> CFlags -> IO (Ptr CPlan)
dft1D :: CDirection -> Transform (Complex Double) (Complex Double)
dft1D :: CDirection -> Transform (Complex Double) (Complex Double)
dft1D CDirection
d = Transform {
inputSize :: Int -> Int
inputSize = Int -> Int
forall a. a -> a
id,
outputSize :: Int -> Int
outputSize = Int -> Int
forall a. a -> a
id,
creationSizeFromInput :: Int -> Int
creationSizeFromInput = Int -> Int
forall a. a -> a
id,
makePlan :: CDirection
-> Ptr (Complex Double)
-> Ptr (Complex Double)
-> CFlags
-> IO (Ptr CPlan)
makePlan = \CDirection
n Ptr (Complex Double)
a Ptr (Complex Double)
b -> IO (Ptr CPlan) -> IO (Ptr CPlan)
forall a. IO a -> IO a
withPlanner (IO (Ptr CPlan) -> IO (Ptr CPlan))
-> (CFlags -> IO (Ptr CPlan)) -> CFlags -> IO (Ptr CPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDirection
-> Ptr (Complex Double)
-> Ptr (Complex Double)
-> CDirection
-> CFlags
-> IO (Ptr CPlan)
fftw_plan_dft_1d CDirection
n Ptr (Complex Double)
a Ptr (Complex Double)
b CDirection
d,
normalization :: Int
-> Plan (Complex Double) (Complex Double)
-> Plan (Complex Double) (Complex Double)
normalization = (Plan (Complex Double) (Complex Double)
-> Plan (Complex Double) (Complex Double))
-> Int
-> Plan (Complex Double) (Complex Double)
-> Plan (Complex Double) (Complex Double)
forall a b. a -> b -> a
const Plan (Complex Double) (Complex Double)
-> Plan (Complex Double) (Complex Double)
forall a. a -> a
id
}
dft :: Transform (Complex Double) (Complex Double)
dft :: Transform (Complex Double) (Complex Double)
dft = CDirection -> Transform (Complex Double) (Complex Double)
dft1D (-CDirection
1)
{-# LINE 75 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
idft :: Transform (Complex Double) (Complex Double)
idft :: Transform (Complex Double) (Complex Double)
idft = CDirection -> Transform (Complex Double) (Complex Double)
dft1D (CDirection
1)
{-# LINE 81 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dftR2C :: Transform Double (Complex Double)
dftR2C :: Transform Double (Complex Double)
dftR2C = Transform {
inputSize :: Int -> Int
inputSize = Int -> Int
forall a. a -> a
id,
outputSize :: Int -> Int
outputSize = \Int
n -> Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
creationSizeFromInput :: Int -> Int
creationSizeFromInput = Int -> Int
forall a. a -> a
id,
makePlan :: CDirection
-> Ptr Double -> Ptr (Complex Double) -> CFlags -> IO (Ptr CPlan)
makePlan = \CDirection
n Ptr Double
a Ptr (Complex Double)
b -> IO (Ptr CPlan) -> IO (Ptr CPlan)
forall a. IO a -> IO a
withPlanner (IO (Ptr CPlan) -> IO (Ptr CPlan))
-> (CFlags -> IO (Ptr CPlan)) -> CFlags -> IO (Ptr CPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDirection
-> Ptr Double -> Ptr (Complex Double) -> CFlags -> IO (Ptr CPlan)
fftw_plan_dft_r2c_1d CDirection
n Ptr Double
a Ptr (Complex Double)
b,
normalization :: Int -> Plan Double (Complex Double) -> Plan Double (Complex Double)
normalization = (Plan Double (Complex Double) -> Plan Double (Complex Double))
-> Int
-> Plan Double (Complex Double)
-> Plan Double (Complex Double)
forall a b. a -> b -> a
const Plan Double (Complex Double) -> Plan Double (Complex Double)
forall a. a -> a
id
}
dftC2R :: Transform (Complex Double) Double
dftC2R :: Transform (Complex Double) Double
dftC2R = Transform {
inputSize :: Int -> Int
inputSize = \Int
n -> Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
outputSize :: Int -> Int
outputSize = Int -> Int
forall a. a -> a
id,
creationSizeFromInput :: Int -> Int
creationSizeFromInput = \Int
n -> Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),
makePlan :: CDirection
-> Ptr (Complex Double) -> Ptr Double -> CFlags -> IO (Ptr CPlan)
makePlan = \CDirection
n Ptr (Complex Double)
a Ptr Double
b -> IO (Ptr CPlan) -> IO (Ptr CPlan)
forall a. IO a -> IO a
withPlanner (IO (Ptr CPlan) -> IO (Ptr CPlan))
-> (CFlags -> IO (Ptr CPlan)) -> CFlags -> IO (Ptr CPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDirection
-> Ptr (Complex Double) -> Ptr Double -> CFlags -> IO (Ptr CPlan)
fftw_plan_dft_c2r_1d CDirection
n Ptr (Complex Double)
a Ptr Double
b,
normalization :: Int -> Plan (Complex Double) Double -> Plan (Complex Double) Double
normalization = (Plan (Complex Double) Double -> Plan (Complex Double) Double)
-> Int
-> Plan (Complex Double) Double
-> Plan (Complex Double) Double
forall a b. a -> b -> a
const Plan (Complex Double) Double -> Plan (Complex Double) Double
forall a. a -> a
id
}
r2rTransform :: CKind -> Transform Double Double
r2rTransform :: CKind -> Transform Double Double
r2rTransform CKind
kind = Transform {
inputSize :: Int -> Int
inputSize = Int -> Int
forall a. a -> a
id,
outputSize :: Int -> Int
outputSize = Int -> Int
forall a. a -> a
id,
creationSizeFromInput :: Int -> Int
creationSizeFromInput = Int -> Int
forall a. a -> a
id,
makePlan :: CDirection -> Ptr Double -> Ptr Double -> CFlags -> IO (Ptr CPlan)
makePlan = \CDirection
n Ptr Double
a Ptr Double
b -> IO (Ptr CPlan) -> IO (Ptr CPlan)
forall a. IO a -> IO a
withPlanner (IO (Ptr CPlan) -> IO (Ptr CPlan))
-> (CFlags -> IO (Ptr CPlan)) -> CFlags -> IO (Ptr CPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDirection
-> Ptr Double -> Ptr Double -> CKind -> CFlags -> IO (Ptr CPlan)
fftw_plan_r2r_1d CDirection
n Ptr Double
a Ptr Double
b CKind
kind,
normalization :: Int -> Plan Double Double -> Plan Double Double
normalization = (Plan Double Double -> Plan Double Double)
-> Int -> Plan Double Double -> Plan Double Double
forall a b. a -> b -> a
const Plan Double Double -> Plan Double Double
forall a. a -> a
id
}
dct1 :: Transform Double Double
dct1 :: Transform Double Double
dct1 = CKind -> Transform Double Double
r2rTransform (CKind
3)
{-# LINE 129 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dct2 :: Transform Double Double
dct2 :: Transform Double Double
dct2 = CKind -> Transform Double Double
r2rTransform (CKind
5)
{-# LINE 135 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dct3 :: Transform Double Double
dct3 :: Transform Double Double
dct3 = CKind -> Transform Double Double
r2rTransform (CKind
4)
{-# LINE 141 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dct4 :: Transform Double Double
dct4 :: Transform Double Double
dct4 = CKind -> Transform Double Double
r2rTransform (CKind
6)
{-# LINE 147 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dst1 :: Transform Double Double
dst1 :: Transform Double Double
dst1 = CKind -> Transform Double Double
r2rTransform (CKind
7)
{-# LINE 153 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dst2 :: Transform Double Double
dst2 :: Transform Double Double
dst2 = CKind -> Transform Double Double
r2rTransform (CKind
9)
{-# LINE 159 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dst3 :: Transform Double Double
dst3 :: Transform Double Double
dst3 = CKind -> Transform Double Double
r2rTransform (CKind
8)
{-# LINE 165 "Numeric/FFT/Vector/Unnormalized.hsc" #-}
dst4 :: Transform Double Double
dst4 :: Transform Double Double
dst4 = CKind -> Transform Double Double
r2rTransform (CKind
10)
{-# LINE 171 "Numeric/FFT/Vector/Unnormalized.hsc" #-}