chore: introduce a real cost function for unrestricted rooms

src/Handler/Utils/Exam.hs

@@ -281,10 +281,6 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
              unrestrictedOccurrences :: [ExamOccurrenceId]
              (unrestrictedOccurrences, restrictedOccurrences)
                 = second Map.fromList $ partitionRestricted ([], []) occurrences''
-             partitionRestricted :: ([a], [(a, Natural)]) -> [(a,ExamOccurrenceCapacity)] -> ([a], [(a, Natural)])
-             partitionRestricted acc []                   = acc
-             partitionRestricted acc ((a,Unrestricted):t) = partitionRestricted (over _1 (a:) acc) t
-             partitionRestricted acc ((a,Restricted n):t) = partitionRestricted (over _2 ((a,n):) acc) t
              -- reduce available space until to excess space is left while keeping the filling ratio as equal as possible
              decreaseBiggestOutlier :: Natural -> Map ExamOccurrenceId Natural -> Map ExamOccurrenceId Natural
              decreaseBiggestOutlier 0 currentOccurrences = currentOccurrences
@@ -396,6 +392,11 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
           = ( accSize <> occSize
             , occ : accOccs
             )
+    
+    partitionRestricted :: ([a], [(a, Natural)]) -> [(a,ExamOccurrenceCapacity)] -> ([a], [(a, Natural)])
+    partitionRestricted acc []                   = acc
+    partitionRestricted acc ((a,Unrestricted):t) = partitionRestricted (over _1 (a:) acc) t
+    partitionRestricted acc ((a,Restricted n):t) = partitionRestricted (over _2 ((a,n):) acc) t
 
     distribute :: forall wordId lineId cost.
                   _
@@ -419,10 +420,32 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                                  Finite c -> Just (fromInteger $ round c, result)
                                  _other   -> Nothing
       where
+        restrictedLines :: [(lineId, Natural)]
+        unrestrictedLines :: [lineId]
+        (unrestrictedLines, restrictedLines) = partitionRestricted ([], []) lineLengths
+
+        -- reorder so unrestricted lines are at the end and my be left empty
+        lineLengths' :: [(lineId, ExamOccurrenceCapacity)]
+        lineLengths' = (over _2 Restricted <$> restrictedLines) ++ ((, Unrestricted) <$> unrestrictedLines)
+
+        restrictedLengths :: [Natural]
+        restrictedLengths = view _2 <$> restrictedLines
+
+        restrictedSpace :: Natural
+        restrictedSpace = sum restrictedLengths
+
+        extraCapacity :: Natural
+        extraCapacity
+          | restrictedSpace > numUnassignedUsers = restrictedSpace - numUnassignedUsers
+          | otherwise = 0
+          where
+            numUnassignedUsers :: Natural
+            numUnassignedUsers = sum $ view _2 <$> wordLengths
+        
         longestLine :: Natural
         -- ^ For scaling costs
-        longestLine = maximum $ impureNonNull $ catMaybes $ view (_2 . _examOccurrenceCapacityIso) <$> lineLengths
+        -- longest restricted line (or 1 if all unrestricted)
-        -- only evaluated for restricted lines, so impureNonNull is fine here
+        longestLine = maybe 1 maximum $ fromNullable restrictedLengths
 
         wordMap :: Map wordId Natural
         wordMap = Map.fromListWith (+) wordLengths
@@ -470,8 +493,8 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                     -- identifier and potential width of current line
                     let (l, potWidth)
                           | lineIx >= 0
-                          , lineIx < length lineLengths
+                          , lineIx < length lineLengths'
-                          = over _1 Just $ lineLengths List.!! lineIx
+                          = over _1 Just $ lineLengths' List.!! lineIx
                           | otherwise
                           = (Nothing, Restricted 0)
                         -- cumulative width for words [i,j), no whitespace required
@@ -479,7 +502,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                     prevMin <- ST.readArray minima i
                     let cost = prevMin + widthCost l potWidth w + breakCost'
                         remainingWords = offsets Array.! Map.size wordMap - offsets Array.! i
-                        remainingLineSpace = foldMap (view _2) $ drop lineIx lineLengths
+                        remainingLineSpace = foldMap (view _2) $ drop lineIx lineLengths'
                         breakCost'
                           | Restricted remainingWords > remainingLineSpace
                           = PosInf 
@@ -516,19 +539,24 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                 if i > 0
                   then accumResult (succ lineIx) i (accCost', accMap')
                   else return (accCost', accMap')
-              lineIxs = reverse $ map (view _1) $ take usedLines lineLengths
+              lineIxs = reverse $ map (view _1) $ take usedLines lineLengths'
            in accumResult 0 (Map.size wordMap) (0, [])
 
+        optimumRatio :: Rational
+        optimumRatio = ((%) `on` fromIntegral . max 1 . sum) (map (view _2) wordLengths) restrictedLengths
 
         widthCost :: Maybe lineId -> ExamOccurrenceCapacity -> Natural -> Extended Rational
-        widthCost _l Unrestricted _w = 0
+        widthCost l Unrestricted w
+          = Finite ((fromIntegral w - fromIntegral extraCapacity) % List.genericLength unrestrictedLines
+                    - nudgeRatio * fromIntegral longestLine)^2 
+          where
+            nudgeRatio :: Rational
+            nudgeRatio = 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
           where
-            optimumRatio = ((%) `on` fromIntegral . max 1 . sum) (map (view _2) wordLengths) restrictedLengths
+            optimumRatio' :: Rational
-            restrictedLengths = catMaybes $ view (_2 . _examOccurrenceCapacityIso) <$> lineLengths
-            -- ^ might be empty, so we need max 1 after sum!
             optimumRatio' = maybe 0 (fromIntegral . lineNudge) l * eaocNudgeSize + optimumRatio
 
     charCost :: [CI Char] -> [CI Char] -> Extended Rational