diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 7734e05b5..324fd5498 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -317,9 +317,12 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences predToPositive 1 = Nothing predToPositive x = Just $ pred x extraCapacity :: Natural - extraCapacity - | restrictedSpace > numUnassignedUsers = restrictedSpace - numUnassignedUsers - | otherwise = 0 + extraUsers :: Natural + (extraCapacity, extraUsers) + | restrictedSpace > numUnassignedUsers + = (restrictedSpace - numUnassignedUsers, 0) + | otherwise + = (0, numUnassignedUsers - restrictedSpace) where restrictedSpace :: Natural restrictedSpace = sum restrictedOccurrences @@ -337,18 +340,32 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences nudgedUnrestrictedOccurrences = nudgedPositiveOccurrences unrestrictedPositiveNudges [] ++ nudgedNegativeOccurrences unrestrictedNegativeNudges [] 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 nudgedPositiveOccurrences :: Map ExamOccurrenceId Natural -> [ExamOccurrenceId] -> [ExamOccurrenceId] nudgedPositiveOccurrences nudges acc | null nudges = acc | 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 nudgedNegativeOccurrences :: Map ExamOccurrenceId Natural ->[ExamOccurrenceId] -> [ExamOccurrenceId] nudgedNegativeOccurrences nudges acc | null nudges = acc | 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 randomlyAssignedUsers :: Map UserId (Maybe ExamOccurrenceId) randomlyAssignedUsers = Map.fromList $ fillUnrestricted