generalize gevalcore

This commit is contained in:
Filip Gralinski 2015-08-24 22:51:03 +02:00 committed by Filip Gralinski
parent 1e444ca3ec
commit cc514d085d

View File

@ -124,14 +124,17 @@ gevalCore metric expectedFilePath outFilePath = do
gevalCore' metric expectedFilePath outFilePath gevalCore' metric expectedFilePath outFilePath
gevalCore' :: Metric -> String -> String -> IO (MetricValue) gevalCore' :: Metric -> String -> String -> IO (MetricValue)
gevalCore' MSE expectedFilePath outFilePath = gevalCore' MSE = gevalCore'' outParser outParser itemError averageC
where outParser = getValue . TR.double
gevalCore'' :: (Text -> a) -> (Text -> b) -> ((a, b) -> c) -> (Sink c (ResourceT IO) Double) -> String -> String -> IO (MetricValue)
gevalCore'' expParser outParser itemStep aggregator expectedFilePath outFilePath =
runResourceT $ runResourceT $
(getZipSource $ (,) (getZipSource $ (,)
<$> ZipSource (items expectedFilePath) <$> ZipSource (items expectedFilePath expParser)
<*> ZipSource (items outFilePath)) <*> ZipSource (items outFilePath outParser))
$$ (CL.map itemError $$ (CL.map itemStep
=$ averageC) =$ aggregator)
averageC :: MonadResource m => Sink Double m Double averageC :: MonadResource m => Sink Double m Double
averageC = getZipSink averageC = getZipSink
@ -139,14 +142,12 @@ averageC = getZipSink
<$> ZipSink CC.sum <$> ZipSink CC.sum
<*> ZipSink CC.length <*> ZipSink CC.length
items :: MonadResource m => String -> Source m Double items :: MonadResource m => String -> (Text -> a) -> Source m a
items filePath = items filePath parser =
CB.sourceFile filePath CB.sourceFile filePath
$= (CT.decode CT.utf8 $= (CT.decode CT.utf8
=$= CT.lines =$= CT.lines
=$= CL.map TR.double =$= CL.map parser)
=$= CC.map getValue)
itemError :: (Double, Double) -> Double itemError :: (Double, Double) -> Double
itemError (exp, out) = (exp-out)**2 itemError (exp, out) = (exp-out)**2