{-|
Module      : TimeSeries.Window
Copyright   : (C) 2013 Parallel Scientific Labs, LLC
License     : GPL-2
Stability   : experimental
Portability : portable

Window for time series analysis.

Later these shall relate to memory and FPGA internal registers in
hardware...

-}
module TimeSeries.Window where

import Data.Array.Unboxed
import Data.List (intersperse)
import Data.Word
import Text.Printf (printf)
import Prelude hiding (length)
import qualified Prelude

import TimeSeries.PRG64

-- | Newtype for windowd data.
--
-- Shall relate to memory contents in hardware.
--
newtype Window = Window (UArray Word64 Double) deriving (Eq, Show)

-- | Considering to restrict window size to power of 2, at least for
-- initial phase.
type Size = Word64

-- | Random vector.
data RandomVector = RandomVector
  { -- | Unit random vector.
    unitRV :: Window
    -- | Control random vector, mentioned as /b/ in the paper.
  , controlRV :: Window
  } deriving (Eq, Show)

-- | Create window from assoc list.
fromList :: [Double] -> Window
fromList xs = Window $ array (0,sz) $ zip [0..] xs where
  sz = fromIntegral (Prelude.length xs - 1)

toList :: Window -> [Double]
toList (Window xs) = elems xs

-- | Window of given size, filled with zeros.
empty :: Size -> Window
empty sz = Window $ array (0,sz-1) [(i,0)|i <- [0..sz-1]]

-- | Put given 'Double' as first element, shifts all the other
-- element except for the last one, which being removed.
push :: Double -> Window -> Window
push v (Window arr) = Window (arr' // [(0,v)]) where
  arr' = ixmap (bounds arr) f arr
  f idx | idx == 0  = 0 -- temporary dummy value
        | otherwise = idx - 1

-- | Size 1 window containing given value.
singleton :: Double -> Window
singleton v = Window $ array (0,0) [(0,v)]

-- | Norm, by viewing window as vector.
--
-- >>> let x = fromList [0,3,4]
-- >>> let y = fromList [0,0,0]
-- >>> distance x y
-- 5.0
--
norm :: Window -> Window -> Double
norm (Window x) (Window y) =
  sqrt $ sum [(xi-yi)^(2::Int)|(xi,yi)<-zip (elems x) (elems y)]

-- | Append two windows, with shifting the contents of second window.
-- Last /n/ elements of second window is removed, where /n/ is number
-- of elements in first window.
append :: Window -> Window -> Window
append w@(Window wina) (Window winb) = Window (winc // assocs wina) where
  winc = ixmap (bounds winb) f winb
  f idx | idx < lengthA = 0
        | otherwise     = idx - lengthA
  lengthA = fromIntegral $ length w

-- | Sums up window elements.
sumWindow :: Window -> Double
sumWindow (Window arr) = sum $ elems arr

-- | Sums up square of window elements.
sumSqWindow :: Window -> Double
sumSqWindow (Window arr) = sum $ [x^(2::Int)|x<-elems arr]

-- | Dot product of given two windows.
dotp :: Window -> Window -> Double
dotp (Window wx) (Window wy) = sum $ zipWith (*) (elems wx) (elems wy)

-- | Dot produt of list of window.
dotps :: [Window] -> Window -> Window
dotps xss ys = fromList [dotp xs ys|xs <- xss]

-- | Copy contents of window to another.
copyContents ::
  Window    -- ^ Destination window.
  -> Window -- ^ Source window.
  -> Window
copyContents (Window to) (Window from) =
  Window $ ixmap (bounds to) id from

-- | Create window for random vectors.
randomVector ::
  Integer    -- ^ Random seed.
  -> Size    -- ^ /bw/, size of basic window.
  -> Size    -- ^ /nb/, size of control vector.
  -> RandomVector
randomVector seed bw nb = RandomVector (fromList r) (fromList b) where
  (r,b) = rnd bw nb (fromIntegral seed)

-- | Create whole random vector from 'RandomVector'.
--
-- Unit random vector and control vector in given 'RandomVector' is
-- convolved.
--
wholeRandomVector ::
  RandomVector
  -- ^ Random vector used to convolve the contents.
  -> Window
  -- ^ Random vector with size /bw * nb/.
wholeRandomVector (RandomVector (Window u) (Window c)) =
  let bw = rangeSize $ bounds u
      nb = rangeSize $ bounds c
      u' = concat $ replicate (fromIntegral nb) (elems u)
      c' = concatMap (replicate (fromIntegral bw)) (elems c)
  in  fromList $ zipWith (*) u' c'

-- | Show contents of window with 'printf'.
pretty :: Window -> String
pretty (Window w) =
  concat . intersperse ", " $  map (printf "%.12f") (elems w)

-- | Average of window contents.
average :: Window -> Double
average win@(Window w) = sum w' / fromIntegral (length win) where
  w' = elems w

-- | Variance of window contents.
variance :: Window -> Double
variance win@(Window w) = sqrt (mean [sq wi|wi<-w'] - sq (mean w')) where
  w' = elems w
  mean xs = sum xs / fromIntegral (length win)
  sq x = x ^ (2::Int)

-- | Length of window.
length :: Window -> Int
length (Window w) = rangeSize $ bounds w