fix(test): isNullResultJustified reported false positives

matriculation numbers are limited to suffixes of equal length
now the relevant test respects this (may result in bigger buckets)
This commit is contained in:
Wolfgang Witt 2021-03-02 10:27:50 +01:00 committed by Wolfgang Witt
parent e14c4091e6
commit 292f5cf91b

View File

@ -14,6 +14,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Foldable
import qualified Data.RFC5051 as RFC5051 import qualified Data.RFC5051 as RFC5051
@ -332,14 +333,14 @@ spec = do
mappingImpossiblePlausible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool mappingImpossiblePlausible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool
mappingImpossiblePlausible mappingImpossiblePlausible
rule rule
userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . relevantUsers rule -> users') userProperties@(sortBy RFC5051.compareUnicode . mapRuleProperty rule . Map.elems . relevantUsers rule -> users')
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences' (map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences'
where where
smallestRoom :: Natural smallestRoom :: Natural
smallestRoom = maybe 0 minimum $ fromNullable occurrences' smallestRoom = maybe 0 minimum $ fromNullable occurrences'
-- If there exists a bucket with the same tag bigger than the smallest room a nullResult might be returned -- If there exists a bucket with the same tag bigger than the smallest room a nullResult might be returned
-- It may still work, but is not guaranteed (e.g. both the first bucket) -- It may still work, but is not guaranteed (e.g. both the first bucket)
go :: Natural -> [Maybe Text] -> [Natural] -> Bool go :: forall a. Eq a => Natural -> [a] -> [Natural] -> Bool
go biggestUserBucket [] _occurrences = biggestUserBucket > smallestRoom go biggestUserBucket [] _occurrences = biggestUserBucket > smallestRoom
go _biggestUserBucket _remainingUsers [] = True go _biggestUserBucket _remainingUsers [] = True
go biggestUserBucket remainingUsers (0:t) = go biggestUserBucket remainingUsers t go biggestUserBucket remainingUsers (0:t) = go biggestUserBucket remainingUsers t
@ -350,13 +351,18 @@ spec = do
= go biggestUserBucket remainingUsers laterOccurrences = go biggestUserBucket remainingUsers laterOccurrences
where where
nextUsers :: Natural nextUsers :: Natural
remainingUsers' :: [Maybe Text] remainingUsers' :: [a]
(fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers (fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers
ruleProperty :: ExamOccurrenceRule -> UserProperties -> Maybe Text mapRuleProperty :: ExamOccurrenceRule -> [(UserProperties, b)] -> [Text]
ruleProperty rule = case rule of mapRuleProperty rule (map fst -> users') = map (ruleProperty rule minMatrLength) users'
ExamRoomSurname -> Just . userSurname . user where
ExamRoomMatriculation -> userMatrikelnummer . user minMatrLength :: Int
_rule -> const Nothing minMatrLength = Foldable.minimum $ map (maybe 0 Text.length . userMatrikelnummer . user) users'
ruleProperty :: ExamOccurrenceRule -> Int -> UserProperties -> Text
ruleProperty rule n = case rule of
ExamRoomSurname -> userSurname . user
ExamRoomMatriculation -> maybe Text.empty (Text.takeEnd n) . userMatrikelnummer . user
_rule -> const $ pack $ show rule
-- copied and adjusted from Hander.Utils.Exam -- copied and adjusted from Hander.Utils.Exam
adjustOccurrences :: Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Map ExamOccurrenceId Natural adjustOccurrences :: Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Map ExamOccurrenceId Natural
-- ^ reduce room capacity for every pre-assigned user by 1 -- ^ reduce room capacity for every pre-assigned user by 1