From 25262aa7a5d925f07faeb912cfb1aa86d56035c1 Mon Sep 17 00:00:00 2001 From: Wolfgang Witt Date: Wed, 17 Mar 2021 15:49:38 +0100 Subject: [PATCH] chore: allow ignoring occurances based on a curated set --- src/Handler/Utils/Exam.hs | 65 ++++++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 25 deletions(-) diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 950efa03c..9d4da6a67 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -7,8 +7,8 @@ module Handler.Utils.Exam , examResultBonus, examGrade , examBonusGrade , ExamAutoOccurrenceConfig - , eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize - , _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize + , eaocIgnoreRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize + , _eaocIgnoreRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize , ExamAutoOccurrenceException(..) , examAutoOccurrence , deregisterExamUsersCount, deregisterExamUsers @@ -217,9 +217,18 @@ examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus bonusPossible = normalSummary <$> sheetSummary bonusAchieved = (<>) <$> fmap normalSummary sheetSummary <*> fmap bonusSummary sheetSummary +data ExamAutoOccurrenceIgnoreRooms = EAOIRAutomatic | EAOIRManual (Set ExamOccurrenceId) + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +instance Default ExamAutoOccurrenceIgnoreRooms where + def = EAOIRManual Set.empty + +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''ExamAutoOccurrenceIgnoreRooms data ExamAutoOccurrenceConfig = ExamAutoOccurrenceConfig - { eaocMinimizeRooms :: Bool + { eaocIgnoreRooms :: ExamAutoOccurrenceIgnoreRooms , eaocFinenessCost :: Rational -- ^ Cost factor incentivising shorter common prefixes on breaks between rooms , eaocNudge :: Map ExamOccurrenceId Integer , eaocNudgeSize :: Rational @@ -227,7 +236,7 @@ data ExamAutoOccurrenceConfig = ExamAutoOccurrenceConfig instance Default ExamAutoOccurrenceConfig where def = ExamAutoOccurrenceConfig - { eaocMinimizeRooms = False + { eaocIgnoreRooms = def , eaocFinenessCost = 0.2 , eaocNudge = Map.empty , eaocNudgeSize = 0.05 @@ -257,7 +266,8 @@ examAutoOccurrence :: forall seed. -> ExamAutoOccurrenceConfig -> Map ExamOccurrenceId ExamOccurrenceCapacity -> Map UserId (User, Maybe ExamOccurrenceId) - -> Either ExamAutoOccurrenceException (ExamOccurrenceMapping ExamOccurrenceId, Map UserId (Maybe ExamOccurrenceId)) + -> Either ExamAutoOccurrenceException + (ExamOccurrenceMapping ExamOccurrenceId, Map UserId (Maybe ExamOccurrenceId), Set ExamOccurrenceId) examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users | Map.null users' = Left ExamAutoOccurrenceExceptionNoUsers @@ -271,6 +281,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences examOccurrenceMappingMapping = Map.fromList $ set _2 (Set.singleton ExamOccurrenceMappingRandom) <$> occurrences'' } , Map.union (view _2 <$> assignedUsers) randomlyAssignedUsers + , ignoredOccurrences ) where assignedUsers,unassignedUsers :: Map UserId (User, Maybe ExamOccurrenceId) @@ -352,7 +363,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences fillUnrestricted [] _ = error "fillUnrestricted should only be called with an infinite list" fillUnrestricted (nextRoom:followingRooms) (acc, nextUser:remainingUsers) = fillUnrestricted followingRooms ((nextUser, Just nextRoom) : acc, remainingUsers) - _ -> bimap (ExamOccurrenceMapping rule) (Map.unionWith (<|>) (view _2 <$> users)) . postprocess <$> bestOption + _ -> over _1 (ExamOccurrenceMapping rule) . over _2 (Map.unionWith (<|>) (view _2 <$> users)) . postprocess <$> bestOption where usersCount :: forall a. Num a => a usersCount = getSum $ foldMap (Sum . fromIntegral . Set.size) users' @@ -394,30 +405,33 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences predToPositive (Restricted n) = Just $ Restricted $ pred n occurrences'' :: [(ExamOccurrenceId, ExamOccurrenceCapacity)] + ignoredOccurrences :: Set ExamOccurrenceId -- ^ Minimise number of occurrences used -- -- Prefer occurrences with higher capacity -- -- If a single occurrence can accommodate all participants, pick the one with -- the least capacity - occurrences'' - | not eaocMinimizeRooms - = Map.toList occurrences' - | Just largeEnoughs <- fromNullable . filter ((>= Restricted usersCount) . view _2) $ Map.toList occurrences' - = pure $ minimumBy (comparing $ view _2) largeEnoughs - | otherwise - = view _2 . foldl' accF (Restricted 0, []) . sortOn (Down . view _2) $ Map.toList occurrences' - where - accF :: (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)]) - -> (ExamOccurrenceId, ExamOccurrenceCapacity) - -> (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)]) - accF acc@(accSize, accOccs) occ@(_, occSize) - | accSize >= Restricted usersCount - = acc - | otherwise - = ( accSize <> occSize - , occ : accOccs - ) + (occurrences'', ignoredOccurrences) = case eaocIgnoreRooms of + (EAOIRManual manuallyIgnored) -> (Map.toList $ Map.restrictKeys occurrences' manuallyIgnored, manuallyIgnored) + EAOIRAutomatic -- effect of ticked minimizeRooms Checkbox + | Just largeEnoughs <- fromNullable . filter ((>= Restricted usersCount) . view _2) $ Map.toList occurrences' + -> let pickedLargeEnough = minimumBy (comparing $ view _2) largeEnoughs + in (pure pickedLargeEnough, Set.delete (view _1 pickedLargeEnough) $ Map.keysSet occurrences') + | otherwise + -> (\(_,b,c) -> (b,c)) . foldl' accF (Restricted 0, [], Set.empty) . sortOn (Down . view _2) $ Map.toList occurrences' + where + accF :: (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], Set ExamOccurrenceId) + -> (ExamOccurrenceId, ExamOccurrenceCapacity) + -> (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], Set ExamOccurrenceId) + accF (accSize, accOccs, accIgnored) occ@(occId, occSize) + | accSize >= Restricted usersCount + = (accSize, accOccs, Set.insert occId accIgnored) + | otherwise + = ( accSize <> occSize + , occ : accOccs + , accIgnored + ) partitionRestricted :: ([a], [(a, Natural)]) -> [(a,ExamOccurrenceCapacity)] -> ([a], [(a, Natural)]) partitionRestricted acc [] = acc @@ -646,8 +660,9 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences postprocess :: [(ExamOccurrenceId, [[CI Char]])] -> ( Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription) , Map UserId (Maybe ExamOccurrenceId) + , Set ExamOccurrenceId ) - postprocess result = (resultAscList, resultUsers) + postprocess result = (resultAscList, resultUsers, ignoredOccurrences) where maxTagLength :: Int maxTagLength = maybe 0 maximum $ fromNullable $ concatMap (map length . snd) result