From 86d50b92b7e244ed73949c19f2a7cbfd4bd3be40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Filip=20Grali=C5=84ski?= Date: Fri, 8 Jun 2018 12:38:45 +0200 Subject: [PATCH] multiple metrics can be specified --- app/Main.hs | 19 ++++++++++++++++--- src/GEval/Core.hs | 28 +++++++++++++++++----------- src/GEval/CreateChallenge.hs | 10 +++++----- src/GEval/LineByLine.hs | 4 ++-- src/GEval/OptionsParser.hs | 27 +++++++++++++++------------ test/Spec.hs | 10 +++++----- 6 files changed, 60 insertions(+), 38 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f2047ff..4013660 100644 --- a/app/Main.hs +++ b/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 opts val = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val +showTheResult :: GEvalOptions -> [MetricValue] -> IO () +-- 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 diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 2c2aecb..3e48d51 100644 --- a/src/GEval/Core.hs +++ b/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 - where metric = gesMetric gevalSpec + Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics + 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 forced metric directory inputFilePath - | forced || (isInputNeeded metric) = do +getInputSourceIfNeeded :: Bool -> [Metric] -> FilePath -> FilePath -> IO SourceSpec +getInputSourceIfNeeded forced metrics directory inputFilePath + | forced || (Prelude.any isInputNeeded metrics) = do iss <- getSmartSourceSpec directory "in.tsv" inputFilePath case iss of Left NoSpecGiven -> throwM $ NoInputFile inputFilePath diff --git a/src/GEval/CreateChallenge.hs b/src/GEval/CreateChallenge.hs index 8880afa..b00258e 100644 --- a/src/GEval/CreateChallenge.hs +++ b/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 precision testName = "--metric " ++ - (show metric) ++ +configContents :: [Metric] -> Maybe Int -> String -> String +configContents metrics precision testName = unwords (Prelude.map (\metric -> ("--metric " ++ (show metric))) metrics) ++ (if testName /= defaultTestName then " --test-name " ++ testName diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs index 08667d5..1ea6429 100644 --- a/src/GEval/LineByLine.hs +++ b/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 diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index e46b033..900a101 100644 --- a/src/GEval/OptionsParser.hs +++ b/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 = option auto - ( long "metric" +metricReader :: Parser [Metric] +metricReader = many $ option auto -- actually `some` should be used instead of `many`, the problem is that + ( 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 - return $ Just val + vals <- geval spec + return $ Just vals runGEval''' (Just Init) _ spec = do initChallenge spec return Nothing diff --git a/test/Spec.hs b/test/Spec.hs index 10c9ce0..9bdbb75 100644 --- a/test/Spec.hs +++ b/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 (Right (Just val)) = return val +extractVal :: (Either (ParserResult GEvalOptions) (Maybe [MetricValue])) -> IO MetricValue +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