multiple metrics can be specified
This commit is contained in:
parent
ffb24509d7
commit
86d50b92b7
19
app/Main.hs
19
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
10
test/Spec.hs
10
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user