From 17d39c42931dd0b6405f5710b2e94a913930dabc Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Fri, 6 Nov 2015 21:57:36 +0100 Subject: [PATCH] check the number of lines --- geval.cabal | 2 +- src/GEval/Core.hs | 27 ++++++++++++++----- test/Spec.hs | 12 +++++++++ .../test-A/out.tsv | 1 + .../error-too-few-lines/config.txt | 1 + .../error-too-few-lines/test-A/expected.tsv | 3 +++ .../error-too-few-lines/test-A/in.tsv | 3 +++ .../test-A/out.tsv | 4 +++ .../error-too-many-lines/config.txt | 1 + .../error-too-many-lines/test-A/expected.tsv | 3 +++ .../error-too-many-lines/test-A/in.tsv | 3 +++ 11 files changed, 53 insertions(+), 7 deletions(-) create mode 100644 test/error-too-few-lines/error-too-few-lines-solution/test-A/out.tsv create mode 100644 test/error-too-few-lines/error-too-few-lines/config.txt create mode 100644 test/error-too-few-lines/error-too-few-lines/test-A/expected.tsv create mode 100644 test/error-too-few-lines/error-too-few-lines/test-A/in.tsv create mode 100644 test/error-too-many-lines/error-too-many-lines-solution/test-A/out.tsv create mode 100644 test/error-too-many-lines/error-too-many-lines/config.txt create mode 100644 test/error-too-many-lines/error-too-many-lines/test-A/expected.tsv create mode 100644 test/error-too-many-lines/error-too-many-lines/test-A/in.tsv diff --git a/geval.cabal b/geval.cabal index 1895440..d50c1a7 100644 --- a/geval.cabal +++ b/geval.cabal @@ -1,5 +1,5 @@ name: geval -version: 0.1.2.1 +version: 0.2.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 0668328..2f9ab13 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -77,6 +77,9 @@ data GEvalException = NoExpectedFile FilePath | NoExpectedTestDirectory FilePath | NoOutTestDirectory FilePath | FileAlreadyThere FilePath + | TooFewLines + | TooManyLines + deriving (Eq) instance Exception GEvalException @@ -88,6 +91,8 @@ instance Show GEvalException where show (NoExpectedTestDirectory filePath) = somethingWrongWithFilesMessage "No test subdirectory with the expected results" filePath show (NoOutTestDirectory filePath) = somethingWrongWithFilesMessage "No test subdirectory with the results obtained" filePath show (FileAlreadyThere filePath) = somethingWrongWithFilesMessage "File already there" filePath + show TooFewLines = "Too few lines in the output file" + show TooManyLines = "Too many lines in the output file" somethingWrongWithFilesMessage :: String -> FilePath -> String somethingWrongWithFilesMessage msg filePath = Prelude.concat @@ -148,28 +153,38 @@ gevalCore' Accuracy = gevalCore'' strip strip hitOrMiss averageC id x /. 0 = 1.0 x /. y = (fromIntegral x) / (fromIntegral y) +data SourceItem a = Got a | Done + gevalCore'' :: (Text -> a) -> (Text -> b) -> ((a, b) -> c) -> (Sink c (ResourceT IO) d) -> (d -> Double ) -> String -> String -> IO (MetricValue) gevalCore'' expParser outParser itemStep aggregator finalStep expectedFilePath outFilePath = do v <- runResourceT $ (getZipSource $ (,) <$> ZipSource (items expectedFilePath expParser) <*> ZipSource (items outFilePath outParser)) - $$ (CL.map itemStep + $$ (CL.map (checkStep itemStep) + =$= CL.catMaybes =$ aggregator) return $ finalStep v +checkStep :: ((a, b) -> c) -> (SourceItem a, SourceItem b) -> Maybe c +checkStep step (Got expectedItem, Got outItem) = Just $ step (expectedItem, outItem) +checkStep _ (Got _, Done) = throw TooFewLines +checkStep _ (Done, Got _) = throw TooManyLines +checkStep _ (Done, Done) = Nothing + + averageC :: MonadResource m => Sink Double m Double averageC = getZipSink $ (\total count -> total / fromIntegral count) <$> ZipSink CC.sum <*> ZipSink CC.length -items :: MonadResource m => String -> (Text -> a) -> Source m a +items :: MonadResource m => String -> (Text -> a) -> Source m (SourceItem a) items filePath parser = - CB.sourceFile filePath - $= (CT.decode CT.utf8 - =$= CT.lines - =$= CL.map parser) + (CB.sourceFile filePath + $= (CT.decode CT.utf8 + =$= CT.lines + =$= CL.map ((\x -> Got x) . parser))) >> yield Done itemError :: (Double, Double) -> Double itemError (exp, out) = (exp-out)**2 diff --git a/test/Spec.hs b/test/Spec.hs index 927f886..9284367 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -48,10 +48,22 @@ main = hspec $ do precisionCount [["bar", "bar", "bar", "bar", "foo", "xyz", "foo"]] ["foo", "bar", "foo", "baz", "bar", "foo"] `shouldBe` 4 it "multiple refs" $ do precisionCount [["foo", "baz"], ["bar"], ["baz", "xyz"]] ["foo", "bar", "foo"] `shouldBe` 2 + describe "error handling" $ do + it "too few lines are handled" $ do + runGEvalTest "error-too-few-lines" `shouldThrow` (== TooFewLines) + it "too many lines are handled" $ do + runGEvalTest "error-too-many-lines" `shouldThrow` (== TooManyLines) + extractVal :: (Either (ParserResult GEvalOptions) (Maybe MetricValue)) -> IO MetricValue extractVal (Right (Just val)) = return val +runGEvalTest testName = (runGEval [ + "--expected-directory", + "test/" ++ testName ++ "/" ++ testName, + "--out-directory", + "test/" ++ testName ++ "/" ++ testName ++ "-solution"]) >>= extractVal + class AEq a where (=~) :: a -> a -> Bool diff --git a/test/error-too-few-lines/error-too-few-lines-solution/test-A/out.tsv b/test/error-too-few-lines/error-too-few-lines-solution/test-A/out.tsv new file mode 100644 index 0000000..d3827e7 --- /dev/null +++ b/test/error-too-few-lines/error-too-few-lines-solution/test-A/out.tsv @@ -0,0 +1 @@ +1.0 diff --git a/test/error-too-few-lines/error-too-few-lines/config.txt b/test/error-too-few-lines/error-too-few-lines/config.txt new file mode 100644 index 0000000..e2faf3d --- /dev/null +++ b/test/error-too-few-lines/error-too-few-lines/config.txt @@ -0,0 +1 @@ +--metric MSE diff --git a/test/error-too-few-lines/error-too-few-lines/test-A/expected.tsv b/test/error-too-few-lines/error-too-few-lines/test-A/expected.tsv new file mode 100644 index 0000000..5a817f5 --- /dev/null +++ b/test/error-too-few-lines/error-too-few-lines/test-A/expected.tsv @@ -0,0 +1,3 @@ +3.0 +10.0 +2.8 diff --git a/test/error-too-few-lines/error-too-few-lines/test-A/in.tsv b/test/error-too-few-lines/error-too-few-lines/test-A/in.tsv new file mode 100644 index 0000000..65bfc7a --- /dev/null +++ b/test/error-too-few-lines/error-too-few-lines/test-A/in.tsv @@ -0,0 +1,3 @@ +A b +B c +A c diff --git a/test/error-too-many-lines/error-too-many-lines-solution/test-A/out.tsv b/test/error-too-many-lines/error-too-many-lines-solution/test-A/out.tsv new file mode 100644 index 0000000..9effd8c --- /dev/null +++ b/test/error-too-many-lines/error-too-many-lines-solution/test-A/out.tsv @@ -0,0 +1,4 @@ +1.0 +4.0 +3.2 +-1.0 diff --git a/test/error-too-many-lines/error-too-many-lines/config.txt b/test/error-too-many-lines/error-too-many-lines/config.txt new file mode 100644 index 0000000..e2faf3d --- /dev/null +++ b/test/error-too-many-lines/error-too-many-lines/config.txt @@ -0,0 +1 @@ +--metric MSE diff --git a/test/error-too-many-lines/error-too-many-lines/test-A/expected.tsv b/test/error-too-many-lines/error-too-many-lines/test-A/expected.tsv new file mode 100644 index 0000000..5a817f5 --- /dev/null +++ b/test/error-too-many-lines/error-too-many-lines/test-A/expected.tsv @@ -0,0 +1,3 @@ +3.0 +10.0 +2.8 diff --git a/test/error-too-many-lines/error-too-many-lines/test-A/in.tsv b/test/error-too-many-lines/error-too-many-lines/test-A/in.tsv new file mode 100644 index 0000000..65bfc7a --- /dev/null +++ b/test/error-too-many-lines/error-too-many-lines/test-A/in.tsv @@ -0,0 +1,3 @@ +A b +B c +A c