Handle preprocessing operations for metrics

app/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import GEval.Core
+import GEval.EvaluationScheme
 import GEval.Common
 import GEval.OptionsParser
 import GEval.ParseParams
@@ -56,12 +57,12 @@ showTable opts multipleResults = do
   mapM_ (\entry -> putStrLn $ formatTableEntry opts paramNames entry) $ zip multipleResults params
   where metrics = gesMetrics $ geoSpec opts
 
-getHeader :: [T.Text] -> [Metric] -> Maybe String
+getHeader :: [T.Text] -> [EvaluationScheme] -> Maybe String
 getHeader [] [singleMetric] = Nothing
 getHeader [] [] = error "no metric given"
-getHeader [] metrics = Just $ intercalate "\t" ("File name" : Prelude.map show metrics)
+getHeader [] schemes = Just $ intercalate "\t" ("File name" : Prelude.map evaluationSchemeName schemes)
-getHeader params metrics = Just $ intercalate "\t" (Prelude.map T.unpack params
+getHeader params schemes = Just $ intercalate "\t" (Prelude.map T.unpack params
-                                                    ++ Prelude.map show metrics)
+                                                    ++ Prelude.map evaluationSchemeName schemes)
 
 formatTableEntry :: GEvalOptions -> [T.Text] -> ((SourceSpec, [MetricValue]), OutputFileParsed) -> String
 formatTableEntry opts paramNames ((sourceSpec, metrics), ofParsed) = intercalate "\t" ((initialColumns paramNames sourceSpec ofParsed) ++ vals)
@@ -84,8 +85,8 @@ formatSourceSpec :: SourceSpec -> String
 formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
 formatSourceSpec spec = show spec
 
-formatTheMetricAndResult :: Maybe Int -> (Metric, MetricValue) -> String
+formatTheMetricAndResult :: Maybe Int -> (EvaluationScheme, MetricValue) -> String
-formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
+formatTheMetricAndResult mPrecision (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult mPrecision val)
 
 
 formatTheResult :: Maybe Int -> MetricValue -> String

geval.cabal

@@ -1,5 +1,5 @@
 name:                geval
-version:             1.18.2.0
+version:             1.19.0.0
 synopsis:            Machine learning evaluation tools
 description:         Please see README.md
 homepage:            http://github.com/name/project
@@ -17,6 +17,7 @@ library
   hs-source-dirs:      src
   exposed-modules:     GEval.Core
                      , GEval.Metric
+                     , GEval.EvaluationScheme
                      , GEval.CreateChallenge
                      , GEval.OptionsParser
                      , GEval.BLEU
@@ -81,6 +82,7 @@ library
                      , containers
                      , statistics
                      , pcre-heavy
+                     , pcre-light
                      , process
                      , uri-encode
                      , MissingH
@@ -95,6 +97,7 @@ library
                      , errors
                      , filemanip
                      , temporary
+                     , utf8-string
   default-language:    Haskell2010
 
 executable geval

src/GEval/Core.hs

@@ -49,6 +49,7 @@ module GEval.Core
     ) where
 
 import GEval.Metric
+import GEval.EvaluationScheme
 
 import Data.Conduit
 import Data.Conduit.Combinators as CC
@@ -159,7 +160,7 @@ data GEvalSpecification = GEvalSpecification
                             gesOutFile :: String,
                             gesExpectedFile :: String,
                             gesInputFile :: String,
-                            gesMetrics :: [Metric],
+                            gesMetrics :: [EvaluationScheme],
                             gesPrecision :: Maybe Int,
                             gesTokenizer :: Maybe Tokenizer,
                             gesGonitoHost :: Maybe String,
@@ -170,7 +171,7 @@ data GEvalSpecification = GEvalSpecification
 
 gesMainMetric :: GEvalSpecification -> Metric
 gesMainMetric spec = case gesMetrics spec of
-  (metric:_) -> metric
+  (scheme:_) -> evaluationSchemeMetric scheme
   otherwise -> error "no metric given"
 
 gesPreprocess :: GEvalSpecification -> (Text -> Text)
@@ -248,7 +249,7 @@ defaultGEvalSpecification = GEvalSpecification {
   gesOutFile = defaultOutFile,
   gesExpectedFile = defaultExpectedFile,
   gesInputFile = defaultInputFile,
-  gesMetrics = [defaultMetric],
+  gesMetrics = [EvaluationScheme defaultMetric []],
   gesPrecision = Nothing,
   gesTokenizer = Nothing,
   gesGonitoHost = Nothing,
@@ -280,9 +281,14 @@ noGraph = const Nothing
 
 gevalOnSingleOut :: GEvalSpecification -> SourceSpec -> SourceSpec -> SourceSpec -> IO (SourceSpec, [MetricOutput])
 gevalOnSingleOut gevalSpec inputSource expectedSource outSource = do
-  vals <- Prelude.mapM (\metric -> gevalCore metric mSelector preprocess inputSource expectedSource outSource) metrics
+  vals <- Prelude.mapM (\scheme -> gevalCore (evaluationSchemeMetric scheme)
+                                           mSelector
+                                           (preprocess . applyPreprocessingOperations scheme)
+                                           inputSource
+                                           expectedSource
+                                           outSource) schemes
   return (outSource, vals)
-  where metrics = gesMetrics gevalSpec
+  where schemes = gesMetrics gevalSpec
         preprocess = gesPreprocess gevalSpec
         mSelector = gesSelector gevalSpec
 
@@ -305,7 +311,7 @@ checkAndGetFiles forceInput gevalSpec = do
        throwM $ NoExpectedDirectory d
     Right expectedSource -> do
        -- in most cases inputSource is NoSource (unless needed by a metric or in the line-by-line mode)
-       inputSource <- getInputSourceIfNeeded forceInput metrics expectedTestDirectory inputFile
+       inputSource <- getInputSourceIfNeeded forceInput (Prelude.map evaluationSchemeMetric schemes) expectedTestDirectory inputFile
 
        mMultipleOuts <- checkMultipleOuts gevalSpec
        osss <- case mMultipleOuts of
@@ -330,7 +336,7 @@ checkAndGetFiles forceInput gevalSpec = do
           outFile = gesOutFile gevalSpec
           expectedFile = gesExpectedFile gevalSpec
           inputFile = gesInputFile gevalSpec
-          metrics = gesMetrics gevalSpec
+          schemes = gesMetrics gevalSpec
 
 checkSingleOut :: FilePath -> FilePath -> IO (Either SmartSourceError SourceSpec)
 checkSingleOut outTestDirectory outFile

src/GEval/CreateChallenge.hs

@@ -5,6 +5,7 @@ module GEval.CreateChallenge
        where
 
 import GEval.Metric
+import GEval.EvaluationScheme
 import GEval.Core (GEvalSpecification(..), GEvalException(..), configFileName, gesMainMetric, defaultTestName)
 import GEval.Submit (tokenFileName)
 import qualified System.Directory as D
@@ -370,8 +371,8 @@ Directory structure
 |]
 
 
-configContents :: [Metric] -> Maybe Int -> String -> String
+configContents :: [EvaluationScheme] -> Maybe Int -> String -> String
-configContents metrics precision testName = unwords (Prelude.map (\metric -> ("--metric " ++ (show metric))) metrics) ++
+configContents schemes precision testName = unwords (Prelude.map (\scheme -> ("--metric " ++ (show scheme))) schemes) ++
                                  (if testName /= defaultTestName
                                      then
                                         " --test-name " ++ testName

src/GEval/EvaluationScheme.hs

@@ -0,0 +1,85 @@
+module GEval.EvaluationScheme
+  (EvaluationScheme(..), evaluationSchemeMetric, applyPreprocessingOperations, evaluationSchemeName)
+  where
+
+import GEval.Metric
+
+import Text.Regex.PCRE.Heavy
+import Text.Regex.PCRE.Light.Base (Regex(..))
+import Data.Text (Text(..), concat, toLower, toUpper, pack, unpack)
+import Data.List (intercalate, break)
+import Data.Either
+import Data.Maybe (fromMaybe)
+import qualified Data.ByteString.UTF8 as BSU
+
+
+data EvaluationScheme = EvaluationScheme Metric [PreprocessingOperation]
+  deriving (Eq)
+
+data PreprocessingOperation = RegexpMatch Regex | LowerCasing | UpperCasing | SetName Text
+  deriving (Eq)
+
+leftParameterBracket :: Char
+leftParameterBracket = '<'
+
+rightParameterBracket :: Char
+rightParameterBracket = '>'
+
+instance Read EvaluationScheme where
+  readsPrec _ s = [(EvaluationScheme metric ops, theRest)]
+    where (metricS, opS) = break (== ':') s
+          metric = read metricS
+          (ops, theRest) = case opS of
+            "" -> ([], "")
+            (_:opS') -> readOps opS'
+
+readOps :: String -> ([PreprocessingOperation], String)
+readOps ('l':theRest) = (LowerCasing:ops, theRest')
+    where (ops, theRest') = readOps theRest
+readOps ('u':theRest) = (UpperCasing:ops, theRest')
+    where (ops, theRest') = readOps theRest
+readOps ('m':theRest) = handleParametrizedOp (RegexpMatch . (fromRight undefined) . ((flip compileM) []) . BSU.fromString) theRest
+readOps ('N':theRest) = handleParametrizedOp (SetName . pack) theRest
+readOps s = ([], s)
+
+handleParametrizedOp :: (String -> PreprocessingOperation) -> String -> ([PreprocessingOperation], String)
+handleParametrizedOp constructor (leftParameterBracket:theRest) =
+  case break (== rightParameterBracket) theRest of
+    (s, []) -> ([], s)
+    (param, (_:theRest')) -> let (ops, theRest'') = readOps theRest'
+                            in ((constructor param):ops, theRest'')
+handleParametrizedOp _ s = ([], s)
+
+instance Show EvaluationScheme where
+  show (EvaluationScheme metric operations) = (show metric) ++ (if null operations
+                                                                then ""
+                                                                else ":" ++ (Prelude.concat (map show operations)))
+
+evaluationSchemeName :: EvaluationScheme -> String
+evaluationSchemeName scheme@(EvaluationScheme metric operations) = fromMaybe (show scheme) (findNameSet operations)
+
+findNameSet :: [PreprocessingOperation] -> Maybe String
+findNameSet [] = Nothing
+findNameSet ((SetName name):_) = Just (unpack name)
+findNameSet (_:ops) = findNameSet ops
+
+evaluationSchemeMetric :: EvaluationScheme -> Metric
+evaluationSchemeMetric (EvaluationScheme metric _) = metric
+
+instance Show PreprocessingOperation where
+  show (RegexpMatch (Regex _ regexp)) = parametrizedOperation "m" (BSU.toString regexp)
+  show LowerCasing = "l"
+  show UpperCasing = "u"
+  show (SetName t) = parametrizedOperation "N" (unpack t)
+
+parametrizedOperation :: String -> String -> String
+parametrizedOperation opCode opArg = opCode ++ [leftParameterBracket] ++ opArg ++ [rightParameterBracket]
+
+applyPreprocessingOperations :: EvaluationScheme -> Text -> Text
+applyPreprocessingOperations (EvaluationScheme _ operations) t = foldl (flip applyPreprocessingOperation) t operations
+
+applyPreprocessingOperation :: PreprocessingOperation -> Text -> Text
+applyPreprocessingOperation (RegexpMatch regex) = Data.Text.concat . (map fst) . (scan regex)
+applyPreprocessingOperation LowerCasing = toLower
+applyPreprocessingOperation UpperCasing = toUpper
+applyPreprocessingOperation (SetName _) = id

src/GEval/OptionsParser.hs

@@ -26,6 +26,7 @@ import Data.String.Here
 import Data.Monoid ((<>))
 
 import GEval.Core
+import GEval.EvaluationScheme
 import GEval.Common
 import GEval.CreateChallenge
 import GEval.LineByLine
@@ -232,14 +233,14 @@ sel :: Maybe Metric -> Metric -> Metric
 sel Nothing m = m
 sel (Just m) _ = m
 
-metricReader :: Parser [Metric]
+metricReader :: Parser [EvaluationScheme]
 metricReader = many $ option auto         -- actually `some` should be used instead of `many`, the problem is that
                ( long "metric"            -- --metric might be in the config.txt file...
                  <> short 'm'
                  <> metavar "METRIC"
                  <> help "Metric to be used - RMSE, MSE, MAE, SMAPE, Pearson, Spearman, Accuracy, LogLoss, Likelihood, F-measure (specify as F1, F2, F0.25, etc.), macro F-measure (specify as Macro-F1, Macro-F2, Macro-F0.25, etc.), multi-label F-measure (specify as MultiLabel-F1, MultiLabel-F2, MultiLabel-F0.25, etc.), MultiLabel-Likelihood, MAP, BLEU, GLEU (\"Google GLEU\" not the grammar correction metric), WER, NMI, ClippEU, LogLossHashed, LikelihoodHashed, BIO-F1, BIO-F1-Labels, TokenAccuracy, soft F-measure (specify as Soft-F1, Soft-F2, Soft-F0.25), probabilistic soft F-measure (specify as Probabilistic-Soft-F1, Probabilistic-Soft-F2, Probabilistic-Soft-F0.25) or CharMatch" )
 
-altMetricReader :: Parser (Maybe Metric)
+altMetricReader :: Parser (Maybe EvaluationScheme)
 altMetricReader = optional $ option auto
                ( long "alt-metric"
                  <> short 'a'
@@ -345,9 +346,9 @@ getGraphFilename :: Int -> FilePath -> FilePath
 getGraphFilename 0 fp = fp
 getGraphFilename ix fp = ((dropExtension fp) ++ "-" ++ (show ix)) ++ (takeExtension fp)
 
-groupByMetric :: [Metric]
+groupByMetric :: [EvaluationScheme]
                 -> [(SourceSpec, [MetricOutput])]
-                -> [(Metric, [(SourceSpec, GraphSeries)])]
+                -> [(EvaluationScheme, [(SourceSpec, GraphSeries)])]
 groupByMetric metrics results = filter (\(_, ss) -> not (null ss))
                                 $ map extractMetric
                                 $ zip [0..] metrics
@@ -358,10 +359,10 @@ groupByMetric metrics results = filter (\(_, ss) -> not (null ss))
                      $ map (\(s, outs) -> (s, outs !! ix)) results)
 
 
-plotGraph :: FilePath -> (Metric, [(SourceSpec, GraphSeries)]) -> IO ()
+plotGraph :: FilePath -> (EvaluationScheme, [(SourceSpec, GraphSeries)]) -> IO ()
-plotGraph graphFile (metric@(ProbabilisticSoftFMeasure _), seriesSpecs) = do
+plotGraph graphFile (scheme@(EvaluationScheme (ProbabilisticSoftFMeasure _) _), seriesSpecs) = do
   toFile def graphFile $ do
-    layoutlr_title .= "GEval Graph / Calibration / Loess / " ++ (show metric)
+    layoutlr_title .= "GEval Graph / Calibration / Loess / " ++ (show scheme)
     let perfectSeries = (FilePathSpec "Perfect",
                          GraphSeries [(0.0, 0.0), (1.0, 1.0)])
     mapM_ plotOneSeries $ (perfectSeries : seriesSpecs)

src/GEval/Validation.hs

@@ -5,6 +5,7 @@ module GEval.Validation
     ) where
 
 import GEval.Metric
+import GEval.EvaluationScheme
 import GEval.Core (GEvalSpecification(..), GEvalException(..), somethingWrongWithFilesMessage, isEmptyFile, geval, defaultInputFile, defaultExpectedFile, defaultOutFile)
 import GEval.Common
 import qualified System.Directory as D
@@ -84,7 +85,7 @@ validationChallenge challengeDirectory spec = do
     configFile = challengeDirectory </> "config.txt"
     gitignoreFile = challengeDirectory </> ".gitignore"
     readmeFile = challengeDirectory </> "README.md"
-    mainMetric = head $ gesMetrics spec
+    mainMetric = evaluationSchemeMetric $ head $ gesMetrics spec
 
 checkCorrectFile :: FilePath -> IO ()
 checkCorrectFile filePath = do
@@ -210,13 +211,14 @@ runOnTest spec testPath = do
         gesTestName = testName
         }
 
-  (flip mapM_) (gesMetrics spec) $ \metric -> do
+  (flip mapM_) (gesMetrics spec) $ \scheme -> do
     withSystemTempDirectory "geval-validation" $ \tmpDir -> do
+      let metric = evaluationSchemeMetric scheme
       let tmpOutDir = tmpDir </> testName
       let tmpOutFile = tmpOutDir </> defaultOutFile
       createDirectory tmpOutDir
       let specificSpec = modifiedSpec {
-            gesMetrics = [metric],
+            gesMetrics = [scheme],
             gesOutDirectory = tmpDir }
       createPerfectOutputFromExpected metric expectedFile tmpOutFile
       [(_, [MetricOutput value _])] <- geval specificSpec

test/Spec.hs

@@ -6,6 +6,7 @@ import Test.Hspec
 import GEval.Metric
 import GEval.Core
 import GEval.Common
+import GEval.EvaluationScheme
 import GEval.OptionsParser
 import GEval.BLEU
 import GEval.ClippEU
@@ -298,6 +299,9 @@ main = hspec $ do
   describe "MultiLabel-Likelihood" $ do
     it "simple" $ do
       runGEvalTest "multilabel-likelihood-simple" `shouldReturnAlmost` 0.115829218528827
+  describe "Preprocessing operations" $ do
+    it "F1 with preprocessing" $ do
+      runGEvalTest "f1-with-preprocessing" `shouldReturnAlmost` 0.57142857142857
   describe "evaluating single lines" $ do
     it "RMSE" $ do
       (MetricOutput v _) <- gevalCoreOnSingleLines RMSE id RawItemTarget
@@ -399,7 +403,7 @@ main = hspec $ do
             gesOutFile = "out.tsv",
             gesExpectedFile = "expected.tsv",
             gesInputFile = "in.tsv",
-            gesMetrics = [Likelihood],
+            gesMetrics = [EvaluationScheme Likelihood []],
             gesPrecision = Nothing,
             gesTokenizer = Nothing,
             gesGonitoHost = Nothing,
@@ -509,7 +513,7 @@ main = hspec $ do
           withSystemTempDirectory "geval-validation-test" $ \tempDir -> do
             let spec = defaultGEvalSpecification {
                   gesExpectedDirectory = Just tempDir,
-                  gesMetrics = [metric],
+                  gesMetrics = [EvaluationScheme metric []],
                   gesPrecision = Just 4 }
             createChallenge True tempDir spec
             validationChallenge tempDir spec

test/f1-with-preprocessing/f1-with-preprocessing-solution/test-A/out.tsv

@@ -0,0 +1,4 @@
+foo:t5 bar:6
+foo:bb
+baz:nie foo:aha bar:qu baq:foo baq:nic baq:haha
+foo:xyt

test/f1-with-preprocessing/f1-with-preprocessing/config.txt

@@ -0,0 +1 @@
+--metric MultiLabel-F1:m<\s|foo:\S+>N<fooF1>

test/f1-with-preprocessing/f1-with-preprocessing/test-A/expected.tsv

@@ -0,0 +1,4 @@
+foo:t5 bar:6
+
+foo:aha baz:nie
+foo:xyz