filipg/geval
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add --min-frequency for black box debugging

Browse Source
This commit is contained in:
Filip Gralinski 2019-01-10 08:15:34 +01:00
parent 1832a23b75
commit e0cfb9c4b0
5 changed files with 70 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
geval.cabal
View File

@ -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

7
src/GEval/BlackBoxDebugging.hs Normal file
View File

@ -0,0 +1,7 @@
module GEval.BlackBoxDebugging
(BlackBoxDebuggingOptions(..))
where
data BlackBoxDebuggingOptions = BlackBoxDebuggingOptions {
bbdoMinFrequency :: Integer
}

4
src/GEval/Core.hs
View File

@ -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

47
src/GEval/LineByLine.hs
View File

@ -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)

44
src/GEval/OptionsParser.hs
View File

@ -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