Add CL options for alignment parameters (closes #50)

src/Scoring.hs

@@ -55,10 +55,3 @@ ballStatusScore scale _ f = case Tcb.mBallStatus $ Tcb.ball $ Tcb.positions f of
 playerScore :: F24.ShirtNumbers -> ScoringFunction
 playerScore jerseys scale e f = logDensity Gaussian.standard (dist / scale) where
  dist = fromMaybe 0.0 (eventPlayerDistance jerseys e f)
-
-totalScore :: F24.ShirtNumbers -> ScoringFunction
-totalScore jerseys scale e f = scale*total where
- total = sum [clockScore 1.0 e f,
- locationScore 5000.0 e f,
- ballStatusScore 1.0 e f,
- playerScore jerseys 100.0 e f]

src/SyncMain.hs

@@ -16,20 +16,28 @@ data Options = Options {
  f24File :: String,
  outputFile :: String,
  timeOnly :: Bool,
+ cScale :: Double,
+ lScale :: Double,
+ pScale :: Double,
+ bScale :: Double, 
  eventCSV :: String,
  frameCSV :: String
 } deriving Show
 
 options :: Parser Options
 options = Options
- <$> argument str (metavar "TRACAB-META")
- <*> argument str (metavar "TRACAB-DATA")
- <*> argument str (metavar "F7")
- <*> argument str (metavar "F24")
- <*> argument str (metavar "OUTPUT")
- <*> switch (long "time-only" <> short 't' <> help "Sync only by time")
- <*> strOption (long "event-csv" <> short 'e' <> value "" <> metavar "FILEPATH" <> help "Location to save a CSV of F24 events")
- <*> strOption (long "frame-csv" <> short 'f' <> value "" <> metavar "FILEPATH" <> help "Location to save a CSV of Tracab frames")
+ <$> argument str (metavar "TRACAB-META")
+ <*> argument str (metavar "TRACAB-DATA")
+ <*> argument str (metavar "F7")
+ <*> argument str (metavar "F24")
+ <*> argument str (metavar "OUTPUT")
+ <*> switch (long "time-only" <> short 't' <> help "Sync only by time")
+ <*> option auto (long "scale-clock" <> short 'c' <> value 1 <> metavar "X" <> help "Clock difference resulting in unit penalty [s, default 1]")
+ <*> option auto (long "scale-location" <> short 'l' <> value 5 <> metavar "X" <> help "Location difference resulting in unit penalty [m, default 5]")
+ <*> option auto (long "scale-player" <> short 'p' <> value 1 <> metavar "X" <> help "Player-ball distance resulting in unit penalty [m, default 1]")
+ <*> option auto (long "scale-ball" <> short 'b' <> value 5 <> metavar "X" <> help "Penalty for syncing to dead-ball frame [default 5]")
+ <*> strOption (long "event-csv" <> short 'e' <> value "" <> metavar "FILEPATH" <> help "Location to save F24 events CSV")
+ <*> strOption (long "frame-csv" <> short 'f' <> value "" <> metavar "FILEPATH" <> help "Location to save Tracab frames CSV")
 
 parseOptions :: IO Options
 parseOptions = let desc = "Synchronise Tracab and F24 data."
@@ -46,7 +54,7 @@ main = do
  let f24Data = F24.convertGameCoordinates tbMeta tbData f24Raw
 
  -- Select events to sync in both halves
- let syncable pid e = (F24.period_id e == pid) && (F24.isOTB e)
+ let syncable pid e = F24.period_id e == pid && F24.isOTB e
  let events1 = filter (syncable 1) (F24.events f24Data)
  let events2 = filter (syncable 2) (F24.events f24Data)
 
@@ -61,11 +69,17 @@ main = do
  -- The penalty for leaving frames unaligned needs to be small.
  -- Conversely, leaving events unaligned should be costly.
  -- Note that the score for a Match is negative on the log-density scale.
- let gapl = \f -> (-10.0) -- Leaves a frame unaligned for p < exp(-10) = 4.5e-5
- let gapr = \e -> (-1000.0)
- let sim = case timeOnly opts of
- True -> Scoring.clockScore 1.0
- False -> Scoring.totalScore (F24.shirtNumbers f24Meta) 1.0
+ let gapl f = -10.0 -- Leaves a frame unaligned for p < exp(-10) = 4.5e-5
+ let gapr e = -1000.0
+
+ -- Build the scoring function as requested by the user.
+ -- FIXME: Combine functions without mentioning arguments.
+ let to = timeOnly opts
+ let scoreClock = Scoring.clockScore (cScale opts)
+ let scoreLocation e f = if to then 0 else Scoring.locationScore (100 * lScale opts) e f
+ let scorePlayer e f = if to then 0 else Scoring.playerScore (F24.shirtNumbers f24Meta) (100 * pScale opts) e f
+ let scoreBall e f = if to then 0 else Scoring.ballStatusScore (bScale opts) e f
+ let sim e f = scoreClock e f + scoreLocation e f + scorePlayer e f + scoreBall e f
 
  -- Align!
  let sync1 = NW.align events1 frames1 sim gapl gapr