diff --git a/geval.cabal b/geval.cabal index 960fdf1..1ec4686 100644 --- a/geval.cabal +++ b/geval.cabal @@ -1,5 +1,5 @@ name: geval -version: 1.11.3.0 +version: 1.12.0.0 synopsis: Machine learning evaluation tools description: Please see README.md homepage: http://github.com/name/project @@ -37,6 +37,7 @@ library , GEval.WER , Text.Tokenizer , GEval.Annotation + , GEval.BlackBoxDebugging , Paths_geval build-depends: base >= 4.7 && < 5 , cond diff --git a/src/GEval/BlackBoxDebugging.hs b/src/GEval/BlackBoxDebugging.hs new file mode 100644 index 0000000..97af1c6 --- /dev/null +++ b/src/GEval/BlackBoxDebugging.hs @@ -0,0 +1,7 @@ +module GEval.BlackBoxDebugging + (BlackBoxDebuggingOptions(..)) + where + +data BlackBoxDebuggingOptions = BlackBoxDebuggingOptions { + bbdoMinFrequency :: Integer +} diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 9eb9f10..14cc748 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -86,6 +86,7 @@ import GEval.WER import Data.Conduit.AutoDecompress import Text.Tokenizer import GEval.Annotation +import GEval.BlackBoxDebugging import qualified Data.HashMap.Strict as M import qualified Data.Vector as V @@ -280,7 +281,8 @@ data ResultOrdering = KeepTheOriginalOrder | FirstTheWorst | FirstTheBest data GEvalOptions = GEvalOptions { geoSpecialCommand :: Maybe GEvalSpecialCommand, geoResultOrdering :: ResultOrdering, - geoSpec :: GEvalSpecification } + geoSpec :: GEvalSpecification, + geoBlackBoxDebugginsOptions :: BlackBoxDebuggingOptions } data GEvalException = NoExpectedFile FilePath | NoOutFile FilePath diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs index fe68b17..da7bc1e 100644 --- a/src/GEval/LineByLine.hs +++ b/src/GEval/LineByLine.hs @@ -42,6 +42,7 @@ import Control.Monad.State.Strict import Data.Monoid ((<>)) import GEval.FeatureExtractor +import GEval.BlackBoxDebugging import Data.Word @@ -71,14 +72,15 @@ runLineByLine ordering spec = runLineByLineGeneralized ordering spec consum formatScore :: MetricValue -> Text formatScore = Data.Text.pack . printf "%f" -runWorstFeatures :: ResultOrdering -> GEvalSpecification -> IO () -runWorstFeatures ordering spec = runLineByLineGeneralized ordering' spec (worstFeaturesPipeline False spec) +runWorstFeatures :: ResultOrdering -> GEvalSpecification -> BlackBoxDebuggingOptions -> IO () +runWorstFeatures ordering spec bbdo = runLineByLineGeneralized ordering' spec (worstFeaturesPipeline False spec bbdo) where ordering' = forceSomeOrdering ordering -worstFeaturesPipeline :: Bool -> GEvalSpecification -> ConduitT LineRecord Void (ResourceT IO) () -worstFeaturesPipeline reversed spec = rank (lessByMetric reversed $ gesMainMetric spec) - .| evalStateC 0 (extractFeaturesAndPValues spec) + +worstFeaturesPipeline :: Bool -> GEvalSpecification -> BlackBoxDebuggingOptions -> ConduitT LineRecord Void (ResourceT IO) () +worstFeaturesPipeline reversed spec bbdo = rank (lessByMetric reversed $ gesMainMetric spec) + .| evalStateC 0 (extractFeaturesAndPValues spec bbdo) .| gobbleAndDo (sortBy featureOrder) .| CL.map (encodeUtf8 . formatFeatureWithPValue) .| CC.unlinesAscii @@ -99,11 +101,11 @@ forceSomeOrdering :: ResultOrdering -> ResultOrdering forceSomeOrdering FirstTheBest = FirstTheBest forceSomeOrdering KeepTheOriginalOrder = FirstTheWorst -extractFeaturesAndPValues :: Monad m => GEvalSpecification -> ConduitT (Double, LineRecord) FeatureWithPValue (StateT Integer m) () -extractFeaturesAndPValues spec = +extractFeaturesAndPValues :: Monad m => GEvalSpecification -> BlackBoxDebuggingOptions -> ConduitT (Double, LineRecord) FeatureWithPValue (StateT Integer m) () +extractFeaturesAndPValues spec bbdo = totalCounter .| featureExtractor spec - .| uScoresCounter + .| uScoresCounter (bbdoMinFrequency bbdo) data RankedFeature = RankedFeature Feature Double MetricValue @@ -131,22 +133,27 @@ featureExtractor spec = CC.map extract .| CC.concat extractUnigramFeaturesFromTabbed mTokenizer "in" inLine, extractUnigramFeatures mTokenizer "out" outLine] mTokenizer = gesTokenizer spec -uScoresCounter :: Monad m => ConduitT RankedFeature FeatureWithPValue (StateT Integer m) () -uScoresCounter = CC.map (\(RankedFeature feature r score) -> (feature, (r, score, 1))) - .| gobbleAndDo countUScores - .| pValueCalculator + +uScoresCounter :: Monad m => Integer -> ConduitT RankedFeature FeatureWithPValue (StateT Integer m) () +uScoresCounter minFreq = CC.map (\(RankedFeature feature r score) -> (feature, (r, score, 1))) + .| gobbleAndDo countUScores + .| lowerFreqFiltre + .| pValueCalculator minFreq where countUScores l = M.toList $ M.fromListWith (\(r1, s1, c1) (r2, s2, c2) -> ((r1 + r2), (s1 + s2), (c1 + c2))) l + lowerFreqFiltre = CC.filter (\(_, (_, _, c)) -> c >= minFreq) -pValueCalculator :: Monad m => ConduitT (Feature, (Double, MetricValue, Integer)) FeatureWithPValue (StateT Integer m) () -pValueCalculator = do +pValueCalculator :: Monad m => Integer -> ConduitT (Feature, (Double, MetricValue, Integer)) FeatureWithPValue (StateT Integer m) () +pValueCalculator minFreq = do firstVal <- await case firstVal of - Just i -> do + Just i@(_, (_, _, c)) -> do total <- lift get - yield $ calculatePValue total i - CC.map $ calculatePValue total + if total - c >= minFreq + then yield $ calculatePValue total i + else return () + CC.filter (\(_, (_, _, c)) -> total - c >= minFreq) .| CC.map (calculatePValue total) Nothing -> return () calculatePValue :: Integer -> (Feature, (Double, MetricValue, Integer)) -> FeatureWithPValue @@ -225,8 +232,8 @@ runDiff ordering otherOut spec = runDiffGeneralized ordering otherOut spec consu formatScoreDiff :: Double -> Text formatScoreDiff = Data.Text.pack . printf "%f" -runMostWorseningFeatures :: ResultOrdering -> FilePath -> GEvalSpecification -> IO () -runMostWorseningFeatures ordering otherOut spec = runDiffGeneralized ordering' otherOut spec consum +runMostWorseningFeatures :: ResultOrdering -> FilePath -> GEvalSpecification -> BlackBoxDebuggingOptions -> IO () +runMostWorseningFeatures ordering otherOut spec bbdo = runDiffGeneralized ordering' otherOut spec consum where ordering' = forceSomeOrdering ordering reversed = case ordering of KeepTheOriginalOrder -> False @@ -234,7 +241,7 @@ runMostWorseningFeatures ordering otherOut spec = runDiffGeneralized ordering' o FirstTheBest -> True consum :: ConduitT (LineRecord, LineRecord) Void (ResourceT IO) () consum = CC.map prepareFakeLineRecord - .| (worstFeaturesPipeline reversed spec) + .| (worstFeaturesPipeline reversed spec bbdo) prepareFakeLineRecord :: (LineRecord, LineRecord) -> LineRecord prepareFakeLineRecord (LineRecord _ _ _ _ scorePrev, LineRecord inp exp out c score) = LineRecord inp exp out c (score - scorePrev) diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index 77a700d..626cb2f 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -26,6 +26,7 @@ import GEval.Core import GEval.CreateChallenge import GEval.LineByLine import GEval.Submit (submit) +import GEval.BlackBoxDebugging import Data.Conduit.SmartSource @@ -88,6 +89,7 @@ optionsParser = GEvalOptions <> help "When in line-by-line or diff mode, sort the results from the best to the worst")) <|> pure KeepTheOriginalOrder) <*> specParser + <*> blackBoxDebuggingOptionsParser precisionArgParser :: Parser Int precisionArgParser = option auto @@ -162,6 +164,15 @@ specParser = GEvalSpecification ) ) +blackBoxDebuggingOptionsParser :: Parser BlackBoxDebuggingOptions +blackBoxDebuggingOptionsParser = BlackBoxDebuggingOptions + <$> option auto + ( long "min-frequency" + <> metavar "N" + <> help "Minimum frequency for the worst features" + <> value 1 + <> showDefault) + singletonMaybe :: Maybe a -> Maybe [a] singletonMaybe (Just x) = Just [x] singletonMaybe Nothing = Nothing @@ -228,34 +239,41 @@ attemptToReadOptsFromConfigFile args opts = do runGEval'' :: GEvalOptions -> IO (Maybe [(SourceSpec, [MetricValue])]) -runGEval'' opts = runGEval''' (geoSpecialCommand opts) (geoResultOrdering opts) (geoSpec opts) +runGEval'' opts = runGEval''' (geoSpecialCommand opts) + (geoResultOrdering opts) + (geoSpec opts) + (geoBlackBoxDebugginsOptions opts) -runGEval''' :: Maybe GEvalSpecialCommand -> ResultOrdering -> GEvalSpecification -> IO (Maybe [(SourceSpec, [MetricValue])]) -runGEval''' Nothing _ spec = do +runGEval''' :: Maybe GEvalSpecialCommand + -> ResultOrdering + -> GEvalSpecification + -> BlackBoxDebuggingOptions + -> IO (Maybe [(SourceSpec, [MetricValue])]) +runGEval''' Nothing _ spec _ = do vals <- geval spec return $ Just vals -runGEval''' (Just Init) _ spec = do +runGEval''' (Just Init) _ spec _ = do initChallenge spec return Nothing -runGEval''' (Just PrintVersion) _ _ = do +runGEval''' (Just PrintVersion) _ _ _ = do putStrLn ("geval " ++ showVersion version) return Nothing -runGEval''' (Just LineByLine) ordering spec = do +runGEval''' (Just LineByLine) ordering spec _ = do runLineByLine ordering spec return Nothing -runGEval''' (Just WorstFeatures) ordering spec = do - runWorstFeatures ordering spec +runGEval''' (Just WorstFeatures) ordering spec bbdo = do + runWorstFeatures ordering spec bbdo return Nothing -runGEval''' (Just (Diff otherOut)) ordering spec = do +runGEval''' (Just (Diff otherOut)) ordering spec _ = do runDiff ordering otherOut spec return Nothing -runGEval''' (Just (MostWorseningFeatures otherOut)) ordering spec = do - runMostWorseningFeatures ordering otherOut spec +runGEval''' (Just (MostWorseningFeatures otherOut)) ordering spec bbdo = do + runMostWorseningFeatures ordering otherOut spec bbdo return Nothing -runGEval''' (Just JustTokenize) _ spec = do +runGEval''' (Just JustTokenize) _ spec _ = do justTokenize (gesTokenizer spec) return Nothing -runGEval''' (Just Submit) _ spec = do +runGEval''' (Just Submit) _ spec _ = do submit (gesGonitoHost spec) (gesToken spec) (gesGonitoGitAnnexRemote spec) return Nothing