start refactoring to enable evaluating multiple outputs

This commit is contained in:
Filip Graliński 2018-06-28 14:49:44 +02:00
parent 0a2e1fcc32
commit 656a194f42
5 changed files with 25 additions and 16 deletions

View File

@ -11,6 +11,8 @@ import Text.Printf
import System.IO import System.IO
import System.Exit import System.Exit
import Data.Conduit.SmartSource
main :: IO () main :: IO ()
main = do main = do
args <- getArgs args <- getArgs
@ -20,14 +22,17 @@ main = do
Right (opts, Just results) -> showTheResult opts results Right (opts, Just results) -> showTheResult opts results
Right (_, Nothing) -> return () 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 -- do not show the metric if just one was given
showTheResult opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val showTheResult' opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val
showTheResult opts [] = do showTheResult' opts [] = do
hPutStrLn stderr "no metric given, use --metric option" hPutStrLn stderr "no metric given, use --metric option"
exitFailure 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 :: Maybe Int -> (Metric, MetricValue) -> String
formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val) formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)

View File

@ -1,5 +1,5 @@
name: geval name: geval
version: 1.0.0.1 version: 1.1.0.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

View File

@ -268,11 +268,12 @@ 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 [(SourceSpec, [MetricValue])]
geval gevalSpec = do geval gevalSpec = do
(inputSource, expectedSource, outSource) <- checkAndGetFiles False gevalSpec (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
where metrics = gesMetrics gevalSpec return [(outSource, results)]
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

View File

@ -23,6 +23,8 @@ import GEval.Core
import GEval.CreateChallenge import GEval.CreateChallenge
import GEval.LineByLine import GEval.LineByLine
import Data.Conduit.SmartSource
fullOptionsParser = info (helper <*> optionsParser) fullOptionsParser = info (helper <*> optionsParser)
(fullDesc (fullDesc
<> progDesc "Run evaluation for tests in Gonito platform" <> progDesc "Run evaluation for tests in Gonito platform"
@ -133,14 +135,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 [(SourceSpec, [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 [(SourceSpec, [MetricValue])]))
runGEvalGetOptions args = do runGEvalGetOptions args = do
optionExtractionResult <- getOptions args optionExtractionResult <- getOptions args
case optionExtractionResult of case optionExtractionResult of
@ -176,10 +178,10 @@ 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 [(SourceSpec, [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 [(SourceSpec, [MetricValue])])
runGEval''' Nothing _ spec = do runGEval''' Nothing _ spec = do
vals <- geval spec vals <- geval spec
return $ Just vals return $ Just vals

View File

@ -47,7 +47,8 @@ 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
(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 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
@ -336,8 +337,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 [(SourceSpec, [MetricValue])])) -> IO MetricValue
extractVal (Right (Just (val:_))) = return val extractVal (Right (Just ([(_, val:_)]))) = return val
runGEvalTest = runGEvalTestExtraOptions [] runGEvalTest = runGEvalTestExtraOptions []