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

chore: reimagine nudge usage

Browse Source 
- scale appropriately for unrestricted sizes
- don't behave weirdly for very large rooms
This commit is contained in:
Wolfgang Witt 2021-03-16 18:18:40 +01:00 committed by Gregor Kleen
parent ff5d27cdf3
commit 3ab8be2e0d
1 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -244,7 +244,7 @@ data ExamAutoOccurrenceException
| ExamAutoOccurrenceExceptionNotEnoughSpace
| ExamAutoOccurrenceExceptionNoUsers
| ExamAutoOccurrenceExceptionRoomTooSmall
deriving (Show, Generic, Typeable)
deriving (Show, Eq, Generic, Typeable)
instance Exception ExamAutoOccurrenceException
@ -291,7 +291,10 @@ 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 % fromIntegral m - eaocNudgeSize * fromIntegral (lineNudges k)
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
@ -437,7 +440,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
longestLine :: Natural
-- ^ For scaling costs
-- longest restricted line (or 1 if all unrestricted)
longestLine = maybe 1 maximum $ fromNullable restrictedLengths
longestLine = maybe numUnassignedUsers maximum $ fromNullable restrictedLengths
wordMap :: Map wordId Natural
wordMap = Map.fromListWith (+) wordLengths
@ -547,24 +550,24 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
widthCost :: Maybe lineId -> ExamOccurrenceCapacity -> Natural -> Extended Rational
widthCost l Unrestricted w
= Finite (fromIntegral w
- (fromIntegral extraUsers % List.genericLength unrestrictedLines)
- nudgeRatio * fromIntegral longestLine)^2
= Finite $ max 1 $ (fromIntegral w - sizeModifier * (fromIntegral extraUsers % List.genericLength unrestrictedLines)) ^ 2
where
nudgeRatio :: Rational
nudgeRatio = maybe 0 (fromIntegral . lineNudge) l * eaocNudgeSize
sizeModifier :: Rational
sizeModifier = 1 + maybe 0 (fromIntegral . lineNudge) l * eaocNudgeSize
widthCost l (Restricted lineWidth) w
| lineWidth < w = PosInf
| otherwise = Finite (max 1 . abs $ ((fromIntegral w % fromIntegral lineWidth) - optimumRatio') * fromIntegral longestLine) ^ 2
| otherwise = Finite $ max 1 $ ((fromIntegral w / nudgedWidth - optimumRatio) * fromIntegral longestLine) ^ 2
where
optimumRatio' :: Rational
optimumRatio' = maybe 0 (fromIntegral . lineNudge) l * eaocNudgeSize + optimumRatio
nudgedWidth :: Rational
nudgedWidth = max 1 $ sizeModifier * fromIntegral lineWidth
sizeModifier :: Rational
sizeModifier = 1 + maybe 0 (fromIntegral . lineNudge) l * eaocNudgeSize
charCost :: [CI Char] -> [CI Char] -> Extended Rational
charCost pA pB = Finite (max 1 $ List.genericLength (pA `lcp` pB) * eaocFinenessCost * fromIntegral longestLine) ^ 2
where
longestLine :: Natural
longestLine = maybe 1 maximum $ fromNullable $ catMaybes
longestLine = maybe (sum $ fromIntegral . length <$> users') maximum $ fromNullable $ catMaybes
$ view (_2 . _examOccurrenceCapacityIso) <$> occurrences''