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

show params in graph labels

Browse Source
This commit is contained in:
Filip Graliński 2018-07-24 15:36:24 +02:00
parent c54af512c7
commit 70271c81f5
1 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Handler/Graph.hs
View File

@ -3,7 +3,6 @@ module Handler.Graph where
import Import import Import
import Handler.Tables import Handler.Tables
import Handler.Shared
import Data.Maybe import Data.Maybe
import Data.List ((!!)) import Data.List ((!!))
import Database.Persist.Sql import Database.Persist.Sql
@ -22,20 +21,20 @@ submissionsToJSON condition challengeName = do
forks <- runDB $ selectList [ForkSource <-. submissionIds, ForkTarget <-. submissionIds] [] forks <- runDB $ selectList [ForkSource <-. submissionIds, ForkTarget <-. submissionIds] []
return $ object [ "nodes" .= (Data.Maybe.catMaybes $ map (auxSubmissionToNode naturalRange) $ zip [0..] entries), return $ object [ "nodes" .= (Data.Maybe.catMaybes $ map (auxSubmissionToNode naturalRange) $ entries),
"edges" .= map forkToEdge forks ] "edges" .= map forkToEdge forks ]
getNaturalRange :: [LeaderboardEntry] -> Double getNaturalRange :: [LeaderboardEntry] -> Double
getNaturalRange entries = 2.0 * (interQuantile $ Data.Maybe.catMaybes $ map (evaluationScore . leaderboardEvaluation) entries) getNaturalRange entries = 2.0 * (interQuantile $ Data.Maybe.catMaybes $ map (evaluationScore . leaderboardEvaluation) entries)
auxSubmissionToNode :: Double -> (Int, LeaderboardEntry) -> Maybe Value auxSubmissionToNode :: Double -> LeaderboardEntry -> Maybe Value
auxSubmissionToNode naturalRange (n, entry) = case evaluationScore $ leaderboardEvaluation entry of auxSubmissionToNode naturalRange entry = case evaluationScore $ leaderboardEvaluation entry of
Just score -> Just $ object [ Just score -> Just $ object [
"id" .= (nodeId $ leaderboardBestSubmissionId entry), "id" .= (nodeId $ leaderboardBestSubmissionId entry),
"x" .= (stampToX $ submissionStamp $ leaderboardBestSubmission entry), "x" .= (stampToX $ submissionStamp $ leaderboardBestSubmission entry),
"y" .= (- ((score / naturalRange) * 100.0)), "y" .= (- ((score / naturalRange) * 100.0)),
"size" .= (2 :: Int), "size" .= (2 :: Int),
"label" .= submissionDescription (leaderboardBestSubmission entry) ] "label" .= descriptionToBeShown (leaderboardBestSubmission entry) (leaderboardBestVariant entry) (leaderboardParams entry) ]
Nothing -> Nothing Nothing -> Nothing
forkToEdge :: Entity Fork -> Value forkToEdge :: Entity Fork -> Value