add --sort and --reverse-sort options

This commit is contained in:
Filip Gralinski 2018-05-28 10:04:27 +02:00
parent ab1056301e
commit 3f7384f467
4 changed files with 33 additions and 13 deletions

View File

@ -1,5 +1,5 @@
name: geval name: geval
version: 0.5.7.0 version: 0.6.0.0
synopsis: Machine learning evaluation tools synopsis: Machine learning evaluation tools
description: Please see README.md description: Please see README.md
homepage: http://github.com/name/project homepage: http://github.com/name/project

View File

@ -16,6 +16,7 @@ module GEval.Core
MetricValue, MetricValue,
GEvalSpecialCommand(..), GEvalSpecialCommand(..),
GEvalSpecification(..), GEvalSpecification(..),
ResultOrdering(..),
GEvalOptions(..), GEvalOptions(..),
GEvalException(..), GEvalException(..),
defaultGEvalSpecification, defaultGEvalSpecification,
@ -180,11 +181,13 @@ getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec
data GEvalSpecialCommand = Init | LineByLine | Diff FilePath data GEvalSpecialCommand = Init | LineByLine | Diff FilePath
data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest
data GEvalOptions = GEvalOptions data GEvalOptions = GEvalOptions
{ geoSpecialCommand :: Maybe GEvalSpecialCommand, { geoSpecialCommand :: Maybe GEvalSpecialCommand,
geoResultOrdering :: ResultOrdering,
geoSpec :: GEvalSpecification } geoSpec :: GEvalSpecification }
data GEvalException = NoExpectedFile FilePath data GEvalException = NoExpectedFile FilePath
| NoOutFile FilePath | NoOutFile FilePath
| NoExpectedDirectory FilePath | NoExpectedDirectory FilePath

View File

@ -38,8 +38,6 @@ import Text.Printf
data LineRecord = LineRecord Text Text Text Word32 MetricValue data LineRecord = LineRecord Text Text Text Word32 MetricValue
deriving (Eq, Show) deriving (Eq, Show)
data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest
runLineByLine :: ResultOrdering -> GEvalSpecification -> IO () runLineByLine :: ResultOrdering -> GEvalSpecification -> IO ()
runLineByLine ordering spec = runLineByLineGeneralized ordering spec consum runLineByLine ordering spec = runLineByLineGeneralized ordering spec consum
where consum :: ConduitT LineRecord Void (ResourceT IO) () where consum :: ConduitT LineRecord Void (ResourceT IO) ()
@ -93,8 +91,17 @@ runDiffGeneralized ordering otherOut spec consum = do
runResourceT $ runConduit $ runResourceT $ runConduit $
((getZipSource $ (,) ((getZipSource $ (,)
<$> ZipSource sourceA <$> ZipSource sourceA
<*> ZipSource sourceB) .| consum) <*> ZipSource sourceB) .| sorter ordering .| consum)
where metric = gesMetric spec where metric = gesMetric spec
sorter KeepTheOriginalOrder = doNothing
sorter ordering = gobbleAndDo $ sortBy (sortOrder ordering (getMetricOrdering metric))
sortOrder FirstTheWorst TheHigherTheBetter = compareScores
sortOrder FirstTheBest TheLowerTheBetter = compareScores
sortOrder _ _ = flip compareScores
compareScores ((LineRecord _ _ _ _ o1), (LineRecord _ _ _ _ n1))
((LineRecord _ _ _ _ o2), (LineRecord _ _ _ _ n2))
= (n1 - o1) `compare` (n2 - o2)
escapeTabs :: Text -> Text escapeTabs :: Text -> Text
escapeTabs = Data.Text.replace "\t" "<tab>" escapeTabs = Data.Text.replace "\t" "<tab>"

View File

@ -41,6 +41,16 @@ optionsParser = GEvalOptions
<> short 'd' <> short 'd'
<> metavar "OTHER-OUT" <> metavar "OTHER-OUT"
<> help "compare results"))) <> help "compare results")))
<*> ((flag' FirstTheWorst
(long "sort"
<> short 's'
<> help "When in line-by-line or diff mode, sort the results from the worst to the best"))
<|>
(flag' FirstTheBest
(long "reverse-sort"
<> short 'r'
<> help "When in line-by-line or diff mode, sort the results from the best to the worst"))
<|> pure KeepTheOriginalOrder)
<*> specParser <*> specParser
precisionArgParser :: Parser Int precisionArgParser :: Parser Int
@ -145,20 +155,20 @@ attemptToReadOptsFromConfigFile args opts = do
runGEval'' :: GEvalOptions -> IO (Maybe MetricValue) runGEval'' :: GEvalOptions -> IO (Maybe MetricValue)
runGEval'' opts = runGEval''' (geoSpecialCommand opts) (geoSpec opts) runGEval'' opts = runGEval''' (geoSpecialCommand opts) (geoResultOrdering opts) (geoSpec opts)
runGEval''' :: Maybe GEvalSpecialCommand -> GEvalSpecification -> IO (Maybe MetricValue) runGEval''' :: Maybe GEvalSpecialCommand -> ResultOrdering -> GEvalSpecification -> IO (Maybe MetricValue)
runGEval''' Nothing spec = do runGEval''' Nothing _ spec = do
val <- geval spec val <- geval spec
return $ Just val return $ Just val
runGEval''' (Just Init) spec = do runGEval''' (Just Init) _ spec = do
initChallenge spec initChallenge spec
return Nothing return Nothing
runGEval''' (Just LineByLine) spec = do runGEval''' (Just LineByLine) ordering spec = do
runLineByLine KeepTheOriginalOrder spec runLineByLine ordering spec
return Nothing return Nothing
runGEval''' (Just (Diff otherOut)) spec = do runGEval''' (Just (Diff otherOut)) ordering spec = do
runDiff KeepTheOriginalOrder otherOut spec runDiff ordering otherOut spec
return Nothing return Nothing
initChallenge :: GEvalSpecification -> IO () initChallenge :: GEvalSpecification -> IO ()