From b14e6a38a28464fdd3cb9d2dbecd992cbc8f367f Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@ceti.pl>
Date: Tue, 26 Jul 2016 16:55:23 +0200
Subject: [PATCH] start implementing general precision/recall

---
 src/GEval/PrecisionRecall.hs | 46 ++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 src/GEval/PrecisionRecall.hs

diff --git a/src/GEval/PrecisionRecall.hs b/src/GEval/PrecisionRecall.hs
new file mode 100644
index 0000000..2872c75
--- /dev/null
+++ b/src/GEval/PrecisionRecall.hs
@@ -0,0 +1,46 @@
+module GEval.PrecisionRecall
+       where
+
+f2Measure :: (a -> b -> Bool) -> [a] -> [b] -> Double
+f2Measure = fMeasure 2.0
+
+fMeasure :: Double -> (a -> b -> Bool) -> [a] -> [b] -> Double
+fMeasure beta matchingFun expected got =
+  (1 + betaSquared) * (p + r) / (betaSquared * p + 2)
+  where betaSquared = beta ^ 2
+        (p, r) = precisionAndRecall matchingFun expected got
+
+precisionAndRecall :: (a -> b -> Bool) -> [a] -> [b] -> (Double, Double)
+precisionAndRecall matchFun expected got = precisionAndRecallFromCounts cs
+  where cs = counts matchFun expected got
+
+precisionAndRecallFromCounts :: (Int, Int, Int) -> (Double, Double)
+precisionAndRecallFromCounts (fp, fn, tp) = (tp / (tp+fp+epsilon), tp / (tp+fn+epsilon))
+  where epsilon = 0.000001
+
+precision :: (a -> b -> Bool) -> [a] -> [b] -> Double
+precision = first . precisionAndRecall
+
+recall :: (a -> b -> Bool) -> [a] -> [b] -> Double
+recall = second . precisionAndRecall
+
+counts :: (a -> b -> Bool) -> [a] -> [b] -> (Int, Int, Int)
+counts matchFun expected got = f
+
+
+countStep :: ([a], (Int, Int)) -> b -> ([a], (Int, Int))
+countStep (expectedLeft, fp, tp) itemGot =
+  (rest, case firstMatched of
+      Just _ -> (fp, tp+1)
+      Nothing -> (fp+1, tp))
+  where (rest, firstMatched) = findFirst ((flip matchingFun) itemGot) expectedLeft
+
+findFirst :: (a -> Bool) -> [a] -> ([a], Maybe a)
+findFirst _ [] -> ([], Nothing)
+findFirst condition (x:xs) = if (condition x)
+                                then
+                                  (xs, Just x)
+                                else
+                                  (x:xs', m)
+                                  where
+                                  (xs',m) = findFirst condition xs