filipg/geval
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

multiple metrics can be specified

Browse Source
This commit is contained in:
Filip Graliński 2018-06-08 12:38:45 +02:00
parent ffb24509d7
commit 86d50b92b7
6 changed files with 60 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
app/Main.hs
View File

@ -8,17 +8,30 @@ import Options.Applicative
import Text.Printf import Text.Printf
import System.IO
import System.Exit
main :: IO () main :: IO ()
main = do main = do
args <- getArgs args <- getArgs
result <- runGEvalGetOptions args result <- runGEvalGetOptions args
case result of case result of
Left parseResult -> handleParseResult parseResult >> return () Left parseResult -> handleParseResult parseResult >> return ()
Right (opts, Just result) -> showTheResult opts result Right (opts, Just results) -> showTheResult opts results
Right (_, Nothing) -> return () 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 :: Maybe Int -> MetricValue -> String
formatTheResult Nothing = show formatTheResult Nothing = show

28
src/GEval/Core.hs
View File

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

10
src/GEval/CreateChallenge.hs
View File

@ -18,7 +18,7 @@ createChallenge :: FilePath -> GEvalSpecification -> IO ()
createChallenge expectedDirectory spec = do createChallenge expectedDirectory spec = do
D.createDirectoryIfMissing False expectedDirectory D.createDirectoryIfMissing False expectedDirectory
createFile (expectedDirectory </> "README.md") $ readmeMDContents metric testName 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 D.createDirectoryIfMissing False trainDirectory
createFile (trainDirectory </> "train.tsv") $ trainContents metric createFile (trainDirectory </> "train.tsv") $ trainContents metric
D.createDirectoryIfMissing False devDirectory D.createDirectoryIfMissing False devDirectory
@ -28,7 +28,8 @@ createChallenge expectedDirectory spec = do
createFile (testDirectory </> "in.tsv") $ testInContents metric createFile (testDirectory </> "in.tsv") $ testInContents metric
createFile (testDirectory </> expectedFile) $ testExpectedContents metric createFile (testDirectory </> expectedFile) $ testExpectedContents metric
createFile (expectedDirectory </> ".gitignore") $ gitignoreContents createFile (expectedDirectory </> ".gitignore") $ gitignoreContents
where metric = gesMetric spec where metric = gesMainMetric spec
metrics = gesMetrics spec
precision = gesPrecision spec precision = gesPrecision spec
testName = gesTestName spec testName = gesTestName spec
trainDirectory = expectedDirectory </> "train" 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 (if testName /= defaultTestName
then then
" --test-name " ++ testName " --test-name " ++ testName

4
src/GEval/LineByLine.hs
View File

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

27
src/GEval/OptionsParser.hs
View File

@ -100,19 +100,21 @@ specParser = GEvalSpecification
<> showDefault <> showDefault
<> metavar "INPUT" <> metavar "INPUT"
<> help "The name of the file with the input (applicable only for some metrics)" ) <> 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 <*> optional precisionArgParser
singletonMaybe :: Maybe a -> Maybe [a]
singletonMaybe (Just x) = Just [x]
singletonMaybe Nothing = Nothing
sel :: Maybe Metric -> Metric -> Metric sel :: Maybe Metric -> Metric -> Metric
sel Nothing m = m sel Nothing m = m
sel (Just 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' <> short 'm'
<> value defaultMetric
<> showDefault
<> metavar "METRIC" <> 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" ) <> 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" <> metavar "METRIC"
<> help "Alternative metric (overrides --metric option)" ) <> 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 runGEval args = do
ret <- runGEvalGetOptions args ret <- runGEvalGetOptions args
case ret of case ret of
Left e -> return $ Left e Left e -> return $ Left e
Right (_, mmv) -> return $ Right mmv 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 runGEvalGetOptions args = do
optionExtractionResult <- getOptions args optionExtractionResult <- getOptions args
case optionExtractionResult of case optionExtractionResult of
@ -142,6 +144,7 @@ runGEvalGetOptions args = do
getOptions :: [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions) getOptions :: [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
getOptions = getOptions' True getOptions = getOptions' True
-- the first argument: whether to try to read from the config file -- the first argument: whether to try to read from the config file
getOptions' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions) getOptions' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
getOptions' readOptsFromConfigFile args = getOptions' readOptsFromConfigFile args =
@ -165,13 +168,13 @@ attemptToReadOptsFromConfigFile args opts = do
where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName 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'' 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 runGEval''' Nothing _ spec = do
val <- geval spec vals <- geval spec
return $ Just val return $ Just vals
runGEval''' (Just Init) _ spec = do runGEval''' (Just Init) _ spec = do
initChallenge spec initChallenge spec
return Nothing return Nothing

10
test/Spec.hs
View File

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