Handle showing as percentage

This commit is contained in:
Filip Gralinski 2020-09-05 16:45:09 +02:00
parent 0337f8dafd
commit e158459bf8
5 changed files with 18 additions and 12 deletions

View File

@ -393,7 +393,8 @@ insertOrUpdateTest testDir challengeId checksum commit opts (priority, metric) =
mAlreadyExistingTest <- getBy $ UniqueChallengeNameMetricChecksum challengeId name metric checksum
case mAlreadyExistingTest of
Just (Entity testId _) -> update testId [TestCommit=.commit,
TestPrecision=. (decimalPlaces $ gesFormatting $ geoSpec opts),
TestPrecision=.(decimalPlaces $ gesFormatting $ geoSpec opts),
TestAsPercentage=.(Just $ asPercentage $ gesFormatting $ geoSpec opts),
TestPriority=.Just priority]
Nothing -> do
_ <- insert $ Test {
@ -404,6 +405,7 @@ insertOrUpdateTest testDir challengeId checksum commit opts (priority, metric) =
testCommit=commit,
testActive=True,
testPrecision=decimalPlaces $ gesFormatting $ geoSpec opts,
testAsPercentage=Just $ asPercentage $ gesFormatting $ geoSpec opts,
testPriority=Just priority}
return ()

View File

@ -119,7 +119,7 @@ doGetScore mMetricName submission = do
return (evaluation)
case evals of
[eval] -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt) (Just $ entityVal eval)
[eval] -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt) (Just $ entityVal eval)
_ -> return "NONE"
Nothing -> return "NONE"
@ -149,7 +149,7 @@ doGetScoreForOut mMetricName submission sha1code = do
Just mn -> find (\(_, t) -> formatTestEvaluationScheme (entityVal t) == mn) evals
case evalSelected of
Nothing -> return "None"
Just (eval, testEnt) -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt)
Just (eval, testEnt) -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt)
(Just $ entityVal eval)
@ -295,7 +295,7 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
let testLabels = map (formatTestEvaluationScheme . entityVal) tests'
let mapping = LM.fromList $ map (\test -> (formatTestEvaluationScheme $ entityVal test,
(test,
(formatTruncatedScore (testPrecision $ entityVal test)
(formatTruncatedScore (getTestFormattingOpts $ entityVal test)
$ extractScore (getTestReference test) entry)))) tests'
let crossTables = splitIntoTablesWithValues "Metric" "Score" mapping testLabels

View File

@ -491,18 +491,20 @@ formatFullScore :: Maybe Evaluation -> Text
formatFullScore (Just evaluation) = fromMaybe "???" (formatNonScientifically <$> evaluationScore evaluation)
formatFullScore Nothing = "N/A"
formatTruncatedScore :: Maybe Int -> Maybe Evaluation -> Text
formatTruncatedScore Nothing e = formatFullScore e
formatTruncatedScore :: FormattingOptions -> Maybe Evaluation -> Text
formatTruncatedScore _ Nothing = formatFullScore Nothing
formatTruncatedScore (Just precision) (Just evaluation) = case evaluationScore evaluation of
formatTruncatedScore formattingOpts (Just evaluation) = case evaluationScore evaluation of
Just score -> T.pack $ formatTheResultWithErrorBounds formattingOpts score (evaluationErrorBound evaluation)
Nothing -> formatFullScore Nothing
where formattingOpts = FormattingOptions {
decimalPlaces = Just precision,
asPercentage = False
}
getTestFormattingOpts :: Test -> FormattingOptions
getTestFormattingOpts test =
FormattingOptions {
decimalPlaces = testPrecision test,
asPercentage = fromMaybe False $ testAsPercentage test
}
formatScore :: Maybe Int -> Double -> Text
formatScore Nothing = T.pack . show
formatScore (Just precision) = T.pack . (printf "%0.*f" precision)

View File

@ -176,7 +176,8 @@ statusCell :: Text -> RepoScheme -> Repo -> (a -> (SubmissionId, Submission, Var
statusCell challengeName repoScheme challengeRepo fun = Table.widget "" (statusCellWidget challengeName repoScheme challengeRepo . fun)
resultCell :: Test -> (a -> Maybe Evaluation) -> Table App a
resultCell test fun = hoverTextCell (formatTestForHtml test) (formatTruncatedScore (testPrecision test) . fun) (formatFullScore . fun)
resultCell test fun = hoverTextCell (formatTestForHtml test) (formatTruncatedScore formattingOpts . fun) (formatFullScore . fun)
where formattingOpts = getTestFormattingOpts test
textLimited :: Int -> Text -> Text
textLimited limit t

View File

@ -75,6 +75,7 @@ Test
commit SHA1
active Bool default=True
precision Int Maybe
asPercentage Bool Maybe
priority Int Maybe
UniqueChallengeNameMetricChecksum challenge name metric checksum
deriving Show