From ddb68eeb98c990152e0e30280ff50e9294d454bb Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Wed, 17 Mar 2021 13:46:28 +0100
Subject: [PATCH] chore: allow nudges between unrestricted rooms (random)

---
 src/Handler/Utils/Exam.hs | 35 +++++++++++++++++++++++++++++------
 1 file changed, 29 insertions(+), 6 deletions(-)

diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index ad583e6ae..950efa03c 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -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)