{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Eventlog.Bands (bands, series, bandsToSeries) where

import Control.Monad (forM_)
import Control.Monad.ST (runST)
import Data.Array.Base (unsafeFreezeSTUArray, (!), bounds)
import Data.Array.ST (writeArray, readArray, newArray)
import Data.Array.Unboxed (UArray)
import Data.Map (Map, lookup, size, foldrWithKey)
import Prelude hiding (lookup, lines, words, length)
import Eventlog.Types
import Data.HashTable.ST.Basic hiding (lookup)
import Data.Aeson hiding (Series)
import GHC.Generics
import Data.Set (Set, notMember)

bands :: Header -> Map Bucket Int -> [Frame] -> (UArray Int Double, UArray (Int, Int) Double)
bands :: Header
-> Map Bucket Int
-> [Frame]
-> (UArray Int Double, UArray (Int, Int) Double)
bands Header
h Map Bucket Int
bs [Frame]
frames = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  STUArray s Int Double
times <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
1, Header -> Int
hCount Header
h) Double
0
  STUArray s (Int, Int) Double
vals  <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((-Int
1,Int
1), (forall k a. Map k a -> Int
Data.Map.size Map Bucket Int
bs, Header -> Int
hCount Header
h)) Double
0
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Frame]
frames) forall a b. (a -> b) -> a -> b
$ \(Int
i, (Frame Double
t [Sample]
ss)) -> do
    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Double
times Int
i Double
t
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sample]
ss forall a b. (a -> b) -> a -> b
$ \(Sample Bucket
k Double
v) -> do
      case Bucket
k forall k a. Ord k => k -> Map k a -> Maybe a
`lookup` Map Bucket Int
bs of
        Maybe Int
Nothing -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Int, Int) Double
vals (Int
0, Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Double
v) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s (Int, Int) Double
vals (Int
0, Int
i)
        Just Int
b  -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Int, Int) Double
vals (Int
b, Int
i) Double
v
  UArray Int Double
times' <- forall s i e. STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray STUArray s Int Double
times
  UArray (Int, Int) Double
vals'  <- forall s i e. STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray STUArray s (Int, Int) Double
vals
  forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Double
times', UArray (Int, Int) Double
vals')

bandsToSeries :: Map Bucket Int -> (UArray Int Double, UArray (Int, Int) Double)
              -> [Series]
bandsToSeries :: Map Bucket Int
-> (UArray Int Double, UArray (Int, Int) Double) -> [Series]
bandsToSeries Map Bucket Int
ks (UArray Int Double
ts, UArray (Int, Int) Double
vs) =
  let (Int
t1, Int
tn) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Double
ts
      go :: Bucket -> Int -> [Series] -> [Series]
go Bucket
k Int
v [Series]
rs = Bucket -> [(Double, Double)] -> Series
Series Bucket
k [(Double, Double)]
go_1 forall a. a -> [a] -> [a]
: [Series]
rs
        where
          go_1 :: [(Double, Double)]
          go_1 :: [(Double, Double)]
go_1 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Int
t1 .. Int
tn] forall a b. (a -> b) -> a -> b
$ \Int
t -> (UArray Int Double
ts forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
t, UArray (Int, Int) Double
vs forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
v, Int
t))
  in forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey Bucket -> Int -> [Series] -> [Series]
go (Bucket -> Int -> [Series] -> [Series]
go (Text -> Bucket
Bucket Text
"OTHER") Int
0 []) Map Bucket Int
ks

data Series = Series { Series -> Bucket
key :: Bucket, Series -> [(Double, Double)]
values :: [(Double, Double)] }
  deriving (Int -> Series -> ShowS
[Series] -> ShowS
Series -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Series] -> ShowS
$cshowList :: [Series] -> ShowS
show :: Series -> String
$cshow :: Series -> String
showsPrec :: Int -> Series -> ShowS
$cshowsPrec :: Int -> Series -> ShowS
Show, [Series] -> Encoding
[Series] -> Value
Series -> Encoding
Series -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Series] -> Encoding
$ctoEncodingList :: [Series] -> Encoding
toJSONList :: [Series] -> Value
$ctoJSONList :: [Series] -> Value
toEncoding :: Series -> Encoding
$ctoEncoding :: Series -> Encoding
toJSON :: Series -> Value
$ctoJSON :: Series -> Value
ToJSON, forall x. Rep Series x -> Series
forall x. Series -> Rep Series x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Series x -> Series
$cfrom :: forall x. Series -> Rep Series x
Generic)

series :: Set Bucket -> [Frame] ->  [Series]
series :: Set Bucket -> [Frame] -> [Series]
series Set Bucket
ks [Frame]
fs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  HashTable s Bucket [(Double, Double)]
m <- forall s k v. ST s (HashTable s k v)
new
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse [Frame]
fs) forall a b. (a -> b) -> a -> b
$ \(Frame Double
t [Sample]
s) ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sample]
s forall a b. (a -> b) -> a -> b
$ \(Sample Bucket
k Double
v) -> do
      let ins :: Maybe [(Double, Double)] -> (Maybe [(Double, Double)], ())
ins Maybe [(Double, Double)]
_ | forall a. Ord a => a -> Set a -> Bool
notMember Bucket
k Set Bucket
ks = (forall a. Maybe a
Nothing, ())
          ins Maybe [(Double, Double)]
Nothing = (forall a. a -> Maybe a
Just [(Double
t, Double
v)]  , ())
          ins (Just [(Double, Double)]
ss) = (forall a. a -> Maybe a
Just ((Double
t,Double
v) forall a. a -> [a] -> [a]
: [(Double, Double)]
ss), ())
      forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate HashTable s Bucket [(Double, Double)]
m Bucket
k Maybe [(Double, Double)] -> (Maybe [(Double, Double)], ())
ins
  forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM (\[Series]
r (Bucket
k,[(Double, Double)]
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> [(Double, Double)] -> Series
Series Bucket
k [(Double, Double)]
v forall a. a -> [a] -> [a]
: [Series]
r)) [] HashTable s Bucket [(Double, Double)]
m