start refactoring to enable evaluating multiple outputs
This commit is contained in:
parent
0a2e1fcc32
commit
656a194f42
15
app/Main.hs
15
app/Main.hs
@ -11,6 +11,8 @@ import Text.Printf
|
||||
import System.IO
|
||||
import System.Exit
|
||||
|
||||
import Data.Conduit.SmartSource
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
@ -20,14 +22,17 @@ main = do
|
||||
Right (opts, Just results) -> showTheResult opts results
|
||||
Right (_, Nothing) -> return ()
|
||||
|
||||
showTheResult :: GEvalOptions -> [MetricValue] -> IO ()
|
||||
showTheResult :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
|
||||
showTheResult opts [(_, vals)] = showTheResult' opts vals
|
||||
showTheResult _ _ = error "multiple outputs not handled yet"
|
||||
|
||||
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
|
||||
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
|
||||
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)
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: geval
|
||||
version: 1.0.0.1
|
||||
version: 1.1.0.0
|
||||
synopsis: Machine learning evaluation tools
|
||||
description: Please see README.md
|
||||
homepage: http://github.com/name/project
|
||||
|
@ -268,10 +268,11 @@ isEmptyFile path = do
|
||||
|
||||
data LineSource m = LineSource (Source m Text) SourceSpec Word32
|
||||
|
||||
geval :: GEvalSpecification -> IO [MetricValue]
|
||||
geval :: GEvalSpecification -> IO [(SourceSpec, [MetricValue])]
|
||||
geval gevalSpec = do
|
||||
(inputSource, expectedSource, outSource) <- checkAndGetFiles False gevalSpec
|
||||
Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
|
||||
results <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
|
||||
return [(outSource, results)]
|
||||
where metrics = gesMetrics gevalSpec
|
||||
|
||||
checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
|
||||
|
@ -23,6 +23,8 @@ import GEval.Core
|
||||
import GEval.CreateChallenge
|
||||
import GEval.LineByLine
|
||||
|
||||
import Data.Conduit.SmartSource
|
||||
|
||||
fullOptionsParser = info (helper <*> optionsParser)
|
||||
(fullDesc
|
||||
<> progDesc "Run evaluation for tests in Gonito platform"
|
||||
@ -133,14 +135,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 [(SourceSpec, [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 [(SourceSpec, [MetricValue])]))
|
||||
runGEvalGetOptions args = do
|
||||
optionExtractionResult <- getOptions args
|
||||
case optionExtractionResult of
|
||||
@ -176,10 +178,10 @@ attemptToReadOptsFromConfigFile args opts = do
|
||||
where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName
|
||||
|
||||
|
||||
runGEval'' :: GEvalOptions -> IO (Maybe [MetricValue])
|
||||
runGEval'' :: GEvalOptions -> IO (Maybe [(SourceSpec, [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 [(SourceSpec, [MetricValue])])
|
||||
runGEval''' Nothing _ spec = do
|
||||
vals <- geval spec
|
||||
return $ Just vals
|
||||
|
@ -47,7 +47,8 @@ main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "root mean square error" $ do
|
||||
it "simple test" $ do
|
||||
(fmap Prelude.head (geval (defaultGEvalSpecification {gesExpectedDirectory=Just "test/rmse-simple/rmse-simple", gesOutDirectory="test/rmse-simple/rmse-simple-solution"}))) `shouldReturnAlmost` 0.64549722436790
|
||||
[(_, (val:_))] <- geval $ defaultGEvalSpecification {gesExpectedDirectory=Just "test/rmse-simple/rmse-simple", gesOutDirectory="test/rmse-simple/rmse-simple-solution"}
|
||||
val `shouldBeAlmost` 0.64549722436790
|
||||
describe "mean square error" $ do
|
||||
it "simple test with arguments" $
|
||||
runGEvalTest "mse-simple" `shouldReturnAlmost` 0.4166666666666667
|
||||
@ -336,8 +337,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 [(SourceSpec, [MetricValue])])) -> IO MetricValue
|
||||
extractVal (Right (Just ([(_, val:_)]))) = return val
|
||||
|
||||
runGEvalTest = runGEvalTestExtraOptions []
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user