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

chore: allow nudges between unrestricted rooms (random)

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-17 13:46:28 +01:00 committed by Gregor Kleen
parent 3ab8be2e0d
commit ddb68eeb98
1 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -291,16 +291,16 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
currentRatios = Map.merge Map.dropMissing Map.dropMissing (Map.zipWithMatched calculateRatio)
currentOccurrences restrictedOccurrences
calculateRatio :: ExamOccurrenceId -> Natural -> Natural -> Rational
calculateRatio k c m = fromIntegral c / (max 1 $ fromIntegral m * sizeModifier)
calculateRatio k c m = fromIntegral c / max 1 (fromIntegral m * sizeModifier)
where
sizeModifier :: Rational
sizeModifier = 1 + eaocNudgeSize * fromIntegral (lineNudges k)
biggestOutlier :: ExamOccurrenceId
biggestOutlier = fst . List.maximumBy (comparing $ view _2) $ Map.toList currentRatios
predToPositive :: Natural -> Maybe Natural
predToPositive 0 = Nothing
predToPositive 1 = Nothing
predToPositive x = Just $ pred x
predToPositive :: Natural -> Maybe Natural
predToPositive 0 = Nothing
predToPositive 1 = Nothing
predToPositive x = Just $ pred x
extraCapacity :: Natural
extraCapacity
| restrictedSpace > numUnassignedUsers = restrictedSpace - numUnassignedUsers
@ -312,9 +312,32 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
numUnassignedUsers = fromIntegral $ length unassignedUsers
finalOccurrences :: [(ExamOccurrenceId, Natural)]
finalOccurrences = Map.toList $ decreaseBiggestOutlier extraCapacity restrictedOccurrences
unrestrictedPositiveNudges :: Map ExamOccurrenceId Natural
unrestrictedNegativeNudges :: Map ExamOccurrenceId Natural
(unrestrictedPositiveNudges, unrestrictedNegativeNudges)
= bimap (Map.map fromIntegral) (Map.map $ fromIntegral . negate) $ Map.partition (> 0)
$ Map.filter (/= 0) $ Map.restrictKeys eaocNudge unrestrictedOccurrences
-- extra entries caused by nudges
nudgedUnrestrictedOccurrences :: [ExamOccurrenceId]
nudgedUnrestrictedOccurrences = nudgedPositiveOccurrences unrestrictedPositiveNudges []
++ nudgedNegativeOccurrences unrestrictedNegativeNudges []
where
-- 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
-- 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
-- fill in users in a random order
randomlyAssignedUsers :: Map UserId (Maybe ExamOccurrenceId)
randomlyAssignedUsers = Map.fromList $ fillUnrestricted (List.cycle $ Set.toList unrestrictedOccurrences)
randomlyAssignedUsers = Map.fromList $ fillUnrestricted
(nudgedUnrestrictedOccurrences ++ List.cycle (Set.toList unrestrictedOccurrences))
$ foldl' addUsers ([], shuffledUsers) finalOccurrences
addUsers :: ([(UserId, Maybe ExamOccurrenceId)], [UserId])
-> (ExamOccurrenceId, Natural)