diff --git a/app/Main.hs b/app/Main.hs index 4013660..9cb6434 100644 --- a/app/Main.hs +++ b/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) diff --git a/geval.cabal b/geval.cabal index 3efbcc6..763b5f5 100644 --- a/geval.cabal +++ b/geval.cabal @@ -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 diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 0a566c3..6001c15 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -268,11 +268,12 @@ 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 - where metrics = gesMetrics gevalSpec + results <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics + return [(outSource, results)] + where metrics = gesMetrics gevalSpec checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec) checkAndGetFiles forceInput gevalSpec = do diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index a5774a7..6647612 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs index 7528885..7a71977 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 []