Statistics.hs
module Frontend.Component.Statistics where
import Prelude
import Data.Array (elemIndex, filter, head, last, length, sortWith, take, zip, (!!))
import Data.DateTime (DateTime)
import Data.Either (Either, hush)
import Data.Foldable (and, or)
import Data.Int (round, toNumber)
import Data.JSDate (getTimezoneOffset, now)
import Data.List (fromFoldable)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class.Console (log)
import Frontend.Api (fetchTrackletsSOA)
import Frontend.Dom (card)
import Frontend.Tracklet.Filter (insideBox)
import Frontend.Tracklets (TrackletSOA, unTrackletSOA)
import Frontend.Types (Config(..), Info(..), Vec2(..))
import Frontend.Util (classes, formatDateTime')
import Global (encodeURIComponent)
import Halogen (liftEffect)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Record.CSV.Printer (printCSVWithOrder)
import Record.CSV.Printer.SList (SLProxy(..))
import Record.CSV.Printer.SList (type (:), type (!), SLProxy(..))
type Props =
{ len :: Int
, id :: Int
, startTime :: DateTime
, duration :: Number
, durationInShop :: Number
, startZones :: Array Boolean
, endZones :: Array Boolean
, throughZones :: Array Boolean
, throughShop :: Boolean
}
type Slots =
()
-- _plot = (SProxy :: SProxy "plot")
type State =
{ info :: Info
, config :: Config
, fetching :: Boolean
, tracklets :: Maybe (Array TrackletSOA)
, props :: Maybe (Array Props)
}
data Action
= Initialize
| SetInput Input
| FetchData
type Input = { info :: Info, config :: Config }
component :: forall query output m. MonadAff m => H.Component HH.HTML query Input output m
component = H.mkComponent
{ initialState: \{info, config} ->
{ info
, config
, fetching: false
, tracklets: Nothing
, props: Nothing
}
, render
, eval: H.mkEval H.defaultEval
{ handleAction = handleAction
, initialize = Just Initialize
, receive = Just <<< SetInput
}
}
render :: forall m. MonadAff m => State -> H.ComponentHTML Action Slots m
render state =
HH.div [ classes ["row"] ]
[ HH.div [ classes ["col-lg-12"] ]
[ card []
[ HH.text "Statistics" ]
[ statistics state
]
]
]
type Order
= "id"
: "startTime"
: "duration"
: "durationInShop"
: "startZone"
: "endZone"
! "throughShop"
toCsv :: Array String -> Array Props -> String
toCsv zoneNames props = fromMaybe "Error" $ encodeURIComponent =<< (hush csv) where
csv = printCSVWithOrder (SLProxy :: SLProxy Order) (fromFoldable (map csvTransform props))
csvTransform
{ len
, id
, startTime
, duration
, durationInShop
, startZones
, endZones
, throughZones
, throughShop
} =
{ id
, startTime: formatDateTime' startTime
, duration: round duration
, durationInShop: round durationInShop
, startZone: fromMaybe "-" $ (zoneNames !! _) =<< elemIndex true startZones
, endZone: fromMaybe "-" $ (zoneNames !! _) =<< elemIndex true endZones
, throughShop
}
statistics :: forall m. MonadAff m => State -> H.ComponentHTML Action Slots m
statistics {info: Info info, config: Config config, tracklets: mtracklets, fetching, props} = let
zoneNames = take 4 (_.name <$> config.zones)
in HH.div_
[ HH.button
[ HE.onClick $ const $ Just FetchData
, classes ["btn", "btn-primary", "btn-outline"]
] [HH.text "Fetch Data"]
, if fetching
then HH.span [ classes ["spinner-border", "spinner-border-sm", "mx-4"] ]
[ HH.span [ classes ["sr-only"] ] [ HH.text "Loading..." ]
]
else HH.text ""
, HH.div [ classes ["m-2"] ] case mtracklets of
Just tracklets ->
[ HH.text $ "Number of tracklets: " <> show (length tracklets)
]
Nothing ->
[ HH.text "No data." ]
, HH.div [ classes ["m-2"] ] case props of
Nothing -> []
Just props' ->
[ HH.a [HP.href $ "data:text/plain;charset=UTF-8," <> toCsv zoneNames props', HP.download "data.csv"] [HH.text "csv"]
]
]
cmpProps :: Config -> TrackletSOA -> Props
cmpProps (Config config) tr = let
{id, t0, t, x, y} = unTrackletSOA tr
shopZones = config.zones -- FIXME: checkout is inside the shop.
inShop p = and ((\{box} -> not $ insideBox box p) <$> shopZones)
in
{ len: length t
, id
, startTime: t0
, duration: fromMaybe 0.0 $ last t
, durationInShop: let
lenInShop = length $ filter identity $ zip x y <#> \(Tuple x' y') ->
inShop { p: V2 x' y', t: t0 }
in toNumber lenInShop / toNumber (length t) * (fromMaybe 0.0 $ last t)
, startZones: fromMaybe (config.zones $> false) do
x0 <- head x
y0 <- head y
pure $ config.zones <#> \zone ->
insideBox zone.box { p: V2 x0 y0, t: t0 }
, endZones: fromMaybe (config.zones $> false) do
x0 <- last x
y0 <- last y
pure $ config.zones <#> \zone ->
insideBox zone.box { p: V2 x0 y0, t: t0 }
, throughZones: config.zones <#> \zone ->
or $ zip x y <#> \(Tuple x' y') ->
insideBox zone.box { p: V2 x' y', t: t0 }
, throughShop: or $ zip x y <#> \(Tuple x' y') ->
inShop { p: V2 x' y', t: t0 }
}
handleAction :: forall output m. MonadAff m => Action -> H.HalogenM State Action Slots output m Unit
handleAction = case _ of
Initialize -> do
{info: Info info, config: Config config} <- H.get
pure unit
SetInput { info, config } -> H.modify_ _ { info = info, config = config }
FetchData -> do
{info: Info info, config: Config config} <- H.get
H.modify_ _ { fetching = true }
-- Get data
tracklets <- liftAff $ fetchTrackletsSOA info.first_dt info.last_dt 10
-- FIXME: Get offset from data, not from now
tzOffset <- liftEffect $ now >>= getTimezoneOffset
-- Compute statistics
let
props :: Either String (Array Props)
props = sortWith _.id <<< map (cmpProps (Config config)) <$> tracklets
log $ show props
H.modify_ _ { fetching = false, tracklets = hush tracklets, props = hush props }