> {-#  LANGUAGE Arrows  #-}
> module HSoM.Examples.SpectrumAnalysis where
> import Euterpea
> import Data.Complex (Complex ((:+)), polar)
> import Data.Maybe (listToMaybe, catMaybes)
> dft :: RealFloat a => [Complex a] -> [Complex a]
> dft xs = 
>   let  lenI = length xs
>        lenR = fromIntegral lenI
>        lenC = lenR :+ 0
>   in [  let i = -2 * pi * fromIntegral k / lenR
>         in (1/lenC) * sum [  (xs!!n) * exp (0 :+ i * fromIntegral n)
>                              | n <- [0,1..lenI-1] ]
>         | k <- [0,1..lenI-1] ]
> mkTerm :: Int -> Double -> [Complex Double]
> mkTerm num n = let f = 2 * pi / fromIntegral num
>                in [  sin (n * f * fromIntegral i) / n :+ 0
>                      | i <- [0,1..num-1] ]
> mkxa, mkxb, mkxc :: Int-> [Complex Double]
> mkxa num = mkTerm num 1
> mkxb num = zipWith (+) (mkxa num) (mkTerm num 3)
> mkxc num = zipWith (+) (mkxb num) (mkTerm num 5)
> printComplexL :: [Complex Double] -> IO ()
> printComplexL xs  =
>   let  f (i,rl:+im) = 
>             do  putStr (spaces (3 - length (show i))  )
>                 putStr (show i       ++ ":  ("        )
>                 putStr (niceNum rl  ++ ", "           )
>                 putStr (niceNum im  ++ ")\n"          )
>   in mapM_ f (zip [0..length xs - 1] xs)
> niceNum :: Double -> String
> niceNum d =
>   let  d' = fromIntegral (round (1e10 * d)) / 1e10
>        (dec, fra)  = break (== '.') (show d')
>        (fra',exp)  = break (== 'e') fra
>   in  spaces (3  - length dec) ++ dec ++ take 11 fra'
>       ++ exp ++ spaces (12 - length fra' - length exp)
> spaces :: Int -> String
> spaces  n = take n (repeat ' ')
> mkPulse :: Int -> [Complex Double]
> mkPulse n = 100 : take (n-1) (repeat 0)
> {-# LINE 721 "SpectrumAnalysis.lhs" #-}
> x1 num = let f = pi * 2 * pi / fromIntegral num
>          in map (:+ 0) [  sin (f * fromIntegral i)
>                           | i <- [0,1..num-1] ]
> {-# LINE 757 "SpectrumAnalysis.lhs" #-}
> mkPolars :: [Complex Double] -> [Complex Double]
> mkPolars = map ((\(m,p)-> m:+p) . polar)