diff --git a/conf/local.cfg.example b/conf/local.cfg.example index 348d45e..7e87b1e 100644 --- a/conf/local.cfg.example +++ b/conf/local.cfg.example @@ -179,6 +179,63 @@ InternalName = example -- DeadlinePenalty = 3/4 +--| +--| Option "VirtualDeadlines" +--| Required: optional +--| +--| This option sets deadlines for all contestnts as virtual start time + VirtualDeadlines seconds. +--| + +-- VirtualDeadlines = 600 -- 10 minutes + +--| +--| Section "CustomScoring" +--| +--| Required: optional +--| +--| You want to make your own scoring system? Use this section! +--| Contestant's score will compute as function of fold of scores by each run in time order. +--| + +-- CustomScoring { + + --| + --| Option: "InitialValue" + --| Required: mandatory + --| + --| ELang expression specifying initial value of accumulator in fold. + --| + + -- InitialValue = 0 + + --| + --| Option: "RecomputeFormula" + --| Required: mandatory + --| + --| ELang expression specifying formula for recomputing value by each run. + --| May contain variables: + --| *previousValue -- value before applying this formula + --| *runScore -- score of current run + --| *isOverdue -- True, if current run is overdue, False elses + --| + + -- RecomputeFormula = Max(previousValue, runScore * If(isOverdue, 1, 3 / 4)) + + --| + --| Option: "FinalFormula" + --| Required: mandatory + --| + --| ELang expression specifying formula for recomput final score by each fold's result. + --| Must return number. + --| May contain variables: + --| *intermediateResult -- fold's result + --| + + + -- FinalFormula = intermediateResult + +-- } + --| --| Section "SetFixedDeadline" --| diff --git a/src/EjStand/Models/Standing.hs b/src/EjStand/Models/Standing.hs index 0d3c5a5..edc5a47 100644 --- a/src/EjStand/Models/Standing.hs +++ b/src/EjStand/Models/Standing.hs @@ -17,6 +17,7 @@ module EjStand.Models.Standing , RunStatusType(..) , FixedDeadline(..) , ConditionalStyle(..) + , CustomScoring(..) , ColumnVariant(..) , OrderType(..) , FractionDisplayStyle(..) @@ -122,6 +123,11 @@ data FractionDisplayStyle = DisplayAsFraction | DisplayAsDecimal !Int deriving (Show) +data CustomScoring = CustomScoring { initialValue :: !ELang.ASTElement + , recomputeFormula :: !ELang.ASTElement + , finalFormula :: !ELang.ASTElement + } + data StandingConfig = StandingConfig { standingName :: !Text , standingContests :: !(Set Integer) , internalName :: !Text @@ -144,6 +150,8 @@ data StandingConfig = StandingConfig { standingName :: !Text , showLanguages :: !Bool , showProblemStatistics :: !Bool , fractionDisplayStyle :: !FractionDisplayStyle + , virtualDeadlines :: !(Maybe Integer) + , customScoring :: !(Maybe CustomScoring) } data RunStatusType = Ignore | Mistake | Rejected | Processing | Pending | Success | Disqualified | Error diff --git a/src/EjStand/Parsers/Configuration.hs b/src/EjStand/Parsers/Configuration.hs index 4181f57..d352834 100644 --- a/src/EjStand/Parsers/Configuration.hs +++ b/src/EjStand/Parsers/Configuration.hs @@ -326,6 +326,14 @@ buildContestNamePattern = evalState $ do !_ <- ensureEmptyState return (regex, replacer) +buildCustomScoring :: Configuration -> CustomScoring +buildCustomScoring = evalState $ do + initialValue <- takeMandatoryValue |> toTextValue |> toELangAST $ "InitialValue" + recomputeFormula <- takeMandatoryValue |> toTextValue |> toELangAST $ "RecomputeFormula" + finalFormula <- takeMandatoryValue |> toTextValue |> toELangAST $ "FinalFormula" + !_ <- ensureEmptyState + return $ CustomScoring initialValue recomputeFormula finalFormula + buildNestedOptions :: (Configuration -> a) -> Text -> TraversingState IO [a] buildNestedOptions builder optionName = do nested <- takeValuesByKey ||> toNestedConfig $ optionName @@ -369,6 +377,8 @@ buildStandingConfig path = do showProblemStatistics <- takeUniqueValue ||> toTextValue ||> toBool .> fromMaybe False $ "ShowProblemStatistics" fractionDisplayStyle <- takeUniqueValue ||> toTextValue ||> toFractionDisplayStyle .> fromMaybe DisplayAsFraction $ "DecimalPrecision" + virtualDeadlines <- takeUniqueValue ||> toTextValue ||> toInteger $ "VirtualDeadlines" + customScoring <- takeUniqueValue ||> toNestedConfig |.> buildCustomScoring $ "CustomScoring" !_ <- ensureEmptyState return $ StandingConfig { standingName = standingName , standingContests = standingContests @@ -392,6 +402,8 @@ buildStandingConfig path = do , showLanguages = showLanguages , showProblemStatistics = showProblemStatistics , fractionDisplayStyle = fractionDisplayStyle + , virtualDeadlines = virtualDeadlines + , customScoring = customScoring } parseStandingConfig :: FilePath -> IO StandingConfig diff --git a/src/EjStand/StandingBuilder.hs b/src/EjStand/StandingBuilder.hs index e495e40..f57b698 100644 --- a/src/EjStand/StandingBuilder.hs +++ b/src/EjStand/StandingBuilder.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module EjStand.StandingBuilder ( prepareStandingSource , buildStanding @@ -24,7 +25,9 @@ import qualified Data.Set as Set import Data.Text ( Text , unpack ) -import Data.Time ( UTCTime ) +import Data.Time ( UTCTime + , addUTCTime + ) import EjStand.Internals.Core ( fromIdentifiableList ) import EjStand.Models.Base import EjStand.Models.Standing @@ -33,6 +36,7 @@ import EjStand.Parsers.EjudgeOptions ( updateStandingSourceWithProble import EjStand.Web.HtmlElements ( getColumnByVariant , getColumnByVariantWithStyles ) +import qualified EjStand.ELang as ELang import Safe ( headMay , lastMay , minimumMay @@ -57,12 +61,16 @@ isAppliableDeadlineOption Problem {..} Contestant {..} FixedDeadline {..} | otherwise = False calculateDeadline :: StandingConfig -> StandingSource -> Problem -> Contestant -> Maybe UTCTime -calculateDeadline StandingConfig {..} StandingSource {..} prob@Problem {..} user@Contestant {..} = if enableDeadlines +calculateDeadline StandingConfig {..} src@StandingSource {..} prob@Problem {..} user@Contestant {..} = if enableDeadlines then let nextContest = snd <$> Map.lookupGT problemContest contests defaultDeadline = nextContest >>= contestStartTime customDeadline = fmap deadline $ lastMay $ filter (isAppliableDeadlineOption prob user) fixedDeadlines - in headMay $ catMaybes [customDeadline, defaultDeadline] + virtualDeadline = do + time <- virtualDeadlines + virtualStart <- getVirtualStart src prob user + return $ addUTCTime (fromInteger time) virtualStart + in headMay $ catMaybes [virtualDeadline, customDeadline, defaultDeadline] else Nothing -- Standing building @@ -125,6 +133,22 @@ applicateRun cfg prob cell@StandingCell {..} runT@(Run {..}, _) | getRunStatusType runStatus == Disqualified = (setCellMainRunForce cfg prob runT cell) { cellScore = 0 } | otherwise = setCellMainRunMaybe cfg prob runT cell +applicateRunWithCustomScoring :: StandingConfig -> Problem -> (StandingCell, Maybe ELang.Value) -> (Run, Bool) -> (StandingCell, Maybe ELang.Value) +applicateRunWithCustomScoring cfg@StandingConfig {..} prob state@(cell@StandingCell {..}, intermediateResult) runT@(Run {..}, overdue) + | getRunStatusType runStatus == Ignore = state + | cellType == Error = state + | getRunStatusType runStatus == Error = (setCellMainRunForce cfg prob runT cell, Nothing) + | cellType == Disqualified = state + | getRunStatusType runStatus == Disqualified = (setCellMainRunForce cfg prob runT cell, Nothing) + | otherwise = case fromJust customScoring of + CustomScoring{..} -> case + ELang.evaluate recomputeFormula [ ELang.VariableBinding "previousValue" (return (fromJust intermediateResult)) + , ELang.VariableBinding "runScore" (return (ELang.ValueRational (fromMaybe 0 runScore))) + , ELang.VariableBinding "isOverdue" (return (ELang.ValueBool overdue)) + ] of + Left _ -> (cell { cellType = Error }, Nothing) + Right val -> (setCellMainRunForce cfg prob runT cell, Just val) + getVirtualStart :: StandingSource -> Problem -> Contestant -> Maybe UTCTime getVirtualStart StandingSource {..} Problem {..} Contestant {..} = minimumMay $ runTime <$> filter ((== VS) . runStatus) @@ -136,7 +160,19 @@ buildCell cfg@StandingConfig {..} src@StandingSource {..} prob@Problem {..} user deadline = calculateDeadline cfg src prob user startCell = defaultCell $ contests ! problemContest virtualStart = if showSuccessTime then getVirtualStart src prob user else Nothing - cell = foldl (applicateRun cfg prob) startCell $ applyRunDeadline deadline <$> runsList + cell = case customScoring of + Nothing -> foldl (applicateRun cfg prob) startCell $ applyRunDeadline deadline <$> runsList + Just CustomScoring {..} -> let + startValue = case ELang.evaluate initialValue [] of + Left _ -> Nothing + Right val -> Just val + in case foldl (applicateRunWithCustomScoring cfg prob) (startCell, startValue) $ applyRunDeadline deadline <$> runsList of + (cell, Nothing) -> cell { cellType = Error } + (cell, Just value) -> case ELang.evaluate finalFormula [ELang.VariableBinding "intermediateResult" (return value)] of + Left _ -> cell { cellType = Error } + Right finalValue -> case ELang.fromValue finalValue :: Maybe Rational of + Nothing -> cell { cellType = Error } + Just score -> cell { cellScore = score } in cell { cellStartTime = fromMaybe (cellStartTime cell) virtualStart } calculateCellStats :: StandingCell -> StandingRowStats