From 3f7384f46748f6e900b422ac8513bbf239f64df9 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Mon, 28 May 2018 10:04:27 +0200
Subject: [PATCH] add --sort and --reverse-sort options

---
 geval.cabal                |  2 +-
 src/GEval/Core.hs          |  5 ++++-
 src/GEval/LineByLine.hs    | 13 ++++++++++---
 src/GEval/OptionsParser.hs | 26 ++++++++++++++++++--------
 4 files changed, 33 insertions(+), 13 deletions(-)

diff --git a/geval.cabal b/geval.cabal
index 08ce371..e51ad70 100644
--- a/geval.cabal
+++ b/geval.cabal
@@ -1,5 +1,5 @@
 name:                geval
-version:             0.5.7.0
+version:             0.6.0.0
 synopsis:            Machine learning evaluation tools
 description:         Please see README.md
 homepage:            http://github.com/name/project
diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs
index e0a110c..37cb237 100644
--- a/src/GEval/Core.hs
+++ b/src/GEval/Core.hs
@@ -16,6 +16,7 @@ module GEval.Core
       MetricValue,
       GEvalSpecialCommand(..),
       GEvalSpecification(..),
+      ResultOrdering(..),
       GEvalOptions(..),
       GEvalException(..),
       defaultGEvalSpecification,
@@ -180,11 +181,13 @@ getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec
 
 data GEvalSpecialCommand = Init | LineByLine | Diff FilePath
 
+data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest
+
 data GEvalOptions = GEvalOptions
                     { geoSpecialCommand :: Maybe GEvalSpecialCommand,
+                      geoResultOrdering :: ResultOrdering,
                       geoSpec :: GEvalSpecification }
 
-
 data GEvalException = NoExpectedFile FilePath
                       | NoOutFile FilePath
                       | NoExpectedDirectory FilePath
diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs
index 91848db..74f053b 100644
--- a/src/GEval/LineByLine.hs
+++ b/src/GEval/LineByLine.hs
@@ -38,8 +38,6 @@ import Text.Printf
 data LineRecord = LineRecord Text Text Text Word32 MetricValue
                   deriving (Eq, Show)
 
-data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest
-
 runLineByLine :: ResultOrdering -> GEvalSpecification -> IO ()
 runLineByLine ordering spec = runLineByLineGeneralized ordering spec consum
    where consum :: ConduitT LineRecord Void (ResourceT IO) ()
@@ -93,8 +91,17 @@ runDiffGeneralized ordering otherOut spec consum = do
   runResourceT $ runConduit $
      ((getZipSource $ (,)
        <$> ZipSource sourceA
-       <*> ZipSource sourceB) .| consum)
+       <*> ZipSource sourceB) .| sorter ordering .| consum)
   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 = Data.Text.replace "\t" "<tab>"
diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs
index 76d6808..dbdd6d6 100644
--- a/src/GEval/OptionsParser.hs
+++ b/src/GEval/OptionsParser.hs
@@ -41,6 +41,16 @@ optionsParser = GEvalOptions
                       <> short 'd'
                       <> metavar "OTHER-OUT"
                       <> 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
 
 precisionArgParser :: Parser Int
@@ -145,20 +155,20 @@ attemptToReadOptsFromConfigFile args opts = do
 
 
 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''' Nothing spec = do
+runGEval''' :: Maybe GEvalSpecialCommand -> ResultOrdering -> GEvalSpecification -> IO (Maybe MetricValue)
+runGEval''' Nothing _ spec = do
   val <- geval spec
   return $ Just val
-runGEval''' (Just Init) spec = do
+runGEval''' (Just Init) _ spec = do
   initChallenge spec
   return Nothing
-runGEval''' (Just LineByLine) spec = do
-  runLineByLine KeepTheOriginalOrder spec
+runGEval''' (Just LineByLine) ordering spec = do
+  runLineByLine ordering spec
   return Nothing
-runGEval''' (Just (Diff otherOut)) spec = do
-  runDiff KeepTheOriginalOrder otherOut spec
+runGEval''' (Just (Diff otherOut)) ordering spec = do
+  runDiff ordering otherOut spec
   return Nothing
 
 initChallenge :: GEvalSpecification -> IO ()