module Frontend.Tracklet.Filter where
import Prelude
import Data.Array (dropWhile, head, init, last, tail, zipWith)
import Data.DateTime (DateTime, diff)
import Data.Foldable (sum)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Time.Duration (class Duration, Seconds(..), convertDuration)
import Frontend.Types (Box(..), Vec2(..), Tracklet)
import Math (sqrt)
type TrackletFilter = Tracklet -> Boolean
distanceAtLeast :: Number -> TrackletFilter
distanceAtLeast n t = (_ >= n) $ sum $ fromMaybe [0.0] $ (zipWith dist <$> init t <*> tail t) where
dist {p: V2 x1 y1} {p: V2 x2 y2} = sqrt $ (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)
durationAtLeast :: forall d. Duration d => d -> TrackletFilter
durationAtLeast d t = fromMaybe false do
h <- head t
l <- last t
let d' = diff l.t h.t :: Seconds
pure $ d' >= (convertDuration d)
insideBox :: Box -> PointFilter
insideBox (Box {x0, y0, x1, y1}) {p: (V2 x y)} =
x0 <= x && x <= x1 && y0 <= y && y <= y1
first :: PointFilter -> Tracklet -> Boolean
first = runParser <<< one
type PointFilter = { t :: DateTime, p :: Vec2 } -> Boolean
type Parser = Tracklet -> Maybe Tracklet
runParser :: Parser -> Tracklet -> Boolean
runParser p = isJust <<< p
any :: PointFilter -> Parser
any f = until f `andThen` one f
until :: PointFilter -> Parser
until f = many (not <$> f)
many :: PointFilter -> Parser
many f = Just <<< dropWhile f
one :: PointFilter -> Parser
one f t = case f <$> head t of
Just true -> tail t
_ -> Nothing
andThen :: Parser -> Parser -> Parser
andThen p q t = p t >>= q
type HLine = {x0 :: Number, x1 :: Number, y :: Number}
data Direction = Up | Dn
duration :: forall d. Duration d => d -> Parser
duration d t = do
h <- head t
let pred = dropWhile (\x -> (diff x.t h.t :: Seconds) < convertDuration d) t
case pred of
[] -> Nothing
l -> Just l
hLine :: HLine -> Direction -> Parser
hLine {x0, x1, y} dir = let
rt = Box {x0, x1, y0: y + 0.5, y1: y + 2.0}
rb = Box {x0, x1, y0: y - 2.0, y1: y - 0.5}
{r1, r2} = case dir of
Dn -> {r1: rt, r2: rb}
Up -> {r1: rb, r2: rt}
in until (insideBox r1) `andThen` one (insideBox r1) `andThen` until (insideBox r2) `andThen` one (insideBox r2)