{-# LINE 1 "Numeric/FFT/Vector/Unnormalized/Multi.hsc" #-}
{- |
Raw, unnormalized multi-dimensional versions of the transforms in @fftw@.

Note that the forwards and backwards transforms of this module are not actually
inverses.  For example, @run idft (run dft v) /= v@ in general.

For more information on the individual transforms, see
<http://www.fftw.org/fftw3_doc/What-FFTW-Really-Computes.html>.

@since 0.2
-}

module Numeric.FFT.Vector.Unnormalized.Multi
  (
        -- * Creating and executing 'Plan's
        run,
        plan,
        execute,
        -- * Complex-to-complex transforms
        dft,
        idft,
        -- * Real-to-complex transforms
        dftR2C,
        dftC2R,
  ) where

import Numeric.FFT.Vector.Base
import Foreign
import Foreign.C
import Data.Complex



-- | Whether the complex fft is forwards or backwards.
type CDirection = CInt

foreign import ccall unsafe fftw_plan_dft
    :: CInt -> Ptr CInt -> Ptr (Complex Double) -> Ptr (Complex Double)
        -> CDirection -> CFlags -> IO (Ptr CPlan)

foreign import ccall unsafe fftw_plan_dft_r2c
    :: CInt -> Ptr CInt -> Ptr Double -> Ptr (Complex Double) -> CFlags
        -> IO (Ptr CPlan)

foreign import ccall unsafe fftw_plan_dft_c2r
    :: CInt -> Ptr CInt -> Ptr (Complex Double) -> Ptr Double -> CFlags
        -> IO (Ptr CPlan)

dftND :: CDirection -> TransformND (Complex Double) (Complex Double)
dftND :: CDirection -> TransformND (Complex Double) (Complex Double)
dftND CDirection
d = TransformND
  { inputSizeND :: Int -> Int
inputSizeND = Int -> Int
forall a. a -> a
id
  , outputSizeND :: Int -> Int
outputSizeND = Int -> Int
forall a. a -> a
id
  , creationSizeFromInputND :: Int -> Int
creationSizeFromInputND = Int -> Int
forall a. a -> a
id
  , makePlanND :: CDirection
-> Ptr CDirection
-> Ptr (Complex Double)
-> Ptr (Complex Double)
-> CFlags
-> IO (Ptr CPlan)
makePlanND = \CDirection
rk Ptr CDirection
dims 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 CDirection
-> Ptr (Complex Double)
-> Ptr (Complex Double)
-> CDirection
-> CFlags
-> IO (Ptr CPlan)
fftw_plan_dft CDirection
rk Ptr CDirection
dims Ptr (Complex Double)
a Ptr (Complex Double)
b CDirection
d
  , normalizationND :: Vector Int
-> Plan (Complex Double) (Complex Double)
-> Plan (Complex Double) (Complex Double)
normalizationND = (Plan (Complex Double) (Complex Double)
 -> Plan (Complex Double) (Complex Double))
-> Vector 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
  }

-- | A forward discrete Fourier transform.  The output and input sizes are the same (@n@).
dft :: TransformND (Complex Double) (Complex Double)
dft :: TransformND (Complex Double) (Complex Double)
dft = CDirection -> TransformND (Complex Double) (Complex Double)
dftND (-CDirection
1)
{-# LINE 61 "Numeric/FFT/Vector/Unnormalized/Multi.hsc" #-}

-- | A backward discrete Fourier transform.  The output and input sizes are the same (@n@).
idft :: TransformND (Complex Double) (Complex Double)
idft :: TransformND (Complex Double) (Complex Double)
idft = CDirection -> TransformND (Complex Double) (Complex Double)
dftND (CDirection
1)
{-# LINE 65 "Numeric/FFT/Vector/Unnormalized/Multi.hsc" #-}

-- | A forward discrete Fourier transform with real data.  If the input size is @n0 * ... * nk@,
-- the output size will be @n0 * ... * nk \`div\` 2 + 1@.
dftR2C :: TransformND Double (Complex Double)
dftR2C :: TransformND Double (Complex Double)
dftR2C = TransformND {
              inputSizeND :: Int -> Int
inputSizeND = Int -> Int
forall a. a -> a
id,
              outputSizeND :: Int -> Int
outputSizeND = \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,
              creationSizeFromInputND :: Int -> Int
creationSizeFromInputND = Int -> Int
forall a. a -> a
id,
              makePlanND :: CDirection
-> Ptr CDirection
-> Ptr Double
-> Ptr (Complex Double)
-> CFlags
-> IO (Ptr CPlan)
makePlanND = \CDirection
rk Ptr CDirection
dims 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 CDirection
-> Ptr Double
-> Ptr (Complex Double)
-> CFlags
-> IO (Ptr CPlan)
fftw_plan_dft_r2c CDirection
rk Ptr CDirection
dims Ptr Double
a Ptr (Complex Double)
b,
              normalizationND :: Vector Int
-> Plan Double (Complex Double) -> Plan Double (Complex Double)
normalizationND = (Plan Double (Complex Double) -> Plan Double (Complex Double))
-> Vector 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
          }

-- | A backward discrete Fourier transform which produces real data.
--
-- This 'Transform' behaves differently than the others:
--
--  - Calling @plan dftC2R n@ creates a 'Plan' whose /output/ size is @n@, and whose
--    /input/ size is @n \`div\` 2 + 1@.
--
--  - If @length v == n@, then @length (run dftC2R v) == 2*(n-1)@.
dftC2R :: TransformND (Complex Double) Double
dftC2R :: TransformND (Complex Double) Double
dftC2R = TransformND {
            inputSizeND :: Int -> Int
inputSizeND = \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,
            outputSizeND :: Int -> Int
outputSizeND = Int -> Int
forall a. a -> a
id,
            creationSizeFromInputND :: Int -> Int
creationSizeFromInputND = \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),
            makePlanND :: CDirection
-> Ptr CDirection
-> Ptr (Complex Double)
-> Ptr Double
-> CFlags
-> IO (Ptr CPlan)
makePlanND = \CDirection
rk Ptr CDirection
dims 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 CDirection
-> Ptr (Complex Double)
-> Ptr Double
-> CFlags
-> IO (Ptr CPlan)
fftw_plan_dft_c2r CDirection
rk Ptr CDirection
dims Ptr (Complex Double)
a Ptr Double
b,
            normalizationND :: Vector Int
-> Plan (Complex Double) Double -> Plan (Complex Double) Double
normalizationND = (Plan (Complex Double) Double -> Plan (Complex Double) Double)
-> Vector 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
        }