From 85ec1fdccbb3dea6044faabbc2c512f5c1fb464e Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Wed, 19 Aug 2015 23:24:19 +0200
Subject: [PATCH] simple test passed

---
 geval.cabal                                   |  1 +
 src/Lib.hs                                    | 33 +++++++++++++++----
 test/Spec.hs                                  | 18 +++++++++-
 .../mse-simple-solution/test-A/out.tsv        |  3 ++
 .../mse-simple/mse-simple/test-A/expected.tsv |  3 ++
 5 files changed, 50 insertions(+), 8 deletions(-)
 create mode 100644 test/mse-simple/mse-simple-solution/test-A/out.tsv
 create mode 100644 test/mse-simple/mse-simple/test-A/expected.tsv

diff --git a/geval.cabal b/geval.cabal
index e86b594..5fba4cd 100644
--- a/geval.cabal
+++ b/geval.cabal
@@ -39,6 +39,7 @@ test-suite geval-test
   build-depends:       base
                      , geval
                      , hspec
+                     , HUnit
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 
diff --git a/src/Lib.hs b/src/Lib.hs
index ff65835..add2f5c 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -10,16 +10,35 @@ import Control.Monad.Trans.Resource
 import qualified Data.Conduit.List as CL
 import Data.Text
 import Data.Text.Read as TR
+import Control.Applicative
 
 geval :: String -> String -> IO (Double)
 geval expectedFilePath outFilePath = do
-  runResourceT $
-    CB.sourceFile expectedFilePath
-    $$ CT.decode CT.utf8
-    =$= CT.lines
-    =$= CL.map TR.double
-    =$= CC.map getValue
-    =$ CC.sum
+  mse <- runResourceT $
+    (getZipSource $ (,)
+       <$> ZipSource (items expectedFilePath)
+       <*> ZipSource (items outFilePath))
+     $$ (CL.map itemError
+         =$ averageC)
+  return $ mse ** 0.5
+
+averageC :: MonadResource m => Sink Double m Double
+averageC = getZipSink
+    $ (\total count -> total / fromIntegral count)
+  <$> ZipSink CC.sum
+  <*> ZipSink CC.length
+
+items :: MonadResource m => String -> Source m Double
+items filePath =
+  CB.sourceFile filePath
+  $= (CT.decode CT.utf8
+      =$= CT.lines
+      =$= CL.map TR.double
+      =$= CC.map getValue)
+
+
+itemError :: (Double, Double) -> Double
+itemError (exp, out) = (exp-out)**2
 
 getValue :: Either String (Double, Text) -> Double
 getValue (Right (x, _)) = x
diff --git a/test/Spec.hs b/test/Spec.hs
index 812d517..74327b7 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,9 +1,25 @@
 import Test.Hspec
 
 import Lib
+import qualified Test.HUnit as HU
 
 main :: IO ()
 main = hspec $ do
   describe "mean square error" $ do
     it "simple test" $ do
-      geval "test/mse-simple/mse-simple/test-A/expected.tsv" "test/mse-simple/mse-simple-solution/test-A/out.tsv" `shouldReturn` 1.118033988749
+      geval "test/mse-simple/mse-simple/test-A/expected.tsv" "test/mse-simple/mse-simple-solution/test-A/out.tsv" `shouldReturnAlmost` 0.64549722436790
+
+class AEq a where
+    (=~) :: a -> a -> Bool
+
+instance AEq Double where
+    x =~ y = abs ( x - y ) < (1.0e-8 :: Double)
+
+(@=~?) :: (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)
diff --git a/test/mse-simple/mse-simple-solution/test-A/out.tsv b/test/mse-simple/mse-simple-solution/test-A/out.tsv
new file mode 100644
index 0000000..51f4458
--- /dev/null
+++ b/test/mse-simple/mse-simple-solution/test-A/out.tsv
@@ -0,0 +1,3 @@
+3.0
+3.0
+2.0
diff --git a/test/mse-simple/mse-simple/test-A/expected.tsv b/test/mse-simple/mse-simple/test-A/expected.tsv
new file mode 100644
index 0000000..7848f76
--- /dev/null
+++ b/test/mse-simple/mse-simple/test-A/expected.tsv
@@ -0,0 +1,3 @@
+2.0
+3.0
+1.5