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

Merge branch 'percentage' into 'master'

Browse Source 
Percentage

See merge request filipg/geval!14
This commit is contained in:
Filip Graliński 2020-08-04 06:15:56 +00:00
commit a26b7b5a25
7 changed files with 79 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
app/Main.hs
View File

@ -70,7 +70,7 @@ getHeader params schemes = Just $ intercalate "\t" (Prelude.map T.unpack params
formatTableEntry :: GEvalOptions -> [T.Text] -> ((SourceSpec, [MetricResult]), OutputFileParsed) -> String formatTableEntry :: GEvalOptions -> [T.Text] -> ((SourceSpec, [MetricResult]), OutputFileParsed) -> String
formatTableEntry opts paramNames ((sourceSpec, metrics), ofParsed) = intercalate "\t" ((initialColumns paramNames sourceSpec ofParsed) ++ vals) formatTableEntry opts paramNames ((sourceSpec, metrics), ofParsed) = intercalate "\t" ((initialColumns paramNames sourceSpec ofParsed) ++ vals)
where vals = Prelude.map (formatTheResult (gesPrecision $ geoSpec opts)) metrics where vals = Prelude.map (formatTheResult (gesFormatting $ geoSpec opts)) metrics
initialColumns :: [T.Text] -> SourceSpec -> OutputFileParsed -> [String] initialColumns :: [T.Text] -> SourceSpec -> OutputFileParsed -> [String]
initialColumns [] sourceSpec ofParsed = [formatSourceSpec sourceSpec] initialColumns [] sourceSpec ofParsed = [formatSourceSpec sourceSpec]
@ -79,35 +79,35 @@ initialColumns params sourceSpec (OutputFileParsed _ paramMap) =
showTheResult' :: GEvalOptions -> [MetricResult] -> IO () showTheResult' :: GEvalOptions -> [MetricResult] -> IO ()
-- do not show the metric if just one was given -- do not show the metric if just one was given
showTheResult' opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val showTheResult' opts [val] = putStrLn $ formatTheResult (gesFormatting $ geoSpec opts) val
showTheResult' opts [] = do showTheResult' opts [] = do
hPutStrLn stderr "no metric given, use --metric option" hPutStrLn stderr "no metric given, use --metric option"
exitFailure exitFailure
showTheResult' opts vals = mapM_ putStrLn showTheResult' opts vals = mapM_ putStrLn
$ intercalate [""] $ intercalate [""]
$ Prelude.map (formatCrossTable (gesPrecision $ geoSpec opts)) $ Prelude.map (formatCrossTable (gesFormatting $ geoSpec opts))
$ splitIntoTablesWithValues (T.pack "metric") (T.pack "value") mapping metricLabels $ splitIntoTablesWithValues (T.pack "metric") (T.pack "value") mapping metricLabels
where mapping = LM.fromList $ zip metricLabels vals where mapping = LM.fromList $ zip metricLabels vals
metricLabels = Prelude.map T.pack $ Prelude.map evaluationSchemeName $ gesMetrics $ geoSpec opts metricLabels = Prelude.map T.pack $ Prelude.map evaluationSchemeName $ gesMetrics $ geoSpec opts
formatCrossTable :: Maybe Int -> TableWithValues MetricResult -> [String] formatCrossTable :: FormattingOptions -> TableWithValues MetricResult -> [String]
formatCrossTable mPrecision (TableWithValues [_, _] body) = formatCrossTable format (TableWithValues [_, _] body) =
-- actually we won't print metric/value header -- actually we won't print metric/value header
-- (1) to keep backward-compatible with the previous version -- (1) to keep backward-compatible with the previous version
-- (2) to be concise -- (2) to be concise
Prelude.map (formatCrossTableLine mPrecision) body Prelude.map (formatCrossTableLine format) body
formatCrossTable mPrecision (TableWithValues header body) = formatCrossTable format (TableWithValues header body) =
(intercalate "\t" $ Prelude.map T.unpack header) : Prelude.map (formatCrossTableLine mPrecision) body (intercalate "\t" $ Prelude.map T.unpack header) : Prelude.map (formatCrossTableLine format) body
formatCrossTableLine :: Maybe Int -> (T.Text, [MetricResult]) -> String formatCrossTableLine :: FormattingOptions-> (T.Text, [MetricResult]) -> String
formatCrossTableLine mPrecision (rowName, values) = formatCrossTableLine format (rowName, values) =
intercalate "\t" ((T.unpack rowName):Prelude.map (formatTheResult mPrecision) values) intercalate "\t" ((T.unpack rowName):Prelude.map (formatTheResult format) values)
formatSourceSpec :: SourceSpec -> String formatSourceSpec :: SourceSpec -> String
formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
formatSourceSpec spec = show spec formatSourceSpec spec = show spec
formatTheMetricAndResult :: Maybe Int -> (EvaluationScheme, MetricResult) -> String formatTheMetricAndResult :: FormattingOptions -> (EvaluationScheme, MetricResult) -> String
formatTheMetricAndResult mPrecision (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult mPrecision val) formatTheMetricAndResult format (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult format val)

5
src/GEval/Common.hs
View File

@ -15,6 +15,11 @@ type MetricValue = Double
data GraphSeries = GraphSeries [(Double, Double)] data GraphSeries = GraphSeries [(Double, Double)]
data FormattingOptions = FormattingOptions {
decimalPlaces :: Maybe Int,
asPercentage :: Bool
}
data MetricResult = SimpleRun MetricValue | BootstrapResampling [MetricValue] data MetricResult = SimpleRun MetricValue | BootstrapResampling [MetricValue]
instance Show MetricResult where instance Show MetricResult where

13
src/GEval/Core.hs
View File

@ -6,6 +6,7 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
module GEval.Core module GEval.Core
( geval, ( geval,
gevalCore, gevalCore,
@ -182,7 +183,7 @@ data GEvalSpecification = GEvalSpecification
gesExpectedFile :: String, gesExpectedFile :: String,
gesInputFile :: String, gesInputFile :: String,
gesMetrics :: [EvaluationScheme], gesMetrics :: [EvaluationScheme],
gesPrecision :: Maybe Int, gesFormatting :: FormattingOptions,
gesTokenizer :: Maybe Tokenizer, gesTokenizer :: Maybe Tokenizer,
gesGonitoHost :: Maybe String, gesGonitoHost :: Maybe String,
gesToken :: Maybe String, gesToken :: Maybe String,
@ -253,7 +254,7 @@ defaultGEvalSpecification = GEvalSpecification {
gesExpectedFile = defaultExpectedFile, gesExpectedFile = defaultExpectedFile,
gesInputFile = defaultInputFile, gesInputFile = defaultInputFile,
gesMetrics = [EvaluationScheme defaultMetric []], gesMetrics = [EvaluationScheme defaultMetric []],
gesPrecision = Nothing, gesFormatting = FormattingOptions Nothing False,
gesTokenizer = Nothing, gesTokenizer = Nothing,
gesGonitoHost = Nothing, gesGonitoHost = Nothing,
gesToken = Nothing, gesToken = Nothing,
@ -748,9 +749,9 @@ countFragAgg :: (Num n, Num v, Monad m) => ConduitM (n, n, v, v) o m (n, n, v, v
countFragAgg = CC.foldl countFragFolder (fromInteger 0, fromInteger 0, fromInteger 0, fromInteger 0) countFragAgg = CC.foldl countFragFolder (fromInteger 0, fromInteger 0, fromInteger 0, fromInteger 0)
gevalCoreByCorrelationMeasure :: (MonadUnliftIO m, MonadThrow m, MonadIO m) => gevalCoreByCorrelationMeasure :: (MonadUnliftIO m, MonadThrow m, MonadIO m) =>
(V.Vector (Double, Double) -> Double) -> -- ^ correlation function (V.Vector (Double, Double) -> Double) -- ^ correlation function
LineSourcesSpecification (ResourceT m) -> -> LineSourcesSpecification (ResourceT m)
m (MetricOutput) -- ^ metric values for the output against the expected output -> m (MetricOutput) -- ^ metric values for the output against the expected output
gevalCoreByCorrelationMeasure correlationFunction = gevalCoreByCorrelationMeasure correlationFunction =
gevalCoreWithoutInput SAPearson correlationC finalStep noGraph gevalCoreWithoutInput SAPearson correlationC finalStep noGraph
where correlationC = CC.foldl (flip (:)) [] where correlationC = CC.foldl (flip (:)) []
@ -850,6 +851,8 @@ gevalRunPipeline' parserSpec itemStep finalPipeline context = do
<$> ZipSource (CL.sourceList [(getFirstLineNo (Proxy :: Proxy m) context)..]) <$> ZipSource (CL.sourceList [(getFirstLineNo (Proxy :: Proxy m) context)..])
<*> (ZipSource $ recordSource context parserSpec)) .| CL.map (checkStep (Proxy :: Proxy m) itemStep)) .| CL.catMaybes .| finalPipeline) <*> (ZipSource $ recordSource context parserSpec)) .| CL.map (checkStep (Proxy :: Proxy m) itemStep)) .| CL.catMaybes .| finalPipeline)
continueGEvalCalculations :: forall m t . (MonadIO m) => continueGEvalCalculations :: forall m t . (MonadIO m) =>
SAMetric t SAMetric t
-> Metric -> Metric

40
src/GEval/CreateChallenge.hs
View File

@ -7,12 +7,13 @@ module GEval.CreateChallenge
import GEval.Metric import GEval.Metric
import GEval.EvaluationScheme import GEval.EvaluationScheme
import GEval.Common (GEvalException(..)) import GEval.Common (GEvalException(..), FormattingOptions(..))
import GEval.Core (GEvalSpecification(..), configFileName, gesMainMetric, defaultTestName) import GEval.Core (GEvalSpecification(..), configFileName, gesMainMetric, defaultTestName)
import GEval.Submit (tokenFileName) import GEval.Submit (tokenFileName)
import GEval.MatchingSpecification (MatchingSpecification(ExactMatch)) import GEval.MatchingSpecification (MatchingSpecification(ExactMatch))
import qualified System.Directory as D import qualified System.Directory as D
import Control.Conditional (whenM) import Control.Conditional (whenM)
import Data.Maybe (catMaybes)
import System.IO import System.IO
import System.FilePath import System.FilePath
@ -22,6 +23,9 @@ import Data.String.Here
import Data.List (intercalate) import Data.List (intercalate)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
import Data.Bool
import Text.Printf
createChallenge :: Bool -> FilePath -> GEvalSpecification -> IO () createChallenge :: Bool -> FilePath -> GEvalSpecification -> IO ()
createChallenge withDataFiles expectedDirectory spec = do createChallenge withDataFiles expectedDirectory spec = do
@ -31,7 +35,7 @@ createChallenge withDataFiles expectedDirectory spec = do
D.createDirectoryIfMissing False testDirectory D.createDirectoryIfMissing False testDirectory
createFile (expectedDirectory </> ".gitignore") $ gitignoreContents createFile (expectedDirectory </> ".gitignore") $ gitignoreContents
createFile (expectedDirectory </> "README.md") $ readmeMDContents metric testName createFile (expectedDirectory </> "README.md") $ readmeMDContents metric testName
createFile (expectedDirectory </> configFileName) $ configContents metrics precision testName createFile (expectedDirectory </> configFileName) $ configContents metrics format testName
createHeaderFile expectedDirectory "in-header.tsv" $ inHeaderContents metric createHeaderFile expectedDirectory "in-header.tsv" $ inHeaderContents metric
createHeaderFile expectedDirectory "out-header.tsv" $ outHeaderContents metric createHeaderFile expectedDirectory "out-header.tsv" $ outHeaderContents metric
if withDataFiles if withDataFiles
@ -49,7 +53,7 @@ createChallenge withDataFiles expectedDirectory spec = do
return () return ()
where metric = gesMainMetric spec where metric = gesMainMetric spec
metrics = gesMetrics spec metrics = gesMetrics spec
precision = gesPrecision spec format = gesFormatting spec
testName = gesTestName spec testName = gesTestName spec
trainDirectory = expectedDirectory </> "train" trainDirectory = expectedDirectory </> "train"
devDirectory = expectedDirectory </> "dev-0" devDirectory = expectedDirectory </> "dev-0"
@ -423,24 +427,26 @@ Directory structure
|] |]
configContents :: [EvaluationScheme] -> Maybe Int -> String -> String configContents :: [EvaluationScheme] -> FormattingOptions -> String -> String
configContents schemes precision testName = unwords (Prelude.map (\scheme -> ("--metric " ++ (show scheme))) schemes) ++ configContents schemes format testName =
(if testName /= defaultTestName unwords $ catMaybes ((Prelude.map (\scheme -> (Just $ "--metric " ++ (show scheme))) schemes)
then ++ [testNameOpt]
" --test-name " ++ testName ++ (precisionOpt format)
else ++ [inHeaderOpts, outHeaderOpts])
"") ++ where precisionOpt (FormattingOptions m b) = [
(precisionOpt precision) ++ maybe Nothing (Just . printf "--precision %d") m,
inHeaderOpts ++ bool Nothing (Just "--show-as-percentage") b ]
outHeaderOpts
where precisionOpt Nothing = ""
precisionOpt (Just p) = " --precision " ++ (show p)
((EvaluationScheme mainMetric _):_) = schemes ((EvaluationScheme mainMetric _):_) = schemes
testNameOpt = if testName /= defaultTestName
then
(Just (" --test-name " ++ testName))
else
Nothing
inHeaderOpts = getHeaderOpts "in-header" inHeaderContents inHeaderOpts = getHeaderOpts "in-header" inHeaderContents
outHeaderOpts = getHeaderOpts "out-header" outHeaderContents outHeaderOpts = getHeaderOpts "out-header" outHeaderContents
getHeaderOpts opt selector = case selector mainMetric of getHeaderOpts opt selector = case selector mainMetric of
Just _ -> " --" ++ opt ++ " " ++ (opt <.> "tsv") Just _ -> Just (" --" ++ opt ++ " " ++ (opt <.> "tsv"))
Nothing -> "" Nothing -> Nothing
-- Originally train content was in one file, to avoid large changes -- Originally train content was in one file, to avoid large changes
-- for the time being we are using the original function. -- for the time being we are using the original function.

33
src/GEval/Formatting.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module GEval.Formatting module GEval.Formatting
(formatTheResult, formatSimpleResult, formatTheResultWithErrorBounds) (formatTheResult, formatSimpleResult, formatTheResultWithErrorBounds)
where where
@ -7,25 +9,28 @@ import Data.Conduit.Bootstrap
import Text.Printf import Text.Printf
formatTheResult :: Maybe Int -> MetricResult -> String formatTheResult :: FormattingOptions -> MetricResult -> String
formatTheResult mPrecision (SimpleRun val) = formatSimpleResult mPrecision val formatTheResult format (SimpleRun val) = formatSimpleResult format val
formatTheResult mPrecision (BootstrapResampling vals) = formatTheResultWithErrorBounds mPrecision pointEstimate (Just errorBound) formatTheResult format (BootstrapResampling vals) = formatTheResultWithErrorBounds format pointEstimate (Just errorBound)
where pointEstimate = (upperBound + lowerBound) / 2.0 where pointEstimate = (upperBound + lowerBound) / 2.0
errorBound = (upperBound - lowerBound) / 2.0 errorBound = (upperBound - lowerBound) / 2.0
(lowerBound, upperBound) = getConfidenceBounds defaultConfidenceLevel vals (lowerBound, upperBound) = getConfidenceBounds defaultConfidenceLevel vals
formatTheResultWithErrorBounds :: Maybe Int -> MetricValue -> Maybe MetricValue -> String formatTheResultWithErrorBounds :: FormattingOptions -> MetricValue -> Maybe MetricValue -> String
formatTheResultWithErrorBounds mPrecision pointEstimate Nothing = formatSimpleResult mPrecision pointEstimate formatTheResultWithErrorBounds format pointEstimate Nothing = formatSimpleResult format pointEstimate
formatTheResultWithErrorBounds mPrecision pointEstimate (Just errorBound) = (formatSimpleResult correctedPrecision pointEstimate) formatTheResultWithErrorBounds format pointEstimate (Just errorBound) = (formatSimpleResult formatWithCorrectedPrecision pointEstimate)
++ "±" ++ "±"
++ (formatSimpleResult correctedPrecision errorBound) ++ (formatSimpleResult formatWithCorrectedPrecision errorBound)
where errorBoundMagnitude = (floor (logBase 10.0 errorBound)) - 1 where errorBoundMagnitude = (floor (logBase 10.0 errorBound)) - 1
correctedPrecision = Just $ selectLowerPrecision (max (-errorBoundMagnitude) 0) mPrecision formatWithCorrectedPrecision = selectLowerPrecision (max (-errorBoundMagnitude) 0) format
formatSimpleResult :: Maybe Int -> MetricValue -> String formatSimpleResult :: FormattingOptions -> MetricValue -> String
formatSimpleResult Nothing = show formatSimpleResult = \case
formatSimpleResult (Just prec) = printf "%0.*f" prec FormattingOptions (Just prec) True -> printf "%.*f" (max 0 (prec-2)) . (*100)
FormattingOptions (Just prec) _ -> printf "%.*f" prec
_ -> show
selectLowerPrecision :: Int -> Maybe Int -> Int selectLowerPrecision :: Int -> FormattingOptions -> FormattingOptions
selectLowerPrecision p Nothing = p selectLowerPrecision p = \case
selectLowerPrecision p (Just p') = min p p' FormattingOptions (Just prec) showAsPercentage -> FormattingOptions (Just $ min prec p) showAsPercentage
FormattingOptions (Nothing) showAsPercentage -> FormattingOptions (Just p) showAsPercentage

15
src/GEval/OptionsParser.hs
View File

@ -6,7 +6,7 @@ module GEval.OptionsParser
runGEvalGetOptions, runGEvalGetOptions,
getOptions, getOptions,
metricReader, metricReader,
precisionArgParser formatParser
) where ) where
import Paths_geval (version) import Paths_geval (version)
@ -138,12 +138,15 @@ optionsParser = GEvalOptions
<> help "Mark worst features when in the line-by-line mode") <> help "Mark worst features when in the line-by-line mode")
precisionArgParser :: Parser Int formatParser :: Parser FormattingOptions
precisionArgParser = option auto formatParser = FormattingOptions
( long "precision" <$> (optional $ option auto ( long "precision"
<> short 'p' <> short 'p'
<> metavar "NUMBER-OF-FRACTIONAL-DIGITS" <> metavar "NUMBER-OF-FRACTIONAL-DIGITS"
<> help "Arithmetic precision, i.e. the number of fractional digits to be shown" ) <> help "Arithmetic precision, i.e. the number of fractional digits to be shown" ))
<*> switch ( long "show-as-percentage"
<> short '%'
<> help "Returns the result as a percentage (i.e. maximum value of 100 instead of 1)" )
specParser :: Parser GEvalSpecification specParser :: Parser GEvalSpecification
specParser = GEvalSpecification specParser = GEvalSpecification
@ -191,7 +194,7 @@ specParser = GEvalSpecification
<> metavar "INPUT" <> metavar "INPUT"
<> help "The name of the file with the input (applicable only for some metrics)" ) <> help "The name of the file with the input (applicable only for some metrics)" )
<*> ((flip fromMaybe) <$> (singletonMaybe <$> altMetricReader) <*> metricReader) <*> ((flip fromMaybe) <$> (singletonMaybe <$> altMetricReader) <*> metricReader)
<*> optional precisionArgParser <*> formatParser
<*> (optional $ option auto <*> (optional $ option auto
( long "tokenizer" ( long "tokenizer"
<> short 'T' <> short 'T'

4
test/Spec.hs
View File

@ -501,7 +501,7 @@ main = hspec $ do
gesExpectedFile = "expected.tsv", gesExpectedFile = "expected.tsv",
gesInputFile = "in.tsv", gesInputFile = "in.tsv",
gesMetrics = [EvaluationScheme Likelihood []], gesMetrics = [EvaluationScheme Likelihood []],
gesPrecision = Nothing, gesFormatting = FormattingOptions Nothing False,
gesTokenizer = Nothing, gesTokenizer = Nothing,
gesGonitoHost = Nothing, gesGonitoHost = Nothing,
gesToken = Nothing, gesToken = Nothing,
@ -629,7 +629,7 @@ main = hspec $ do
let spec = defaultGEvalSpecification { let spec = defaultGEvalSpecification {
gesExpectedDirectory = Just tempDir, gesExpectedDirectory = Just tempDir,
gesMetrics = [scheme], gesMetrics = [scheme],
gesPrecision = Just 4 } gesFormatting = FormattingOptions (Just 4) False }
createChallenge True tempDir spec createChallenge True tempDir spec
validationChallenge tempDir spec validationChallenge tempDir spec
describe "test sample outputs" $ do describe "test sample outputs" $ do