pijul nest
guest [sign in]

Fork channel

Create a new channel as a copy of main.

Rename channel

Rename main to:

Delete channel

Delete main? This cannot be undone.

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 }