diff --git a/app/Main.hs b/app/Main.hs index 6f3d412..53ef2aa 100644 --- a/app/Main.hs +++ b/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 params metrics = Just $ intercalate "\t" (Prelude.map T.unpack params - ++ Prelude.map show metrics) +getHeader [] schemes = Just $ intercalate "\t" ("File name" : Prelude.map evaluationSchemeName schemes) +getHeader params schemes = Just $ intercalate "\t" (Prelude.map T.unpack params + ++ 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 mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val) +formatTheMetricAndResult :: Maybe Int -> (EvaluationScheme, MetricValue) -> String +formatTheMetricAndResult mPrecision (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult mPrecision val) formatTheResult :: Maybe Int -> MetricValue -> String diff --git a/geval.cabal b/geval.cabal index ba5d58b..7d07ecb 100644 --- a/geval.cabal +++ b/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 diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 696ae7d..0feeef4 100644 --- a/src/GEval/Core.hs +++ b/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 diff --git a/src/GEval/CreateChallenge.hs b/src/GEval/CreateChallenge.hs index b26e55d..34bbd55 100644 --- a/src/GEval/CreateChallenge.hs +++ b/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 metrics precision testName = unwords (Prelude.map (\metric -> ("--metric " ++ (show metric))) metrics) ++ +configContents :: [EvaluationScheme] -> Maybe Int -> String -> String +configContents schemes precision testName = unwords (Prelude.map (\scheme -> ("--metric " ++ (show scheme))) schemes) ++ (if testName /= defaultTestName then " --test-name " ++ testName diff --git a/src/GEval/EvaluationScheme.hs b/src/GEval/EvaluationScheme.hs new file mode 100644 index 0000000..a3677fe --- /dev/null +++ b/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 diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index d68b0b7..e0cfb0f 100644 --- a/src/GEval/OptionsParser.hs +++ b/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 graphFile (metric@(ProbabilisticSoftFMeasure _), seriesSpecs) = do +plotGraph :: FilePath -> (EvaluationScheme, [(SourceSpec, GraphSeries)]) -> IO () +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) diff --git a/src/GEval/Validation.hs b/src/GEval/Validation.hs index 2cf925e..ef2e981 100644 --- a/src/GEval/Validation.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 2a4ff26..bbffbaf 100644 --- a/test/Spec.hs +++ b/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 diff --git a/test/f1-with-preprocessing/f1-with-preprocessing-solution/test-A/out.tsv b/test/f1-with-preprocessing/f1-with-preprocessing-solution/test-A/out.tsv new file mode 100644 index 0000000..3011820 --- /dev/null +++ b/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 diff --git a/test/f1-with-preprocessing/f1-with-preprocessing/config.txt b/test/f1-with-preprocessing/f1-with-preprocessing/config.txt new file mode 100644 index 0000000..f17e516 --- /dev/null +++ b/test/f1-with-preprocessing/f1-with-preprocessing/config.txt @@ -0,0 +1 @@ +--metric MultiLabel-F1:m<\s|foo:\S+>N diff --git a/test/f1-with-preprocessing/f1-with-preprocessing/test-A/expected.tsv b/test/f1-with-preprocessing/f1-with-preprocessing/test-A/expected.tsv new file mode 100644 index 0000000..954f296 --- /dev/null +++ b/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