multiple metrics can be specified

app/Main.hs

@@ -8,17 +8,30 @@ import Options.Applicative
 
 import Text.Printf
 
+import System.IO
+import System.Exit
+
 main :: IO ()
 main = do
   args <- getArgs
   result <- runGEvalGetOptions args
   case result of
     Left parseResult -> handleParseResult parseResult >> return ()
-    Right (opts, Just result) -> showTheResult opts result
+    Right (opts, Just results) -> showTheResult opts results
     Right (_, Nothing) -> return ()
 
-showTheResult :: GEvalOptions -> MetricValue -> IO ()
+showTheResult :: GEvalOptions -> [MetricValue] -> IO ()
-showTheResult opts val = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val
+-- do not show the metric if just one was given
+showTheResult opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val
+showTheResult opts [] = do
+  hPutStrLn stderr "no metric given, use --metric option"
+  exitFailure
+
+showTheResult opts vals =  mapM_ putStrLn $ map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
+
+formatTheMetricAndResult :: Maybe Int -> (Metric, MetricValue) -> String
+formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
+
 
 formatTheResult :: Maybe Int -> MetricValue -> String
 formatTheResult Nothing  = show

src/GEval/Core.hs

@@ -34,7 +34,8 @@ module GEval.Core
       EvaluationContext(..),
       ParserSpec(..),
       fileAsLineSource,
-      checkAndGetFiles
+      checkAndGetFiles,
+      gesMainMetric
     ) where
 
 import Data.Conduit
@@ -180,9 +181,14 @@ data GEvalSpecification = GEvalSpecification
                             gesOutFile :: String,
                             gesExpectedFile :: String,
                             gesInputFile :: String,
-                            gesMetric :: Metric,
+                            gesMetrics :: [Metric],
                             gesPrecision :: Maybe Int}
 
+gesMainMetric :: GEvalSpecification -> Metric
+gesMainMetric spec = case gesMetrics spec of
+  (metric:_) -> metric
+  otherwise -> error "no metric given"
+
 getExpectedDirectory :: GEvalSpecification -> FilePath
 getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec
                             where outDirectory = gesOutDirectory spec
@@ -241,7 +247,7 @@ defaultGEvalSpecification = GEvalSpecification {
   gesOutFile = defaultOutFile,
   gesExpectedFile = defaultExpectedFile,
   gesInputFile = defaultInputFile,
-  gesMetric = defaultMetric,
+  gesMetrics = [defaultMetric],
   gesPrecision = Nothing}
 
 isEmptyFile :: FilePath -> IO (Bool)
@@ -252,11 +258,11 @@ isEmptyFile path = do
 
 data LineSource m = LineSource (Source m Text) SourceSpec Word32
 
-geval :: GEvalSpecification -> IO (MetricValue)
+geval :: GEvalSpecification -> IO [MetricValue]
 geval gevalSpec = do
   (inputSource, expectedSource, outSource) <- checkAndGetFiles False gevalSpec
-  gevalCore metric inputSource expectedSource outSource
+  Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
-   where metric = gesMetric gevalSpec
+   where metrics = gesMetrics gevalSpec
 
 checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
 checkAndGetFiles forceInput gevalSpec = do
@@ -279,7 +285,7 @@ checkAndGetFiles forceInput gevalSpec = do
           throwM $ NoExpectedDirectory d
         Right expectedSource -> do
           -- in most cases inputSource is NoSource (unless needed by a metric or in the line-by-line mode)
-          inputSource <- getInputSourceIfNeeded forceInput metric expectedTestDirectory inputFile
+          inputSource <- getInputSourceIfNeeded forceInput metrics expectedTestDirectory inputFile
           return (inputSource, expectedSource, outSource)
    where expectedTestDirectory = expectedDirectory </> testName
          outTestDirectory = outDirectory </> testName
@@ -289,16 +295,16 @@ checkAndGetFiles forceInput gevalSpec = do
          outFile = gesOutFile gevalSpec
          expectedFile = gesExpectedFile gevalSpec
          inputFile = gesInputFile gevalSpec
-         metric = gesMetric gevalSpec
+         metrics = gesMetrics gevalSpec
 
 getOutFile :: GEvalSpecification -> FilePath -> FilePath
 getOutFile gevalSpec out = outDirectory </> testName </> out
   where outDirectory = gesOutDirectory gevalSpec
         testName = gesTestName gevalSpec
 
-getInputSourceIfNeeded :: Bool -> Metric -> FilePath -> FilePath -> IO SourceSpec
+getInputSourceIfNeeded :: Bool -> [Metric] -> FilePath -> FilePath -> IO SourceSpec
-getInputSourceIfNeeded forced metric directory inputFilePath
+getInputSourceIfNeeded forced metrics directory inputFilePath
-   | forced || (isInputNeeded metric) = do
+   | forced || (Prelude.any isInputNeeded metrics) = do
        iss <- getSmartSourceSpec directory "in.tsv" inputFilePath
        case iss of
          Left NoSpecGiven -> throwM $ NoInputFile inputFilePath

src/GEval/CreateChallenge.hs

@@ -18,7 +18,7 @@ createChallenge :: FilePath -> GEvalSpecification -> IO ()
 createChallenge expectedDirectory spec = do
   D.createDirectoryIfMissing False expectedDirectory
   createFile (expectedDirectory </> "README.md") $ readmeMDContents metric testName
-  createFile (expectedDirectory </> configFileName) $ configContents metric precision testName
+  createFile (expectedDirectory </> configFileName) $ configContents metrics precision testName
   D.createDirectoryIfMissing False trainDirectory
   createFile (trainDirectory </> "train.tsv") $ trainContents metric
   D.createDirectoryIfMissing False devDirectory
@@ -28,7 +28,8 @@ createChallenge expectedDirectory spec = do
   createFile (testDirectory </> "in.tsv") $ testInContents metric
   createFile (testDirectory </> expectedFile) $ testExpectedContents metric
   createFile (expectedDirectory </> ".gitignore") $ gitignoreContents
-  where metric = gesMetric spec
+  where metric = gesMainMetric spec
+        metrics = gesMetrics spec
         precision = gesPrecision spec
         testName = gesTestName spec
         trainDirectory = expectedDirectory </> "train"
@@ -256,9 +257,8 @@ Directory structure
 |]
 
 
-configContents :: Metric -> Maybe Int -> String -> String
+configContents :: [Metric] -> Maybe Int -> String -> String
-configContents metric precision testName = "--metric " ++
+configContents metrics precision testName = unwords (Prelude.map (\metric -> ("--metric " ++ (show metric))) metrics) ++
-                                 (show metric) ++
                                  (if testName /= defaultTestName
                                      then
                                         " --test-name " ++ testName

src/GEval/LineByLine.hs

@@ -58,7 +58,7 @@ runLineByLineGeneralized :: ResultOrdering -> GEvalSpecification -> ConduitT Lin
 runLineByLineGeneralized ordering spec consum = do
   (inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles True spec
   gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath (sorter ordering .| consum)
-  where metric = gesMetric spec
+  where metric = gesMainMetric spec
         sorter KeepTheOriginalOrder = doNothing
         sorter ordering = gobbleAndDo $ sortBy (sortOrder ordering (getMetricOrdering metric))
         sortOrder FirstTheWorst TheHigherTheBetter = compareScores
@@ -101,7 +101,7 @@ runDiffGeneralized ordering otherOut spec consum = do
         ((getZipSource $ (,)
           <$> ZipSource sourceA
           <*> ZipSource sourceB) .| sorter ordering .| consum)
-  where metric = gesMetric spec
+  where metric = gesMainMetric spec
         sorter KeepTheOriginalOrder = doNothing
         sorter ordering = gobbleAndDo $ sortBy (sortOrder ordering (getMetricOrdering metric))
         sortOrder FirstTheWorst TheHigherTheBetter = compareScores

src/GEval/OptionsParser.hs

@@ -100,19 +100,21 @@ specParser = GEvalSpecification
     <> showDefault
     <> metavar "INPUT"
     <> help "The name of the file with the input (applicable only for some metrics)" )
-  <*> ((flip fromMaybe) <$> altMetricReader <*> metricReader)
+  <*> ((flip fromMaybe) <$> (singletonMaybe <$> altMetricReader) <*> metricReader)
   <*> optional precisionArgParser
 
+singletonMaybe :: Maybe a -> Maybe [a]
+singletonMaybe (Just x) = Just [x]
+singletonMaybe Nothing = Nothing
+
 sel :: Maybe Metric -> Metric -> Metric
 sel Nothing m = m
 sel (Just m) _ = m
 
-metricReader :: Parser Metric
+metricReader :: Parser [Metric]
-metricReader = option auto
+metricReader = many $ option auto         -- actually `some` should be used instead of `many`, the problem is that
-               ( long "metric"
+               ( long "metric"            -- --metric might be in the config.txt file...
                  <> short 'm'
-                 <> value defaultMetric
-                 <> showDefault
                  <> metavar "METRIC"
                  <> help "Metric to be used - RMSE, MSE, Accuracy, LogLoss, Likelihood, F-measure (specify as F1, F2, F0.25, etc.), MAP, BLEU, NMI, ClippEU, LogLossHashed, LikelihoodHashed, BIO-F1, BIO-F1-Labels or CharMatch" )
 
@@ -123,14 +125,14 @@ altMetricReader = optional $ option auto
                  <> metavar "METRIC"
                  <> help "Alternative metric (overrides --metric option)" )
 
-runGEval :: [String] -> IO (Either (ParserResult GEvalOptions) (Maybe MetricValue))
+runGEval :: [String] -> IO (Either (ParserResult GEvalOptions) (Maybe [MetricValue]))
 runGEval args = do
   ret <- runGEvalGetOptions args
   case ret of
     Left e -> return $ Left e
     Right (_, mmv) -> return $ Right mmv
 
-runGEvalGetOptions :: [String] -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
+runGEvalGetOptions :: [String] -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe [MetricValue]))
 runGEvalGetOptions args = do
   optionExtractionResult <- getOptions args
   case optionExtractionResult of
@@ -142,6 +144,7 @@ runGEvalGetOptions args = do
 getOptions :: [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
 getOptions = getOptions' True
 
+
 -- the first argument: whether to try to read from the config file
 getOptions' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
 getOptions' readOptsFromConfigFile args =
@@ -165,13 +168,13 @@ attemptToReadOptsFromConfigFile args opts = do
   where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName
 
 
-runGEval'' :: GEvalOptions -> IO (Maybe MetricValue)
+runGEval'' :: GEvalOptions -> IO (Maybe [MetricValue])
 runGEval'' opts = runGEval''' (geoSpecialCommand opts) (geoResultOrdering opts) (geoSpec opts)
 
-runGEval''' :: Maybe GEvalSpecialCommand -> ResultOrdering -> GEvalSpecification -> IO (Maybe MetricValue)
+runGEval''' :: Maybe GEvalSpecialCommand -> ResultOrdering -> GEvalSpecification -> IO (Maybe [MetricValue])
 runGEval''' Nothing _ spec = do
-  val <- geval spec
+  vals <- geval spec
-  return $ Just val
+  return $ Just vals
 runGEval''' (Just Init) _ spec = do
   initChallenge spec
   return Nothing

test/Spec.hs

@@ -47,7 +47,7 @@ main :: IO ()
 main = hspec $ do
   describe "root mean square error" $ do
     it "simple test" $ do
-      geval (defaultGEvalSpecification {gesExpectedDirectory=Just "test/rmse-simple/rmse-simple", gesOutDirectory="test/rmse-simple/rmse-simple-solution"}) `shouldReturnAlmost` 0.64549722436790
+      (fmap Prelude.head (geval (defaultGEvalSpecification {gesExpectedDirectory=Just "test/rmse-simple/rmse-simple", gesOutDirectory="test/rmse-simple/rmse-simple-solution"}))) `shouldReturnAlmost` 0.64549722436790
   describe "mean square error" $ do
     it "simple test with arguments" $
       runGEvalTest "mse-simple" `shouldReturnAlmost` 0.4166666666666667
@@ -285,7 +285,7 @@ main = hspec $ do
             gesOutFile = "out.tsv",
             gesExpectedFile = "expected.tsv",
             gesInputFile = "in.tsv",
-            gesMetric = Likelihood,
+            gesMetrics = [Likelihood],
             gesPrecision = Nothing }
     it "simple test" $ do
       results <- runLineByLineGeneralized KeepTheOriginalOrder sampleChallenge Data.Conduit.List.consume
@@ -333,8 +333,8 @@ testMatchFun 'b' 1 = True
 testMatchFun 'c' 1 = True
 testMatchFun _ _ = False
 
-extractVal :: (Either (ParserResult GEvalOptions) (Maybe MetricValue)) -> IO MetricValue
+extractVal :: (Either (ParserResult GEvalOptions) (Maybe [MetricValue])) -> IO MetricValue
-extractVal (Right (Just val)) = return val
+extractVal (Right (Just (val:_))) = return val
 
 runGEvalTest = runGEvalTestExtraOptions []
 
@@ -349,7 +349,7 @@ extractMetric testName = do
   result <- getOptions ["--expected-directory", "test/" ++ testName ++ "/" ++ testName]
   return $ case result of
    Left _ -> Nothing
-   Right opts -> Just $ gesMetric $ geoSpec opts
+   Right opts -> Just $ gesMainMetric $ geoSpec opts
 
 class AEq a where
     (=~) :: a -> a -> Bool