add getOptions for extracting options without running the evaluation
This commit is contained in:
parent
a86828e3a8
commit
b4e5dcbd9d
@ -1,5 +1,5 @@
|
|||||||
name: geval
|
name: geval
|
||||||
version: 0.2.2.0
|
version: 0.2.3.0
|
||||||
synopsis: Machine learning evaluation tools
|
synopsis: Machine learning evaluation tools
|
||||||
description: Please see README.md
|
description: Please see README.md
|
||||||
homepage: http://github.com/name/project
|
homepage: http://github.com/name/project
|
||||||
|
@ -40,7 +40,7 @@ import GEval.BLEU
|
|||||||
type MetricValue = Double
|
type MetricValue = Double
|
||||||
|
|
||||||
data Metric = RMSE | MSE | BLEU | Accuracy
|
data Metric = RMSE | MSE | BLEU | Accuracy
|
||||||
deriving (Show, Read)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
data MetricOrdering = TheLowerTheBetter | TheHigherTheBetter
|
data MetricOrdering = TheLowerTheBetter | TheHigherTheBetter
|
||||||
|
|
||||||
|
@ -3,7 +3,8 @@
|
|||||||
module GEval.OptionsParser
|
module GEval.OptionsParser
|
||||||
(fullOptionsParser,
|
(fullOptionsParser,
|
||||||
runGEval,
|
runGEval,
|
||||||
runGEvalGetOptions) where
|
runGEvalGetOptions,
|
||||||
|
getOptions) where
|
||||||
|
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import qualified System.Directory as D
|
import qualified System.Directory as D
|
||||||
@ -83,29 +84,37 @@ runGEval args = do
|
|||||||
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 = runGEval' True
|
runGEvalGetOptions args = do
|
||||||
|
optionExtractionResult <- getOptions args
|
||||||
|
case optionExtractionResult of
|
||||||
|
Left parserResult -> return $ Left parserResult
|
||||||
|
Right opts -> do
|
||||||
|
mmv <- runGEval'' opts
|
||||||
|
return $ Right (opts, mmv)
|
||||||
|
|
||||||
|
getOptions :: [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
|
||||||
|
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
|
||||||
runGEval' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
|
getOptions' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
|
||||||
runGEval' readOptsFromConfigFile args =
|
getOptions' readOptsFromConfigFile args =
|
||||||
case parserResult of
|
case parserResult of
|
||||||
Success opts -> if readOptsFromConfigFile then
|
Success opts -> if readOptsFromConfigFile then
|
||||||
attemptToReadOptsFromConfigFile args opts else
|
attemptToReadOptsFromConfigFile args opts else
|
||||||
do
|
do
|
||||||
mmv <- runGEval'' opts
|
return $ Right opts
|
||||||
return $ Right $ (opts, mmv)
|
|
||||||
otherwise -> return $ Left parserResult
|
otherwise -> return $ Left parserResult
|
||||||
where parserResult = execParserPure (prefs idm) fullOptionsParser args
|
where parserResult = execParserPure (prefs idm) fullOptionsParser args
|
||||||
|
|
||||||
attemptToReadOptsFromConfigFile :: [String] -> GEvalOptions -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
|
attemptToReadOptsFromConfigFile :: [String] -> GEvalOptions -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
|
||||||
attemptToReadOptsFromConfigFile args opts = do
|
attemptToReadOptsFromConfigFile args opts = do
|
||||||
configExists <- D.doesFileExist configFilePath
|
configExists <- D.doesFileExist configFilePath
|
||||||
if configExists then do
|
if configExists then do
|
||||||
configH <- openFile configFilePath ReadMode
|
configH <- openFile configFilePath ReadMode
|
||||||
contents <- hGetContents configH
|
contents <- hGetContents configH
|
||||||
runGEval' False ((words contents) ++ args)
|
getOptions' False ((words contents) ++ args)
|
||||||
else
|
else
|
||||||
runGEval' False args
|
getOptions' False args
|
||||||
where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName
|
where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
flags: {}
|
flags: {}
|
||||||
packages:
|
packages:
|
||||||
- '.'
|
- '.'
|
||||||
extra-deps: []
|
extra-deps: [cond-0.4.1.1]
|
||||||
resolver: lts-3.13
|
compiler-check: newer-minor
|
||||||
|
resolver: nightly-2015-12-19
|
||||||
|
10
test/Spec.hs
10
test/Spec.hs
@ -33,6 +33,9 @@ main = hspec $ do
|
|||||||
precisionCount [["bar", "bar", "bar", "bar", "foo", "xyz", "foo"]] ["foo", "bar", "foo", "baz", "bar", "foo"] `shouldBe` 4
|
precisionCount [["bar", "bar", "bar", "bar", "foo", "xyz", "foo"]] ["foo", "bar", "foo", "baz", "bar", "foo"] `shouldBe` 4
|
||||||
it "multiple refs" $ do
|
it "multiple refs" $ do
|
||||||
precisionCount [["foo", "baz"], ["bar"], ["baz", "xyz"]] ["foo", "bar", "foo"] `shouldBe` 2
|
precisionCount [["foo", "baz"], ["bar"], ["baz", "xyz"]] ["foo", "bar", "foo"] `shouldBe` 2
|
||||||
|
describe "reading options" $ do
|
||||||
|
it "can get the metric" $ do
|
||||||
|
extractMetric "bleu-complex" `shouldReturn` (Just BLEU)
|
||||||
describe "error handling" $ do
|
describe "error handling" $ do
|
||||||
it "too few lines are handled" $ do
|
it "too few lines are handled" $ do
|
||||||
runGEvalTest "error-too-few-lines" `shouldThrow` (== TooFewLines)
|
runGEvalTest "error-too-few-lines" `shouldThrow` (== TooFewLines)
|
||||||
@ -55,6 +58,13 @@ runGEvalTest testName = (runGEval [
|
|||||||
"--out-directory",
|
"--out-directory",
|
||||||
"test/" ++ testName ++ "/" ++ testName ++ "-solution"]) >>= extractVal
|
"test/" ++ testName ++ "/" ++ testName ++ "-solution"]) >>= extractVal
|
||||||
|
|
||||||
|
extractMetric :: String -> IO (Maybe Metric)
|
||||||
|
extractMetric testName = do
|
||||||
|
result <- getOptions ["--expected-directory", "test/" ++ testName ++ "/" ++ testName]
|
||||||
|
return $ case result of
|
||||||
|
Left _ -> Nothing
|
||||||
|
Right opts -> Just $ gesMetric $ geoSpec opts
|
||||||
|
|
||||||
class AEq a where
|
class AEq a where
|
||||||
(=~) :: a -> a -> Bool
|
(=~) :: a -> a -> Bool
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user