diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 6f6bef2..bbc9c8f 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -213,7 +213,10 @@ getExpectedDirectory :: GEvalSpecification -> FilePath getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec where outDirectory = gesOutDirectory spec -data GEvalSpecialCommand = Init | LineByLine | WorstFeatures | Diff FilePath | PrintVersion +data GEvalSpecialCommand = Init + | LineByLine | WorstFeatures + | Diff FilePath | MostWorseningFeatures FilePath + | PrintVersion data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs index 2631341..eaa6b85 100644 --- a/src/GEval/LineByLine.hs +++ b/src/GEval/LineByLine.hs @@ -12,6 +12,7 @@ module GEval.LineByLine runWorstFeatures, runLineByLineGeneralized, runDiff, + runMostWorseningFeatures, runDiffGeneralized, LineRecord(..), ResultOrdering(..) @@ -212,6 +213,17 @@ runDiff ordering otherOut spec = runDiffGeneralized ordering otherOut spec consu formatScoreDiff :: Double -> Text formatScoreDiff = Data.Text.pack . printf "%f" +runMostWorseningFeatures :: ResultOrdering -> FilePath -> GEvalSpecification -> IO () +runMostWorseningFeatures ordering otherOut spec = runDiffGeneralized ordering' otherOut spec consum + where ordering' = forceSomeOrdering ordering + consum :: ConduitT (LineRecord, LineRecord) Void (ResourceT IO) () + consum = CC.map prepareFakeLineRecord + .| (worstFeaturesPipeline spec) + prepareFakeLineRecord :: (LineRecord, LineRecord) -> LineRecord + prepareFakeLineRecord (LineRecord _ _ _ _ scorePrev, LineRecord inp exp out c score) = + LineRecord inp exp out c (score - scorePrev) + + runDiffGeneralized :: ResultOrdering -> FilePath -> GEvalSpecification -> ConduitT (LineRecord, LineRecord) Void (ResourceT IO) a -> IO a runDiffGeneralized ordering otherOut spec consum = do (inputSource, expectedSource, outSource) <- checkAndGetFilesSingleOut True spec diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index d55335f..aeeb58b 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -55,7 +55,13 @@ optionsParser = GEvalOptions ( long "diff" <> short 'd' <> metavar "OTHER-OUT" - <> help "compare results"))) + <> help "compare results")) + <|> + (MostWorseningFeatures <$> strOption + ( long "most-worsening-features" + <> short 'm' + <> help "Print a ranking of the \"most worsening\" features, i.e. features that worsen the score the most when comparing outputs from two systems."))) + <*> ((flag' FirstTheWorst (long "sort" <> short 's' @@ -205,6 +211,9 @@ runGEval''' (Just WorstFeatures) ordering spec = do runGEval''' (Just (Diff otherOut)) ordering spec = do runDiff ordering otherOut spec return Nothing +runGEval''' (Just (MostWorseningFeatures otherOut)) ordering spec = do + runMostWorseningFeatures ordering otherOut spec + return Nothing initChallenge :: GEvalSpecification -> IO () initChallenge spec = case gesExpectedDirectory spec of