diff options
Diffstat (limited to 'lib/Extrapolation.hs')
| -rw-r--r-- | lib/Extrapolation.hs | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/lib/Extrapolation.hs b/lib/Extrapolation.hs index 389d047..759b31e 100644 --- a/lib/Extrapolation.hs +++ b/lib/Extrapolation.hs @@ -18,6 +18,7 @@ import qualified Data.Vector as V import GHC.Float (int2Double) import GHC.IO (unsafePerformIO) +import API (SentPing (..)) import Conduit (MonadIO (liftIO)) import Data.List (sortBy, sortOn) import Data.Ord (Down (..)) @@ -29,8 +30,7 @@ import Persist (Geopos (..), Station (..), Stop (..), Ticket (..), TicketId, Token (..), Tracker (..), - TrainAnchor (..), - TrainPing (..)) + TrainAnchor (..)) import Server.Util (utcToSeconds) -- | Determines how to extrapolate delays (and potentially other things) from the real-time @@ -44,7 +44,7 @@ class Extrapolator strategy where -> Ticket -> V.Vector (Stop, Station, TimeZoneSeries) -> V.Vector ShapePoint - -> TrainPing + -> SentPing -> TrainAnchor -- | extrapolate status at some time (i.e. "how much delay does the train have *now*?") @@ -65,14 +65,14 @@ instance Extrapolator LinearExtrapolator where -- (in case the train just stands still for a while, take the most recent update) extrapolateAtPosition _ history positionNow = fmap (minimumBy (compare `on` difference)) - $ NE.nonEmpty $ sortOn (Down . trainAnchorWhen) + $ NE.nonEmpty $ sortOn (Down . trainAnchorCreated) $ NE.filter (\a -> trainAnchorSequence a < positionNow) history where difference status = positionNow - trainAnchorSequence status - extrapolateAnchorFromPing _ ticketId Ticket{..} stops shape ping@TrainPing{..} = TrainAnchor - { trainAnchorCreated = trainPingTimestamp + extrapolateAnchorFromPing _ ticketId Ticket{..} stops shape ping@SentPing{..} = TrainAnchor + { trainAnchorCreated = sentPingTimestamp , trainAnchorTicket = ticketId - , trainAnchorWhen = utcToSeconds trainPingTimestamp ticketDay + , trainAnchorWhen = utcToSeconds sentPingTimestamp ticketDay , trainAnchorSequence , trainAnchorDelay , trainAnchorMsg = Nothing @@ -81,8 +81,8 @@ instance Extrapolator LinearExtrapolator where (trainAnchorDelay, trainAnchorSequence) = linearDelay stops shape ping ticketDay tzseries = undefined -linearDelay :: V.Vector (Stop, Station, TimeZoneSeries) -> V.Vector ShapePoint -> TrainPing -> Day -> (Seconds, Double) -linearDelay tripStops shape TrainPing{..} runningDay = (observedDelay, observedSequence) +linearDelay :: V.Vector (Stop, Station, TimeZoneSeries) -> V.Vector ShapePoint -> SentPing -> Day -> (Seconds, Double) +linearDelay tripStops shape SentPing{..} runningDay = (observedDelay, observedSequence) where -- at which (fractional) sequence number is the ping? observedSequence = int2Double (stopSequence lastStop) + observedProgress * int2Double (stopSequence nextStop - stopSequence lastStop) @@ -93,7 +93,7 @@ linearDelay tripStops shape TrainPing{..} runningDay = (observedDelay, observedS + if expectedProgress == 1 -- if the hypothetical on-time train is already at (or past) the next station, -- just add the time distance we're behind - then seconds2Double (utcToSeconds trainPingTimestamp runningDay - nextSeconds) + then seconds2Double (utcToSeconds sentPingTimestamp runningDay - nextSeconds) -- otherwise the above is sufficient else 0 @@ -107,14 +107,14 @@ linearDelay tripStops shape TrainPing{..} runningDay = (observedDelay, observedS | p < 0 -> 0 | p > 1 -> 1 | otherwise -> p - where p = seconds2Double (utcToSeconds trainPingTimestamp runningDay - lastSeconds) + where p = seconds2Double (utcToSeconds sentPingTimestamp runningDay - lastSeconds) / seconds2Double expectedTravelTime -- scheduled duration between last and next stops expectedTravelTime = nextSeconds - lastSeconds -- closest point on the shape; this is where we assume the train to be - closestPoint = minimumBy (compare `on` euclid trainPingGeopos) line + closestPoint = minimumBy (compare `on` euclid sentPingGeopos) line -- scheduled departure at last & arrival at next stop lastSeconds = toSeconds (stopDeparture lastStop) lastTzSeries runningDay |