From 67f73f420e9d6346edaa29bf69f6905aae282848 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Tue, 2 Aug 2016 09:48:58 +0200
Subject: [PATCH] ClippEU passes tests

---
 src/GEval/ClippEU.hs                          |  9 +++++++-
 src/GEval/Core.hs                             | 23 ++++++++++++++++++-
 src/GEval/PrecisionRecall.hs                  |  2 +-
 test/Spec.hs                                  |  7 +++---
 .../{ => test-A}/out.tsv                      |  0
 5 files changed, 35 insertions(+), 6 deletions(-)
 rename test/clippeu-simple/clippeu-simple-solution/{ => test-A}/out.tsv (100%)

diff --git a/src/GEval/ClippEU.hs b/src/GEval/ClippEU.hs
index d1fc683..c93a174 100644
--- a/src/GEval/ClippEU.hs
+++ b/src/GEval/ClippEU.hs
@@ -54,7 +54,7 @@ clippingSpecParser = do
   rectangle <- rectangleParser
   char '/'
   margin <- decimal
-  return $ ClippingSpec pageNo rectangle (extendedRectangle margin rectangle)
+  return $ ClippingSpec pageNo (smallerRectangle margin rectangle) (extendedRectangle margin rectangle)
 
 possibleWhitespace = many' (satisfy isHorizontalSpace)
 
@@ -65,6 +65,13 @@ extendedRectangle margin (Rectangle (Point x0 y0) (Point x1 y1)) =
   Rectangle (Point (x0 `nonNegativeDiff` margin) (y0 `nonNegativeDiff` margin))
             (Point (x1 + margin) (y1 + margin))
 
+smallerRectangle :: Int -> Rectangle -> Rectangle
+smallerRectangle margin (Rectangle (Point x0 y0) (Point x1 y1)) =
+  Rectangle (Point (x0 + margin) (y0 + margin))
+            (Point (x1 `nonNegativeDiff` margin) (y1 `nonNegativeDiff` margin))
+
+
+
 nonNegativeDiff x y
   | x < y = 0
   | otherwise = x - y
diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs
index 2f7ab4b..83035c2 100644
--- a/src/GEval/Core.hs
+++ b/src/GEval/Core.hs
@@ -35,12 +35,16 @@ import System.FilePath
 import Data.Maybe
 import qualified Data.List.Split as DLS
 
+import Data.Attoparsec.Text (parseOnly)
+
 import GEval.BLEU
 import GEval.Common
+import GEval.ClippEU
+import GEval.PrecisionRecall
 
 type MetricValue = Double
 
-data Metric = RMSE | MSE | BLEU | Accuracy
+data Metric = RMSE | MSE | BLEU | Accuracy | ClippEU
               deriving (Show, Read, Eq)
 
 data MetricOrdering = TheLowerTheBetter | TheHigherTheBetter
@@ -50,6 +54,7 @@ getMetricOrdering RMSE     = TheLowerTheBetter
 getMetricOrdering MSE      = TheLowerTheBetter
 getMetricOrdering BLEU     = TheHigherTheBetter
 getMetricOrdering Accuracy = TheHigherTheBetter
+getMetricOrdering ClippEU  = TheHigherTheBetter
 
 defaultOutDirectory = "."
 defaultTestName = "test-A"
@@ -168,6 +173,17 @@ gevalCore' BLEU = gevalCore'' (Prelude.map Prelude.words . DLS.splitOn "\t" . un
 gevalCore' Accuracy = gevalCore'' strip strip hitOrMiss averageC id
                       where hitOrMiss (x,y) = if x == y then 1.0 else 0.0
 
+gevalCore' ClippEU = gevalCore'' parseClippingSpecs parseClippings matchStep clippeuAgg finalStep
+  where
+    parseClippings = controlledParse lineClippingsParser
+    parseClippingSpecs = controlledParse lineClippingSpecsParser
+    matchStep (clippingSpecs, clippings) = (maxMatch matchClippingToSpec clippingSpecs clippings,
+                                            Prelude.length clippingSpecs,
+                                            Prelude.length clippings)
+    clippeuAgg = CC.foldl clippeuFuse (0, 0, 0)
+    clippeuFuse (a1, a2, a3) (b1, b2, b3) = (a1+b1, a2+b2, a3+b3)
+    finalStep counts = f2MeasureOnCounts counts
+
 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)
@@ -210,3 +226,8 @@ getValue (Right (x, reminder)) =
   then x
   else throw $ UnexpectedData "number expected"
 getValue (Left s) = throw $ UnexpectedData s
+
+controlledParse parser t =
+  case parseOnly parser t of
+    (Right v) -> v
+    (Left _) -> throw $ UnexpectedData "cannot parse line"
diff --git a/src/GEval/PrecisionRecall.hs b/src/GEval/PrecisionRecall.hs
index 4eefb33..967966b 100644
--- a/src/GEval/PrecisionRecall.hs
+++ b/src/GEval/PrecisionRecall.hs
@@ -2,7 +2,7 @@
 
 module GEval.PrecisionRecall(fMeasure, f1Measure, f2Measure, precision, recall,
                              fMeasureOnCounts, f1MeasureOnCounts, f2MeasureOnCounts,
-                             precisionAndRecall, precisionAndRecallFromCounts)
+                             precisionAndRecall, precisionAndRecallFromCounts, maxMatch)
        where
 
 import GEval.Common
diff --git a/test/Spec.hs b/test/Spec.hs
index 5388efc..161cc49 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -84,11 +84,12 @@ main = hspec $ do
       r `shouldBe` []
     it "parsing specs" $ do
       let (Right r) = parseOnly lineClippingSpecsParser  " 2/0,0,2,3/5  10/20,30,40,50/10"
-      r `shouldBe` [ClippingSpec (PageNumber 2) (Rectangle (Point 0 0) (Point 2 3))
+      r `shouldBe` [ClippingSpec (PageNumber 2) (Rectangle (Point 5 5) (Point 0 0))
                                                 (Rectangle (Point 0 0) (Point 7 8)),
-                    ClippingSpec (PageNumber 10) (Rectangle (Point 20 30) (Point 40 50))
+                    ClippingSpec (PageNumber 10) (Rectangle (Point 30 40) (Point 30 40))
                                                  (Rectangle (Point 10 20) (Point 50 60))]
-
+    it "full test" $ do
+      runGEvalTest "clippeu-simple" `shouldReturnAlmost` 0.399999999999
 
 neverMatch :: Char -> Int -> Bool
 neverMatch _ _ = False
diff --git a/test/clippeu-simple/clippeu-simple-solution/out.tsv b/test/clippeu-simple/clippeu-simple-solution/test-A/out.tsv
similarity index 100%
rename from test/clippeu-simple/clippeu-simple-solution/out.tsv
rename to test/clippeu-simple/clippeu-simple-solution/test-A/out.tsv