2015-08-19 22:14:34 +02:00
|
|
|
import Test.Hspec
|
|
|
|
|
2015-08-23 08:14:47 +02:00
|
|
|
import GEval.Core
|
|
|
|
import GEval.OptionsParser
|
2015-08-24 22:23:35 +02:00
|
|
|
import GEval.BLEU
|
2015-08-23 07:40:37 +02:00
|
|
|
import Options.Applicative
|
2015-08-19 23:24:19 +02:00
|
|
|
import qualified Test.HUnit as HU
|
2015-08-19 22:14:34 +02:00
|
|
|
|
2015-08-17 23:32:00 +02:00
|
|
|
main :: IO ()
|
2015-08-19 22:14:34 +02:00
|
|
|
main = hspec $ do
|
2015-08-23 07:40:37 +02:00
|
|
|
describe "root mean square error" $ do
|
2015-08-19 22:14:34 +02:00
|
|
|
it "simple test" $ do
|
2015-08-23 07:40:37 +02:00
|
|
|
geval (defaultGEvalSpecification {gesExpectedDirectory=Just "test/rmse-simple/rmse-simple", gesOutDirectory="test/rmse-simple/rmse-simple-solution"}) `shouldReturnAlmost` 0.64549722436790
|
|
|
|
describe "mean square error" $ do
|
2015-11-06 22:02:01 +01:00
|
|
|
it "simple test with arguments" $
|
|
|
|
runGEvalTest "mse-simple" `shouldReturnAlmost` 0.4166666666666667
|
2015-08-24 23:40:40 +02:00
|
|
|
describe "BLEU" $ do
|
2015-11-06 22:02:01 +01:00
|
|
|
it "trivial example from Wikipedia" $
|
|
|
|
runGEvalTest "bleu-trivial" `shouldReturnAlmost` 0.0
|
|
|
|
it "complex example" $
|
|
|
|
runGEvalTest "bleu-complex" `shouldReturnAlmost` 0.6211
|
|
|
|
it "perfect translation" $
|
|
|
|
runGEvalTest "bleu-perfect" `shouldReturnAlmost` 1.0000
|
2015-10-31 19:05:23 +01:00
|
|
|
describe "Accuracy" $ do
|
2015-11-06 22:02:01 +01:00
|
|
|
it "simple example" $
|
|
|
|
runGEvalTest "accuracy-simple" `shouldReturnAlmost` 0.6
|
2015-08-24 22:23:35 +02:00
|
|
|
describe "precision count" $ do
|
|
|
|
it "simple test" $ do
|
|
|
|
precisionCount [["Alice", "has", "a", "cat" ]] ["Ala", "has", "cat"] `shouldBe` 2
|
|
|
|
it "none found" $ do
|
|
|
|
precisionCount [["Alice", "has", "a", "cat" ]] ["for", "bar", "baz"] `shouldBe` 0
|
|
|
|
it "multiple values" $ 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
|
2015-12-20 16:49:17 +01:00
|
|
|
describe "reading options" $ do
|
|
|
|
it "can get the metric" $ do
|
|
|
|
extractMetric "bleu-complex" `shouldReturn` (Just BLEU)
|
2015-11-06 21:57:36 +01:00
|
|
|
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)
|
2015-11-06 22:42:08 +01:00
|
|
|
it "empty output is handled" $ do
|
|
|
|
runGEvalTest "empty-output" `shouldThrow` (== EmptyOutput)
|
2015-11-06 23:14:10 +01:00
|
|
|
it "unexpected data is handled" $
|
|
|
|
runGEvalTest "unexpected-data" `shouldThrow` (== UnexpectedData "input does not start with a digit")
|
2015-11-06 23:24:46 +01:00
|
|
|
it "unwanted data is handled" $
|
|
|
|
runGEvalTest "unwanted-data" `shouldThrow` (== UnexpectedData "number expected")
|
|
|
|
|
2015-08-23 07:40:37 +02:00
|
|
|
|
|
|
|
extractVal :: (Either (ParserResult GEvalOptions) (Maybe MetricValue)) -> IO MetricValue
|
|
|
|
extractVal (Right (Just val)) = return val
|
2015-08-19 23:24:19 +02:00
|
|
|
|
2015-11-06 21:57:36 +01:00
|
|
|
runGEvalTest testName = (runGEval [
|
|
|
|
"--expected-directory",
|
|
|
|
"test/" ++ testName ++ "/" ++ testName,
|
|
|
|
"--out-directory",
|
|
|
|
"test/" ++ testName ++ "/" ++ testName ++ "-solution"]) >>= extractVal
|
|
|
|
|
2015-12-20 16:49:17 +01:00
|
|
|
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
|
|
|
|
|
2015-08-19 23:24:19 +02:00
|
|
|
class AEq a where
|
|
|
|
(=~) :: a -> a -> Bool
|
|
|
|
|
|
|
|
instance AEq Double where
|
2015-08-25 16:10:20 +02:00
|
|
|
x =~ y = abs ( x - y ) < (1.0e-4 :: Double)
|
2015-08-19 23:24:19 +02:00
|
|
|
|
|
|
|
(@=~?) :: (Show a, AEq a) => a -> a -> HU.Assertion
|
|
|
|
(@=~?) expected actual = expected =~ actual HU.@? assertionMsg
|
|
|
|
where
|
|
|
|
assertionMsg = "Expected : " ++ show expected ++
|
|
|
|
"\nActual : " ++ show actual
|
|
|
|
|
|
|
|
shouldReturnAlmost :: (AEq a, Show a, Eq a) => IO a -> a -> Expectation
|
|
|
|
shouldReturnAlmost action expected = action >>= (@=~? expected)
|