From eaf245beaaa1f739d6b857712f1e4ea5b53e7c82 Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Mon, 18 Jan 2021 14:48:26 +0100
Subject: [PATCH] fix: examAutoOccurence no longer user >100% of a room

---
 src/Handler/Utils/Exam.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index 490b8cd9c..00d3a90b4 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -396,19 +396,23 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
           minima <- ST.newListArray (0, Map.size wordMap) $ 0 : repeat PosInf :: forall s. ST s (STArray s Int (Extended Rational))
           breaks <- ST.newArray (0, Map.size wordMap) 0 :: forall s. ST s (STUArray s Int Int)
 
-          forM_ (Array.range (0, Map.size wordMap)) $ \i' -> do
-            let go i j
+          -- find current line
+          let
+            walkBack 0   = return 0
+            walkBack i'' = fmap succ $ walkBack =<< ST.readArray breaks i''
+          -- calculate line breaks
+          forM_ (Array.range (0, Map.size wordMap)) $ \i -> do
+            let go j
                   | j <= Map.size wordMap = do
-                    let
-                      walkBack 0   = return 0
-                      walkBack i'' = fmap succ $ walkBack =<< ST.readArray breaks i''
                     lineIx <- walkBack i
+                    -- identifier and potential width of current line
                     let (l, potWidth)
                           | lineIx >= 0
                           , lineIx < length lineLengths
                           = over _1 Just $ lineLengths List.!! lineIx
                           | otherwise
                           = (Nothing, 0)
+                        -- cumulative width for words [i,j), no whitespace required
                         w = offsets Array.! j - offsets Array.! i
                     prevMin <- ST.readArray minima i
                     let cost = prevMin + widthCost l potWidth w + breakCost'
@@ -431,12 +435,13 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                       when (cost < minCost) $ do
                         ST.writeArray minima j cost
                         ST.writeArray breaks j i
-                      go i' $ succ j
+                      go $ succ j
                   | otherwise = return ()
-             in go i' $ succ i'
+             in go $ succ i
             -- traceM . show . map (fmap (fromRational :: Rational -> Centi)) =<< ST.getElems minima
             -- traceM . show =<< ST.getElems breaks
 
+          usedLines <- walkBack $ Map.size wordMap
           let accumResult lineIx j (accCost, accMap) = do
                 i <- ST.readArray breaks j
                 accCost' <- (+) accCost <$> ST.readArray minima j
@@ -445,7 +450,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
                 if
                   | i > 0     -> accumResult (succ lineIx) i (accCost', accMap')
                   | otherwise -> return (accCost', accMap')
-              lineIxs = reverse $ map (view _1) lineLengths
+              lineIxs = reverse $ map (view _1) $ take usedLines lineLengths
            in accumResult 0 (Map.size wordMap) (0, [])