Update for GEval preprocessing operations

This commit is contained in:
Filip Graliński 2019-08-12 18:19:02 +02:00
parent e589996530
commit 3b6846c683
9 changed files with 39 additions and 11 deletions

View File

@ -17,6 +17,7 @@ import qualified Data.Map as M
import Handler.Tables (timestampCell) import Handler.Tables (timestampCell)
import GEval.Core (isBetter) import GEval.Core (isBetter)
import GEval.EvaluationScheme
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Database.Esqueleto ((^.)) import Database.Esqueleto ((^.))
@ -227,7 +228,7 @@ getTargetStatus theNow entries indicator target =
else TargetOngoing else TargetOngoing
else TargetPassed else TargetPassed
where entries' = where entries' =
filter (\v -> isBetter (testMetric $ entityVal $ indicatorEntryTest indicator) filter (\v -> isBetter (evaluationSchemeMetric $ testMetric $ entityVal $ indicatorEntryTest indicator)
v v
(targetValue $ entityVal target)) (targetValue $ entityVal target))
$ catMaybes $ catMaybes

View File

@ -9,6 +9,7 @@ import Data.Maybe
import Data.List ((!!)) import Data.List ((!!))
import Database.Persist.Sql import Database.Persist.Sql
import GEval.Core (getMetricOrdering) import GEval.Core (getMetricOrdering)
import GEval.EvaluationScheme
import GEval.Common (MetricValue) import GEval.Common (MetricValue)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
@ -247,7 +248,7 @@ entriesToPoints (Entity testId test) entries = (scores, timePoints)
monotonicBy (\entry -> fromJust $ evaluationScore $ (tableEntryMapping entry) M.! testId) comparator monotonicBy (\entry -> fromJust $ evaluationScore $ (tableEntryMapping entry) M.! testId) comparator
$ filter (\entry -> testId `M.member` (tableEntryMapping entry) $ filter (\entry -> testId `M.member` (tableEntryMapping entry)
&& isJust (evaluationScore ((tableEntryMapping entry) M.! testId))) entries && isJust (evaluationScore ((tableEntryMapping entry) M.! testId))) entries
comparator = compareFun $ getMetricOrdering $ testMetric test comparator = compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test
targetsToLines :: UTCTime -> IndicatorEntry -> [TargetStatus] -> Value targetsToLines :: UTCTime -> IndicatorEntry -> [TargetStatus] -> Value
targetsToLines theNow indicator statuses = object [ targetsToLines theNow indicator statuses = object [

View File

@ -40,6 +40,7 @@ import System.IO.Unsafe (unsafePerformIO)
import Text.Regex.TDFA import Text.Regex.TDFA
import GEval.Core import GEval.Core
import GEval.EvaluationScheme
import qualified Data.Vector as DV import qualified Data.Vector as DV
@ -395,6 +396,7 @@ getIsHigherTheBetterArray = Array
. DV.fromList . DV.fromList
. map (convertIsHigherTheBetter . map (convertIsHigherTheBetter
. getMetricOrdering . getMetricOrdering
. evaluationSchemeMetric
. testMetric) . testMetric)
where convertIsHigherTheBetter TheHigherTheBetter = Bool True where convertIsHigherTheBetter TheHigherTheBetter = Bool True
convertIsHigherTheBetter _ = Bool False convertIsHigherTheBetter _ = Bool False
@ -416,5 +418,6 @@ runSlackHook hook message = do
mempty mempty
return () return ()
slackLink app title addr = "<" ++ link ++ "|" ++ title ++ ">" slackLink :: App -> Text -> Text -> Text
where link = (appRoot $ appSettings app) ++ "/" ++ addr slackLink app title addr = "<" ++ slink ++ "|" ++ title ++ ">"
where slink = (appRoot $ appSettings app) ++ "/" ++ addr

View File

@ -29,6 +29,7 @@ import Gonito.ExtractMetadata (ExtractionOptions(..),
import qualified Text.Read as TR import qualified Text.Read as TR
import GEval.Core import GEval.Core
import GEval.EvaluationScheme
import GEval.Common (MetricValue) import GEval.Common (MetricValue)
import GEval.OptionsParser import GEval.OptionsParser
import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..)) import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..))
@ -277,7 +278,7 @@ doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do
activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] [] activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
let (Entity mainTestId mainTest) = getMainTest activeTests let (Entity mainTestId mainTest) = getMainTest activeTests
let orderDirection = case getMetricOrdering (testMetric mainTest) of let orderDirection = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of
TheHigherTheBetter -> E.desc TheHigherTheBetter -> E.desc
TheLowerTheBetter -> E.asc TheLowerTheBetter -> E.asc
@ -341,10 +342,10 @@ doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do
newScores <- mapM (getScoreForOut mainTestId) outs newScores <- mapM (getScoreForOut mainTestId) outs
let newScores' = catMaybes newScores let newScores' = catMaybes newScores
let newScores'' = case getMetricOrdering (testMetric mainTest) of let newScores'' = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of
TheHigherTheBetter -> reverse $ sort newScores' TheHigherTheBetter -> reverse $ sort newScores'
TheLowerTheBetter -> sort newScores' TheLowerTheBetter -> sort newScores'
let compOp = case getMetricOrdering (testMetric mainTest) of let compOp = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of
TheLowerTheBetter -> (<) TheLowerTheBetter -> (<)
TheHigherTheBetter -> (>) TheHigherTheBetter -> (>)
@ -554,7 +555,7 @@ checkOrInsertEvaluation repoDir chan out = do
msg chan $ "Start evaluation..." msg chan $ "Start evaluation..."
challengeDir <- getRepoDir $ challengePrivateRepo challenge challengeDir <- getRepoDir $ challengePrivateRepo challenge
variant <- runDB $ get404 $ outVariant out variant <- runDB $ get404 $ outVariant out
resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv") resultOrException <- liftIO $ rawEval challengeDir (evaluationSchemeMetric $ testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv")
case resultOrException of case resultOrException of
Right (Left _) -> do Right (Left _) -> do
err chan "Cannot parse options, check the challenge repo" err chan "Cannot parse options, check the challenge repo"

View File

@ -22,6 +22,7 @@ import PersistSHA1
import qualified Data.List as DL import qualified Data.List as DL
import GEval.Core import GEval.Core
import GEval.EvaluationScheme
import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..)) import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..))
@ -243,7 +244,7 @@ getLeaderboardEntries ByTag challengeId =
noEmptyList l = map Just l noEmptyList l = map Just l
compareResult :: Test -> Maybe Double -> Maybe Double -> Ordering compareResult :: Test -> Maybe Double -> Maybe Double -> Ordering
compareResult test (Just x) (Just y) = (compareFun $ getMetricOrdering $ testMetric test) x y compareResult test (Just x) (Just y) = (compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test) x y
compareResult _ (Just _) Nothing = GT compareResult _ (Just _) Nothing = GT
compareResult _ Nothing (Just _) = LT compareResult _ Nothing (Just _) = LT
compareResult _ Nothing Nothing = EQ compareResult _ Nothing Nothing = EQ

View File

@ -6,7 +6,9 @@ import Database.Persist.Quasi
import PersistSHA1 import PersistSHA1
import GEval.Core import GEval.Core
import GEval.EvaluationScheme
import PersistMetric import PersistMetric
import PersistEvaluationScheme
-- You can define all of your database entities in the entities file. -- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities -- You can find more information on persistent and how to declare entities

View File

@ -0,0 +1,18 @@
module PersistEvaluationScheme where
import ClassyPrelude.Yesod
import Database.Persist.Sql
import GEval.EvaluationScheme
import qualified Data.Text as T
instance PersistField EvaluationScheme where
toPersistValue m = PersistText (T.pack $ show m)
fromPersistValue (PersistText t) = case readMay t of
Just val -> Right val
Nothing -> Left "Unexpected value"
fromPersistValue _ = Left "Unexpected value"
instance PersistFieldSql EvaluationScheme where
sqlType _ = SqlString

View File

@ -42,7 +42,7 @@ Challenge
archived Bool Maybe archived Bool Maybe
Test Test
challenge ChallengeId challenge ChallengeId
metric Metric metric EvaluationScheme
name Text name Text
checksum SHA1 checksum SHA1
commit SHA1 commit SHA1

View File

@ -24,6 +24,7 @@ library
Import Import
Import.NoFoundation Import.NoFoundation
Model Model
PersistEvaluationScheme
PersistMetric PersistMetric
PersistSHA1 PersistSHA1
Settings Settings
@ -126,7 +127,7 @@ library
, filemanip , filemanip
, cryptohash , cryptohash
, markdown , markdown
, geval >= 1.16.2.0 && < 1.19 , geval >= 1.19.0.0 && < 1.20
, filepath , filepath
, yesod-table , yesod-table
, regex-tdfa , regex-tdfa