diff --git a/app/Main.hs b/app/Main.hs index 337da7f..b7337eb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -70,7 +70,7 @@ getHeader params schemes = Just $ intercalate "\t" (Prelude.map T.unpack params formatTableEntry :: GEvalOptions -> [T.Text] -> ((SourceSpec, [MetricResult]), OutputFileParsed) -> String 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 [] sourceSpec ofParsed = [formatSourceSpec sourceSpec] @@ -79,35 +79,35 @@ initialColumns params sourceSpec (OutputFileParsed _ paramMap) = showTheResult' :: GEvalOptions -> [MetricResult] -> IO () -- 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 hPutStrLn stderr "no metric given, use --metric option" exitFailure showTheResult' opts vals = mapM_ putStrLn $ intercalate [""] - $ Prelude.map (formatCrossTable (gesPrecision $ geoSpec opts)) + $ Prelude.map (formatCrossTable (gesFormatting $ geoSpec opts)) $ splitIntoTablesWithValues (T.pack "metric") (T.pack "value") mapping metricLabels where mapping = LM.fromList $ zip metricLabels vals metricLabels = Prelude.map T.pack $ Prelude.map evaluationSchemeName $ gesMetrics $ geoSpec opts -formatCrossTable :: Maybe Int -> TableWithValues MetricResult -> [String] -formatCrossTable mPrecision (TableWithValues [_, _] body) = +formatCrossTable :: FormattingOptions -> TableWithValues MetricResult -> [String] +formatCrossTable format (TableWithValues [_, _] body) = -- actually we won't print metric/value header -- (1) to keep backward-compatible with the previous version -- (2) to be concise - Prelude.map (formatCrossTableLine mPrecision) body -formatCrossTable mPrecision (TableWithValues header body) = - (intercalate "\t" $ Prelude.map T.unpack header) : Prelude.map (formatCrossTableLine mPrecision) body + Prelude.map (formatCrossTableLine format) body +formatCrossTable format (TableWithValues header body) = + (intercalate "\t" $ Prelude.map T.unpack header) : Prelude.map (formatCrossTableLine format) body -formatCrossTableLine :: Maybe Int -> (T.Text, [MetricResult]) -> String -formatCrossTableLine mPrecision (rowName, values) = - intercalate "\t" ((T.unpack rowName):Prelude.map (formatTheResult mPrecision) values) +formatCrossTableLine :: FormattingOptions-> (T.Text, [MetricResult]) -> String +formatCrossTableLine format (rowName, values) = + intercalate "\t" ((T.unpack rowName):Prelude.map (formatTheResult format) values) formatSourceSpec :: SourceSpec -> String formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp formatSourceSpec spec = show spec -formatTheMetricAndResult :: Maybe Int -> (EvaluationScheme, MetricResult) -> String -formatTheMetricAndResult mPrecision (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult mPrecision val) +formatTheMetricAndResult :: FormattingOptions -> (EvaluationScheme, MetricResult) -> String +formatTheMetricAndResult format (scheme, val) = (evaluationSchemeName scheme) ++ "\t" ++ (formatTheResult format val) diff --git a/src/GEval/Common.hs b/src/GEval/Common.hs index 4a9cc4e..c8b581d 100644 --- a/src/GEval/Common.hs +++ b/src/GEval/Common.hs @@ -15,6 +15,11 @@ type MetricValue = Double data GraphSeries = GraphSeries [(Double, Double)] +data FormattingOptions = FormattingOptions { + decimalPlaces :: Maybe Int, + asPercentage :: Bool + } + data MetricResult = SimpleRun MetricValue | BootstrapResampling [MetricValue] instance Show MetricResult where diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 01b0a82..0fb4b16 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PackageImports #-} + module GEval.Core ( geval, gevalCore, @@ -182,7 +183,7 @@ data GEvalSpecification = GEvalSpecification gesExpectedFile :: String, gesInputFile :: String, gesMetrics :: [EvaluationScheme], - gesPrecision :: Maybe Int, + gesFormatting :: FormattingOptions, gesTokenizer :: Maybe Tokenizer, gesGonitoHost :: Maybe String, gesToken :: Maybe String, @@ -253,7 +254,7 @@ defaultGEvalSpecification = GEvalSpecification { gesExpectedFile = defaultExpectedFile, gesInputFile = defaultInputFile, gesMetrics = [EvaluationScheme defaultMetric []], - gesPrecision = Nothing, + gesFormatting = FormattingOptions Nothing False, gesTokenizer = Nothing, gesGonitoHost = 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) gevalCoreByCorrelationMeasure :: (MonadUnliftIO m, MonadThrow m, MonadIO m) => - (V.Vector (Double, Double) -> Double) -> -- ^ correlation function - LineSourcesSpecification (ResourceT m) -> - m (MetricOutput) -- ^ metric values for the output against the expected output + (V.Vector (Double, Double) -> Double) -- ^ correlation function + -> LineSourcesSpecification (ResourceT m) + -> m (MetricOutput) -- ^ metric values for the output against the expected output gevalCoreByCorrelationMeasure correlationFunction = gevalCoreWithoutInput SAPearson correlationC finalStep noGraph where correlationC = CC.foldl (flip (:)) [] @@ -850,6 +851,8 @@ gevalRunPipeline' parserSpec itemStep finalPipeline context = do <$> ZipSource (CL.sourceList [(getFirstLineNo (Proxy :: Proxy m) context)..]) <*> (ZipSource $ recordSource context parserSpec)) .| CL.map (checkStep (Proxy :: Proxy m) itemStep)) .| CL.catMaybes .| finalPipeline) + + continueGEvalCalculations :: forall m t . (MonadIO m) => SAMetric t -> Metric diff --git a/src/GEval/CreateChallenge.hs b/src/GEval/CreateChallenge.hs index 69e1150..f9e7dc6 100644 --- a/src/GEval/CreateChallenge.hs +++ b/src/GEval/CreateChallenge.hs @@ -7,12 +7,13 @@ module GEval.CreateChallenge import GEval.Metric import GEval.EvaluationScheme -import GEval.Common (GEvalException(..)) +import GEval.Common (GEvalException(..), FormattingOptions(..)) import GEval.Core (GEvalSpecification(..), configFileName, gesMainMetric, defaultTestName) import GEval.Submit (tokenFileName) import GEval.MatchingSpecification (MatchingSpecification(ExactMatch)) import qualified System.Directory as D import Control.Conditional (whenM) +import Data.Maybe (catMaybes) import System.IO import System.FilePath @@ -22,6 +23,9 @@ import Data.String.Here import Data.List (intercalate) import Data.List.Split (splitOn) +import Data.Bool + +import Text.Printf createChallenge :: Bool -> FilePath -> GEvalSpecification -> IO () createChallenge withDataFiles expectedDirectory spec = do @@ -31,7 +35,7 @@ createChallenge withDataFiles expectedDirectory spec = do D.createDirectoryIfMissing False testDirectory createFile (expectedDirectory ".gitignore") $ gitignoreContents 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 "out-header.tsv" $ outHeaderContents metric if withDataFiles @@ -49,7 +53,7 @@ createChallenge withDataFiles expectedDirectory spec = do return () where metric = gesMainMetric spec metrics = gesMetrics spec - precision = gesPrecision spec + format = gesFormatting spec testName = gesTestName spec trainDirectory = expectedDirectory "train" devDirectory = expectedDirectory "dev-0" @@ -423,24 +427,26 @@ Directory structure |] -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 - else - "") ++ - (precisionOpt precision) ++ - inHeaderOpts ++ - outHeaderOpts - where precisionOpt Nothing = "" - precisionOpt (Just p) = " --precision " ++ (show p) +configContents :: [EvaluationScheme] -> FormattingOptions -> String -> String +configContents schemes format testName = + unwords $ catMaybes ((Prelude.map (\scheme -> (Just $ "--metric " ++ (show scheme))) schemes) + ++ [testNameOpt] + ++ (precisionOpt format) + ++ [inHeaderOpts, outHeaderOpts]) + where precisionOpt (FormattingOptions m b) = [ + maybe Nothing (Just . printf "--precision %d") m, + bool Nothing (Just "--show-as-percentage") b ] ((EvaluationScheme mainMetric _):_) = schemes + testNameOpt = if testName /= defaultTestName + then + (Just (" --test-name " ++ testName)) + else + Nothing inHeaderOpts = getHeaderOpts "in-header" inHeaderContents outHeaderOpts = getHeaderOpts "out-header" outHeaderContents getHeaderOpts opt selector = case selector mainMetric of - Just _ -> " --" ++ opt ++ " " ++ (opt <.> "tsv") - Nothing -> "" + Just _ -> Just (" --" ++ opt ++ " " ++ (opt <.> "tsv")) + Nothing -> Nothing -- Originally train content was in one file, to avoid large changes -- for the time being we are using the original function. diff --git a/src/GEval/Formatting.hs b/src/GEval/Formatting.hs index 149c1b9..ea6fac3 100644 --- a/src/GEval/Formatting.hs +++ b/src/GEval/Formatting.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + module GEval.Formatting (formatTheResult, formatSimpleResult, formatTheResultWithErrorBounds) where @@ -7,25 +9,28 @@ import Data.Conduit.Bootstrap import Text.Printf -formatTheResult :: Maybe Int -> MetricResult -> String -formatTheResult mPrecision (SimpleRun val) = formatSimpleResult mPrecision val -formatTheResult mPrecision (BootstrapResampling vals) = formatTheResultWithErrorBounds mPrecision pointEstimate (Just errorBound) +formatTheResult :: FormattingOptions -> MetricResult -> String +formatTheResult format (SimpleRun val) = formatSimpleResult format val +formatTheResult format (BootstrapResampling vals) = formatTheResultWithErrorBounds format pointEstimate (Just errorBound) where pointEstimate = (upperBound + lowerBound) / 2.0 errorBound = (upperBound - lowerBound) / 2.0 (lowerBound, upperBound) = getConfidenceBounds defaultConfidenceLevel vals -formatTheResultWithErrorBounds :: Maybe Int -> MetricValue -> Maybe MetricValue -> String -formatTheResultWithErrorBounds mPrecision pointEstimate Nothing = formatSimpleResult mPrecision pointEstimate -formatTheResultWithErrorBounds mPrecision pointEstimate (Just errorBound) = (formatSimpleResult correctedPrecision pointEstimate) +formatTheResultWithErrorBounds :: FormattingOptions -> MetricValue -> Maybe MetricValue -> String +formatTheResultWithErrorBounds format pointEstimate Nothing = formatSimpleResult format pointEstimate +formatTheResultWithErrorBounds format pointEstimate (Just errorBound) = (formatSimpleResult formatWithCorrectedPrecision pointEstimate) ++ "±" - ++ (formatSimpleResult correctedPrecision errorBound) + ++ (formatSimpleResult formatWithCorrectedPrecision errorBound) 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 Nothing = show -formatSimpleResult (Just prec) = printf "%0.*f" prec +formatSimpleResult :: FormattingOptions -> MetricValue -> String +formatSimpleResult = \case + FormattingOptions (Just prec) True -> printf "%.*f" (max 0 (prec-2)) . (*100) + FormattingOptions (Just prec) _ -> printf "%.*f" prec + _ -> show -selectLowerPrecision :: Int -> Maybe Int -> Int -selectLowerPrecision p Nothing = p -selectLowerPrecision p (Just p') = min p p' +selectLowerPrecision :: Int -> FormattingOptions -> FormattingOptions +selectLowerPrecision p = \case + FormattingOptions (Just prec) showAsPercentage -> FormattingOptions (Just $ min prec p) showAsPercentage + FormattingOptions (Nothing) showAsPercentage -> FormattingOptions (Just p) showAsPercentage diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index fdddad9..0290083 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -6,7 +6,7 @@ module GEval.OptionsParser runGEvalGetOptions, getOptions, metricReader, - precisionArgParser + formatParser ) where import Paths_geval (version) @@ -138,12 +138,15 @@ optionsParser = GEvalOptions <> help "Mark worst features when in the line-by-line mode") -precisionArgParser :: Parser Int -precisionArgParser = option auto - ( long "precision" +formatParser :: Parser FormattingOptions +formatParser = FormattingOptions + <$> (optional $ option auto ( long "precision" <> short 'p' <> 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 = GEvalSpecification @@ -191,7 +194,7 @@ specParser = GEvalSpecification <> metavar "INPUT" <> help "The name of the file with the input (applicable only for some metrics)" ) <*> ((flip fromMaybe) <$> (singletonMaybe <$> altMetricReader) <*> metricReader) - <*> optional precisionArgParser + <*> formatParser <*> (optional $ option auto ( long "tokenizer" <> short 'T' diff --git a/test/Spec.hs b/test/Spec.hs index d54bd3d..49abfb9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -501,7 +501,7 @@ main = hspec $ do gesExpectedFile = "expected.tsv", gesInputFile = "in.tsv", gesMetrics = [EvaluationScheme Likelihood []], - gesPrecision = Nothing, + gesFormatting = FormattingOptions Nothing False, gesTokenizer = Nothing, gesGonitoHost = Nothing, gesToken = Nothing, @@ -629,7 +629,7 @@ main = hspec $ do let spec = defaultGEvalSpecification { gesExpectedDirectory = Just tempDir, gesMetrics = [scheme], - gesPrecision = Just 4 } + gesFormatting = FormattingOptions (Just 4) False } createChallenge True tempDir spec validationChallenge tempDir spec describe "test sample outputs" $ do