fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore: nudges for ExamRoomRandom have a bigger effect

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-24 12:28:19 +01:00 committed by Gregor Kleen
parent f9b545952d
commit e00a2b074b
1 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Handler/Utils/Exam.hs
View File

@ -317,9 +317,12 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
predToPositive 1 = Nothing predToPositive 1 = Nothing
predToPositive x = Just $ pred x predToPositive x = Just $ pred x
extraCapacity :: Natural extraCapacity :: Natural
extraCapacity extraUsers :: Natural
| restrictedSpace > numUnassignedUsers = restrictedSpace - numUnassignedUsers (extraCapacity, extraUsers)
| otherwise = 0 | restrictedSpace > numUnassignedUsers
= (restrictedSpace - numUnassignedUsers, 0)
| otherwise
= (0, numUnassignedUsers - restrictedSpace)
where where
restrictedSpace :: Natural restrictedSpace :: Natural
restrictedSpace = sum restrictedOccurrences restrictedSpace = sum restrictedOccurrences
@ -337,18 +340,32 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
nudgedUnrestrictedOccurrences = nudgedPositiveOccurrences unrestrictedPositiveNudges [] nudgedUnrestrictedOccurrences = nudgedPositiveOccurrences unrestrictedPositiveNudges []
++ nudgedNegativeOccurrences unrestrictedNegativeNudges [] ++ nudgedNegativeOccurrences unrestrictedNegativeNudges []
where where
replicateMany :: Int -> [a] -> [a]
replicateMany n as = take (n * length as) $ List.cycle as
nudgeEffect :: Int
nudgeEffect = max 1 $ ceiling $ eaocNudgeSize * fromIntegral extraUsers
-- for a positive nudge, add one entry to the front of the list -- for a positive nudge, add one entry to the front of the list
nudgedPositiveOccurrences :: Map ExamOccurrenceId Natural -> [ExamOccurrenceId] -> [ExamOccurrenceId] nudgedPositiveOccurrences :: Map ExamOccurrenceId Natural -> [ExamOccurrenceId] -> [ExamOccurrenceId]
nudgedPositiveOccurrences nudges acc nudgedPositiveOccurrences nudges acc
| null nudges = acc | null nudges = acc
| otherwise = nudgedPositiveOccurrences (Map.mapMaybe predToPositive nudges) | otherwise = nudgedPositiveOccurrences (Map.mapMaybe predToPositive nudges)
$ Set.toList (Set.intersection unrestrictedOccurrences $ Map.keysSet nudges) ++ acc $ nudgeOccurrences' ++ acc
where
nudgeOccurrences :: [ExamOccurrenceId]
nudgeOccurrences = Set.toList (Set.intersection unrestrictedOccurrences $ Map.keysSet nudges)
nudgeOccurrences' :: [ExamOccurrenceId]
nudgeOccurrences' = replicateMany nudgeEffect nudgeOccurrences
-- for a negative nudge, add one entry for every other unrestricted occurrence to the front of the list -- for a negative nudge, add one entry for every other unrestricted occurrence to the front of the list
nudgedNegativeOccurrences :: Map ExamOccurrenceId Natural ->[ExamOccurrenceId] -> [ExamOccurrenceId] nudgedNegativeOccurrences :: Map ExamOccurrenceId Natural ->[ExamOccurrenceId] -> [ExamOccurrenceId]
nudgedNegativeOccurrences nudges acc nudgedNegativeOccurrences nudges acc
| null nudges = acc | null nudges = acc
| otherwise = nudgedNegativeOccurrences (Map.mapMaybe predToPositive nudges) | otherwise = nudgedNegativeOccurrences (Map.mapMaybe predToPositive nudges)
$ Set.toList (Set.difference unrestrictedOccurrences $ Map.keysSet nudges) ++ acc $ nudgeOccurrences' ++ acc
where
nudgeOccurrences :: [ExamOccurrenceId]
nudgeOccurrences = Set.toList (Set.difference unrestrictedOccurrences $ Map.keysSet nudges)
nudgeOccurrences' :: [ExamOccurrenceId]
nudgeOccurrences' = replicateMany nudgeEffect nudgeOccurrences
-- fill in users in a random order -- fill in users in a random order
randomlyAssignedUsers :: Map UserId (Maybe ExamOccurrenceId) randomlyAssignedUsers :: Map UserId (Maybe ExamOccurrenceId)
randomlyAssignedUsers = Map.fromList $ fillUnrestricted randomlyAssignedUsers = Map.fromList $ fillUnrestricted