diff --git a/ghci.sh b/ghci.sh
index ab5cf41bd..750d384b8 100755
--- a/ghci.sh
+++ b/ghci.sh
@@ -20,4 +20,4 @@ if [[ -d .stack-work-ghci ]]; then
     trap move-back EXIT
 fi
 
-stack ghci --flag uniworx:dev --flag uniworx:library-only ${@:-uniworx:lib}
+stack ghci --flag uniworx:dev --flag uniworx:library-only --ghci-options -fobject-code ${@:-uniworx:lib}
diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 81bbd36ff..f31a52272 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -1267,6 +1267,7 @@ BreadcrumbExternalExamGrades: Prüfungsleistungen
 BreadcrumbExternalExamStaffInvite: Einladung zum Prüfer
 BreadcrumbParticipantsList: Kursteilnehmerlisten
 BreadcrumbParticipants: Kursteilnehmerliste
+BreadcrumbExamAutoOccurrence: Automatische Raumverteilung
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
@@ -1574,7 +1575,7 @@ ExamBonusRoundNonPositive: Vielfaches, auf das gerundet werden soll, muss positi
 ExamBonusRoundTip: Bonuspunkte werden kaufmännisch auf ein Vielfaches der angegeben Zahl gerundet.
 
 ExamAutomaticOccurrenceAssignment: Termin- bzw. Raumzuteilung
-ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden, sich selbstständig einen Raum bzw. Termin aussuchen dürfen oder manuell durch Kursverwalter zugeteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
+ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden, sich selbstständig einen Raum bzw. Termin aussuchen dürfen oder manuell durch Kursverwalter zugeteilt werden? Die automatische Verteilung muss von einem Kursverwalter ausgelöst werden und geschieht nicht mit Ablauf einer Frist o.Ä.. Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist somit immer möglich.
 ExamOccurrenceRule: Verfahren
 ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
 ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung
@@ -2270,4 +2271,15 @@ ExternalExamUserMustBeStaff: Sie selbst müssen stets assoziierte Person sein, f
 ExternalExamCourseExists: Der angegebene Kurs existiert im System. Prüfungen sollten daher direkt beim Kurs (statt extern) hinterlegt werden.
 ExternalExamExists coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ existiert bereits.
 ExternalExamCreated coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich angelegt.
-ExternalExamEdited coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich bearbeitet.
\ No newline at end of file
+ExternalExamEdited coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich bearbeitet.
+
+ExamAutoOccurrenceMinimizeRooms: Verwendete Räume minimieren
+ExamAutoOccurrenceMinimizeRoomsTip: Soll, für die Aufteilung, die Liste an Räumen zunächst reduziert werden, sodass nur so wenige Räume verwendet werden, wie nötig (größte zuerst)?
+ExamAutoOccurrenceOccurrencesChangedInFlight: Raumliste wurde verändert
+ExamAutoOccurrenceParticipantsAssigned num@Int64: Verteilungstabelle erfolgreich gespeichert und #{num} Teilnehmer zugewiesen
+TitleExamAutoOccurrence tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{tid}-#{ssh}-#{csh} #{examn}: Automatische Raumverteilung
+BtnExamAutoOccurrenceCalculate: Verteilung berechnen
+BtnExamAutoOccurrenceAccept: Verteilung akzeptieren
+ExamRoomMappingSurname: Nachnamen beginnend mit
+ExamRoomMappingMatriculation: Matrikelnummern endend in
+ExamRoomLoad: Auslastung
\ No newline at end of file
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index cfac175fd..1f697b94d 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -1572,7 +1572,7 @@ ExamBonusRoundNonPositive: Rounding multiple must be positive and greater than z
 ExamBonusRoundTip: Bonus points are rounded commercially to a multiple of the given number
 
 ExamAutomaticOccurrenceAssignment: Selection of occurrences/rooms for/by participants
-ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms, should they instead be permitted to autonomously choose an occurrence/a room, or should they be assigned to occurrences/rooms manually by course administrators? Manipulation of the distribution and manually assigning participants remains possible.
+ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms, should they instead be permitted to autonomously choose an occurrence/room, or should they be assigned to occurrences/rooms manually by course administrators? Automatic distribution needs to be triggered by a course administrator. It is not done automatically at a predefined time. Thus manipulation of the distribution and manually assigning participants remains possible.
 ExamOccurrenceRule: Procedure
 ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
 ExamRoomManual': No automatic or autonomous assignment
diff --git a/models/exams.model b/models/exams.model
index 5baa6e711..2bdc42cda 100644
--- a/models/exams.model
+++ b/models/exams.model
@@ -4,6 +4,7 @@ Exam
   gradingRule ExamGradingRule Maybe
   bonusRule ExamBonusRule Maybe
   occurrenceRule ExamOccurrenceRule
+  examOccurrenceMapping (ExamOccurrenceMapping ExamOccurrenceName) Maybe
   visibleFrom UTCTime Maybe
   registerFrom UTCTime Maybe
   registerTo UTCTime Maybe
diff --git a/package.yaml b/package.yaml
index f8d437c20..86e2ff3c8 100644
--- a/package.yaml
+++ b/package.yaml
@@ -138,6 +138,7 @@ dependencies:
   - prometheus-metrics-ghc
   - wai-middleware-prometheus
   - extended-reals
+  - rfc5051
 
 other-extensions:
   - GeneralizedNewtypeDeriving
@@ -182,6 +183,8 @@ default-extensions:
   - DeriveGeneric
   - DeriveLift
   - DeriveFunctor
+  - DeriveFoldable
+  - DeriveTraversable
   - DerivingStrategies
   - DerivingVia
   - DataKinds
diff --git a/routes b/routes
index 8bf60981c..52f9bad23 100644
--- a/routes
+++ b/routes
@@ -188,6 +188,7 @@
     /register                   ERegisterR         POST        !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
     /register/#ExamOccurrenceName ERegisterOccR    POST        !exam-occurrence-registrationANDtimeANDcapacityANDcourse-registeredAND¬exam-occurrence-registered !exam-occurrence-registrationANDtimeANDexam-occurrence-registeredAND¬exam-result
     /grades                     EGradesR       GET POST        !exam-office
+    /assign-occurrences         EAutoOccurrenceR   POST
   /apps                         CApplicationsR GET POST
   !/apps/files                  CAppsFilesR    GET
   /apps/#CryptoFileNameCourseApplication CourseApplicationR:
diff --git a/src/Database/Persist/Class/Instances.hs b/src/Database/Persist/Class/Instances.hs
index 8fc9eb20b..193ea1f16 100644
--- a/src/Database/Persist/Class/Instances.hs
+++ b/src/Database/Persist/Class/Instances.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableInstances, GeneralizedNewtypeDeriving #-}
 
 module Database.Persist.Class.Instances
   (
@@ -10,12 +10,15 @@ import ClassyPrelude
 import Database.Persist.Class
 import Database.Persist.Types (HaskellName, DBName, PersistValue)
 import Database.Persist.Types.Instances ()
+import Database.Persist.Sql
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
 
 import qualified Data.Map as Map
 
+import Data.Aeson (ToJSONKey, FromJSONKey)
+
 
 instance PersistEntity record => Hashable (Key record) where
   hashWithSalt s = hashWithSalt s . toPersistValue
@@ -34,3 +37,7 @@ uniqueToMap = fmap Map.fromList $ zip <$> persistUniqueToFieldNames <*> persistU
 
 instance PersistEntity record => Eq (Unique record) where
   (==) = (==) `on` uniqueToMap
+
+
+deriving newtype instance ToJSONKey (BackendKey SqlBackend)
+deriving newtype instance FromJSONKey (BackendKey SqlBackend)
diff --git a/src/Foundation.hs b/src/Foundation.hs
index a4d40b60e..184cedf7c 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1923,6 +1923,7 @@ instance YesodBreadcrumbs UniWorX where
     EInviteR   -> i18nCrumb MsgBreadcrumbExamParticipantInvite . Just $ CExamR tid ssh csh examn EShowR
     ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
     ERegisterOccR _occn -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
+    EAutoOccurrenceR -> i18nCrumb MsgBreadcrumbExamAutoOccurrence . Just $ CExamR tid ssh csh examn EUsersR
 
   breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
     TUsersR  -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 6580c90f4..ca916130c 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -11,3 +11,4 @@ import Handler.Exam.Edit               as Handler.Exam
 import Handler.Exam.Show               as Handler.Exam
 import Handler.Exam.Users              as Handler.Exam
 import Handler.Exam.AddUser            as Handler.Exam
+import Handler.Exam.AutoOccurrence     as Handler.Exam
diff --git a/src/Handler/Exam/AutoOccurrence.hs b/src/Handler/Exam/AutoOccurrence.hs
new file mode 100644
index 000000000..908449351
--- /dev/null
+++ b/src/Handler/Exam/AutoOccurrence.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Handler.Exam.AutoOccurrence
+  ( examAutoOccurrenceCalculateWidget
+  , postEAutoOccurrenceR
+  ) where
+
+import Import
+import Handler.Utils
+import Handler.Utils.Exam
+
+import qualified Data.Map as Map
+
+import qualified Database.Esqueleto as E
+import Database.Persist.Sql (updateWhereCount)
+
+
+newtype ExamAutoOccurrenceCalculateForm = ExamAutoOccurrenceCalculateForm
+  { eaofConfig :: ExamAutoOccurrenceConfig
+  } deriving stock   (Eq, Ord, Read, Show, Generic, Typeable)
+    deriving newtype (Default)
+
+data ExamAutoOccurrenceAcceptForm = ExamAutoOccurrenceAcceptForm
+  { eaofMapping    :: Maybe (ExamOccurrenceMapping ExamOccurrenceId)
+  , eaofAssignment :: Map UserId (Maybe ExamOccurrenceId)
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  } ''ExamAutoOccurrenceAcceptForm
+
+data ExamAutoOccurrenceButton
+  = BtnExamAutoOccurrenceCalculate
+  | BtnExamAutoOccurrenceAccept
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe ExamAutoOccurrenceButton
+instance Finite ExamAutoOccurrenceButton
+
+nullaryPathPiece ''ExamAutoOccurrenceButton $ camelToPathPiece' 4
+
+embedRenderMessage ''UniWorX ''ExamAutoOccurrenceButton id
+instance Button UniWorX ExamAutoOccurrenceButton where
+  btnClasses _ = [BCIsButton, BCPrimary]
+
+
+examAutoOccurrenceCalculateForm :: ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm
+examAutoOccurrenceCalculateForm ExamAutoOccurrenceCalculateForm{ eaofConfig }
+  = identifyForm FIDExamAutoOccurrenceCalculate . renderAForm FormStandard $ ExamAutoOccurrenceCalculateForm <$> eaocForm
+  where
+    eaocForm = 
+      (set _eaocMinimizeRooms <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just $ eaofConfig ^. _eaocMinimizeRooms))
+      <*> pure def
+
+examAutoOccurrenceAcceptForm :: Maybe ExamAutoOccurrenceAcceptForm -> Form ExamAutoOccurrenceAcceptForm
+examAutoOccurrenceAcceptForm confirmData = identifyForm FIDExamAutoOccurrenceConfirm $ \html -> do
+  (confirmDataRes, confirmDataView) <- mreq secretJsonField "" confirmData
+  (acceptRes, acceptView) <- buttonForm' [BtnExamAutoOccurrenceAccept] mempty
+  return (acceptRes *> confirmDataRes, toWidget html <> fvInput confirmDataView <> acceptView)
+
+
+examAutoOccurrenceCalculateWidget :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Widget
+examAutoOccurrenceCalculateWidget tid ssh csh examn = do
+  (formView, formEncoding) <- liftHandler . generateFormPost $ examAutoOccurrenceCalculateForm def
+  
+  wrapForm' BtnExamAutoOccurrenceCalculate formView def
+    { formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR
+    , formEncoding
+    }
+      
+
+postEAutoOccurrenceR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
+postEAutoOccurrenceR tid ssh csh examn = do
+  (Entity eId Exam{ examOccurrenceRule }, occurrences) <- runDB $ do
+    exam@(Entity eId _) <- fetchExam tid ssh csh examn
+    occurrences <- selectList [ ExamOccurrenceExam ==. eId ] [ Asc ExamOccurrenceName ]
+    return (exam, occurrences)
+  
+  
+  ((calculateRes, _), _) <- runFormPost $ examAutoOccurrenceCalculateForm def
+
+  calcResult <- formResultMaybe calculateRes $ \ExamAutoOccurrenceCalculateForm{..} -> runDB $ do
+    participants <- E.select . E.from $ \(registration `E.InnerJoin` user) -> do
+      E.on $ registration E.^. ExamRegistrationUser E.==. user E.^. UserId
+      E.where_ $ registration E.^. ExamRegistrationExam E.==. E.val eId
+      return (user, registration)
+    let participants' = Map.fromList $ do
+          (Entity uid userRec, Entity _ ExamRegistration{..}) <- participants
+          return (uid, (userRec, examRegistrationOccurrence))
+        occurrences' = Map.fromList $ map (\(Entity eoId ExamOccurrence{..}) -> (eoId, examOccurrenceCapacity)) occurrences
+        (eaofMapping, eaofAssignment) = examAutoOccurrence eId examOccurrenceRule eaofConfig occurrences' participants'
+    return $ Just ExamAutoOccurrenceAcceptForm{..}
+
+  ((confirmRes, confirmView), confirmEncoding) <- runFormPost $ examAutoOccurrenceAcceptForm calcResult
+  let confirmWidget = wrapForm confirmView def
+        { formAction   = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR
+        , formEncoding = confirmEncoding
+        , formSubmit   = FormNoSubmit
+        }
+
+  formResult confirmRes $ \ExamAutoOccurrenceAcceptForm{..} -> do
+    Sum assignedCount <- runDB $ do
+      let eaofMapping'' :: Maybe (Maybe (ExamOccurrenceMapping ExamOccurrenceName))
+          eaofMapping'' = (<$> eaofMapping) . traverseExamOccurrenceMapping $ \eoId -> case filter ((== eoId) . entityKey) occurrences of
+            [Entity _ ExamOccurrence{..}] -> Just examOccurrenceName
+            _other -> Nothing
+      eaofMapping' <- case eaofMapping'' of
+        Nothing        -> return Nothing
+        Just  Nothing  -> invalidArgsI [MsgExamAutoOccurrenceOccurrencesChangedInFlight]
+        Just (Just x ) -> return $ Just x
+      update eId [ ExamExamOccurrenceMapping =. eaofMapping' ]
+      fmap fold . iforM eaofAssignment $ \pid occ -> case occ of
+        Just _  -> Sum <$> updateWhereCount [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. pid, ExamRegistrationOccurrence ==. Nothing ] [ ExamRegistrationOccurrence =. occ ]
+        Nothing -> return mempty
+    addMessageI Success $ MsgExamAutoOccurrenceParticipantsAssigned assignedCount
+    redirect $ CExamR tid ssh csh examn EUsersR
+
+  ExamAutoOccurrenceAcceptForm{..} <- maybe (redirect $ CExamR tid ssh csh examn EUsersR) return calcResult
+
+  let heading = MsgTitleExamAutoOccurrence tid ssh csh examn
+      mappingWgt
+        = let occLoads :: Map ExamOccurrenceId Natural
+              occLoads = Map.fromListWith (+) . mapMaybe (\(_, mOcc) -> (, 1) <$> mOcc) $ Map.toList eaofAssignment
+
+              occLoad = fromMaybe 0 . flip Map.lookup occLoads
+
+              occMappingRule = examOccurrenceMappingRule <$> eaofMapping
+
+              loadProp curr max'
+                | max' /= 0 = MsgProportion (toMessage curr) (toMessage max') (toRational curr / toRational max')
+                | otherwise = MsgProportionNoRatio (toMessage curr) (toMessage max')
+
+              occMapping occId = examOccurrenceMappingDescriptionWidget <$> occMappingRule <*> (Map.lookup occId . examOccurrenceMappingMapping =<< eaofMapping)
+           in $(widgetFile "widgets/exam-occurrence-mapping")
+
+  siteLayoutMsg heading $ do
+    setTitleI heading
+    $(widgetFile "exam/auto-occurrence-confirm")
diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs
index 52d90559f..ae40a86c3 100644
--- a/src/Handler/Exam/Edit.hs
+++ b/src/Handler/Exam/Edit.hs
@@ -35,6 +35,7 @@ postEEditR tid ssh csh examn = do
         , examGradingRule      = efGradingRule
         , examBonusRule        = efBonusRule
         , examOccurrenceRule   = efOccurrenceRule
+        , examExamOccurrenceMapping = examExamOccurrenceMapping oldExam
         , examVisibleFrom      = efVisibleFrom
         , examRegisterFrom     = efRegisterFrom
         , examRegisterTo       = efRegisterTo
diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs
index d4e6582a7..7cbfdb32d 100644
--- a/src/Handler/Exam/New.hs
+++ b/src/Handler/Exam/New.hs
@@ -32,6 +32,7 @@ postCExamNewR tid ssh csh = do
         , examGradingRule                  = efGradingRule
         , examBonusRule                    = efBonusRule
         , examOccurrenceRule               = efOccurrenceRule
+        , examExamOccurrenceMapping        = Nothing
         , examVisibleFrom                  = efVisibleFrom
         , examRegisterFrom                 = efRegisterFrom
         , examRegisterTo                   = efRegisterTo
diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs
index e072b9e71..1bb67c713 100644
--- a/src/Handler/Exam/Show.hs
+++ b/src/Handler/Exam/Show.hs
@@ -145,6 +145,7 @@ getEShowR tid ssh csh examn = do
       showAchievedPoints = not $ null results
       showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == ExamRoomFifo)
       markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
+      showOccurrenceMappingColumn = examOccurrenceRuleAutomatic examOccurrenceRule && occurrenceAssignmentsShown && is _Just examExamOccurrenceMapping
 
   let heading = prependCourseTitle tid ssh csh $ CI.original examName
 
@@ -161,4 +162,7 @@ getEShowR tid ssh csh examn = do
 
       examBonusW :: ExamBonusRule -> Widget
       examBonusW bonusRule = $(widgetFile "widgets/bonusRule")
+
+      occurrenceMapping :: ExamOccurrenceName -> Maybe Widget
+      occurrenceMapping occName = examOccurrenceMappingDescriptionWidget <$> fmap examOccurrenceMappingRule examExamOccurrenceMapping <*> (fmap examOccurrenceMappingMapping examExamOccurrenceMapping >>= Map.lookup occName)
     $(widgetFile "exam-show")
diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs
index 39624ab04..eee9a53b0 100644
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@@ -11,6 +11,8 @@ import Handler.Utils.Exam
 import Handler.Utils.Users
 import Handler.Utils.Csv
 
+import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget)
+
 import Handler.ExamOffice.Exam (examCloseWidget)
 
 import qualified Database.Esqueleto as E
@@ -390,7 +392,7 @@ embedRenderMessage ''UniWorX ''ExamUserCsvException id
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
-  (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal, bonus) <- runDB $ do
+  (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, bonus) <- runDB $ do
     exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn
     examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
     bonus <- examBonus exam
diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index f4d1d32d9..9ccb492d4 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -1,12 +1,17 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+
 module Handler.Utils.Exam
   ( fetchExamAux
   , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam
   , examBonus, examBonusPossible, examBonusAchieved
   , examResultBonus, examGrade
+  , ExamAutoOccurrenceConfig
+  , eaocMinimizeRooms, eaocFinenessCost
+  , _eaocMinimizeRooms, _eaocFinenessCost
   , examAutoOccurrence
   ) where
 
-import Import.NoFoundation hiding (distribute)
+import Import.NoFoundation
 
 import Database.Persist.Sql (SqlBackendCanRead)
 import qualified Database.Esqueleto as E
@@ -26,7 +31,7 @@ import qualified Data.CaseInsensitive as CI
 
 import Control.Monad.Trans.Random.Lazy (evalRand)
 import System.Random (mkStdGen)
-import Control.Monad.Random.Class (weightedMay)
+import Control.Monad.Random.Class (weighted)
 import Control.Monad.ST (ST, runST)
 
 import Data.Array (Array)
@@ -40,9 +45,10 @@ import qualified Data.List as List
 
 import Data.ExtendedReal
 
-import qualified Data.Text as Text
 import qualified Data.Char as Char
 
+import qualified Data.RFC5051 as RFC5051
+
 
 fetchExamAux :: ( SqlBackendCanRead backend
                 , E.SqlSelect b a
@@ -184,17 +190,32 @@ examGrade Exam{..} mBonus (otoList -> results)
           where
             lowerBounds :: [(ExamGrade, Points)]
             lowerBounds = zip [Grade40, Grade37 ..] examGradingKey'
+
+data ExamAutoOccurrenceConfig = ExamAutoOccurrenceConfig
+  { eaocMinimizeRooms :: Bool
+  , eaocFinenessCost  :: Rational -- ^ Cost factor incentivising shorter common prefixes on breaks between rooms
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Default ExamAutoOccurrenceConfig where
+  def = ExamAutoOccurrenceConfig
+    { eaocMinimizeRooms = False
+    , eaocFinenessCost  = 0.2
+    }
+
+makeLenses_ ''ExamAutoOccurrenceConfig
         
 
 examAutoOccurrence :: forall seed.
                       Hashable seed
                    => seed
                    -> ExamOccurrenceRule
+                   -> ExamAutoOccurrenceConfig
                    -> Map ExamOccurrenceId Natural
                    -> Map UserId (User, Maybe ExamOccurrenceId)
                    -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
-examAutoOccurrence (hash -> seed) rule occurrences users
+examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
   | sum occurrences < usersCount
+    || sum occurrences <= 0
     || Map.null users
   = nullResult
   | otherwise
@@ -203,8 +224,8 @@ examAutoOccurrence (hash -> seed) rule occurrences users
         -> ( Nothing
            , flip Map.mapWithKey users $ \uid (_, mOcc)
                -> let randomOcc = flip evalRand (mkStdGen $ hashWithSalt seed uid) $
-                       weightedMay $ over _2 fromIntegral <$> occurrences'
-                   in mOcc <|> randomOcc
+                        weighted $ over _2 fromIntegral <$> occurrences'
+                   in Just $ fromMaybe randomOcc mOcc
            )
       _ | Just (postprocess -> (resMapping, result)) <- bestOption
           -> ( Just $ ExamOccurrenceMapping rule resMapping
@@ -221,38 +242,21 @@ examAutoOccurrence (hash -> seed) rule occurrences users
     users' = case rule of
       ExamRoomSurname
         -> Map.fromListWith Set.union
-           [ (map CI.mk $ unpack userSurname', Set.singleton uid)
+           [ (map CI.mk $ unpack userSurname, Set.singleton uid)
            | (uid, (User{..}, Nothing)) <- Map.toList users
-           , let userSurname' = Text.filter Char.isLetter userSurname
-           , not $ null userSurname'
+           , not $ null userSurname
            ]
       ExamRoomMatriculation
         -> let matrUsers
                  = Map.fromListWith Set.union
                    [ (map CI.mk $ unpack matriculation', Set.singleton uid)
                    | (uid, (User{..}, Nothing)) <- Map.toList users
-                   , let Just matriculation' = Text.filter Char.isDigit <$> userMatrikelnummer
+                   , let Just matriculation' = userMatrikelnummer
                    , not $ null matriculation'
                    ]
             in Map.mapKeysWith Set.union (take . F.minimum . Set.map length $ Map.keysSet matrUsers) matrUsers
       _ -> Map.singleton [] $ Map.keysSet users
 
-    usersGroups :: Natural -- ^ fineness
-                -> Map [CI Char] (Set UserId)
-    -- ^ Partition users into monotonously finer
-    usersGroups (fromIntegral -> c) = Map.mapKeysWith Set.union restr users' 
-      where
-        restr = case rule of
-          ExamRoomSurname
-            -> take c
-          ExamRoomMatriculation
-            -> reverse . take c . reverse
-          _other
-            -> id
-
-    maximumFineness :: Natural
-    -- ^ Fineness at which `usersGroups` becomes constant
-    maximumFineness = fromIntegral . F.maximum . Set.map length $ Map.keysSet users'
 
     occurrences' :: [(ExamOccurrenceId, Natural)]
     -- ^ Minimise number of occurrences used
@@ -262,6 +266,8 @@ examAutoOccurrence (hash -> seed) rule occurrences users
     -- If a single occurrence can accomodate all participants, pick the one with
     -- the least capacity
     occurrences'
+      | not eaocMinimizeRooms
+      = Map.toList occurrences
       | Just largeEnoughs <- fromNullable . filter ((>= usersCount) . view _2) $ Map.toList occurrences
       = pure $ minimumBy (comparing $ view _2) largeEnoughs
       | otherwise
@@ -278,24 +284,12 @@ examAutoOccurrence (hash -> seed) rule occurrences users
             , occ : accOccs
             )
 
-    largestOccurrence :: Num a => a
-    largestOccurrence = fromIntegral . maximum . mapNonNull (view _2) $ impureNonNull occurrences'
-
-    finenessCost :: Natural -> Natural
-    finenessCost x = round (finenessConst * largestOccurrence) * fromIntegral (length occurrences') * x * x
-      where
-        finenessConst :: Rational
-        -- ^ Cost (scaled to proportion of occurrence) of having higher fineness
-        finenessConst = 1 % 5 -- TODO: tweak
-
-
     distribute :: forall wordId lineId cost.
-                  ( Num cost
-                  , Ord wordId, Ord lineId
-                  )
+                  _
                => [(wordId, Natural)]
                -> [(lineId, Natural)]
-               -> Maybe (cost, Map lineId (Set wordId))
+               -> (wordId -> wordId -> Extended Rational)
+               -> Maybe (cost, [(lineId, [wordId])])
     -- ^ Distribute the given items (@wordId@s) with associated size in
     -- contiguous blocks into the given buckets (@lineId@s) such that they are
     -- filled as evenly as possible (proportionally)
@@ -303,8 +297,8 @@ examAutoOccurrence (hash -> seed) rule occurrences users
     -- Return a cost scaled to item-size squared
     --
     -- See <https://xxyxyz.org/line-breaking/> under \"Shortest Path\"
-    distribute wordLengths lineLengths
-      | null wordLengths = Just (0, Map.empty)
+    distribute wordLengths lineLengths breakCost
+      | null wordLengths = Just (0, [ (l, []) | (l, _) <- lineLengths ])
       | null lineLengths = Nothing
       | otherwise        = let (cost, result) = distribute'
                             in case cost of
@@ -344,7 +338,7 @@ examAutoOccurrence (hash -> seed) rule occurrences users
 
             bounds = (0, Map.size wordMap)
 
-        distribute' :: (Extended Rational, Map lineId (Set wordId))
+        distribute' :: (Extended Rational, [(lineId, [wordId])])
         distribute' = runST $ do
           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)
@@ -363,7 +357,22 @@ examAutoOccurrence (hash -> seed) rule occurrences users
                           | otherwise
                           = 0
                         w = offsets Array.! j - offsets Array.! i
-                    cost <- (+) (widthCost potWidth w) <$> ST.readArray minima i
+                    prevMin <- ST.readArray minima i
+                    let cost = prevMin + widthCost potWidth w + breakCost'
+                        breakCost'
+                          | j < Map.size wordMap
+                          , j > 0
+                          = breakCost (wordIx # pred j) (wordIx # j)
+                          | otherwise
+                          = 0
+                    traceM $ show ( i
+                                  , j
+                                  , potWidth
+                                  , w
+                                  , (fromRational :: Rational -> Centi) <$> prevMin
+                                  , (fromRational :: Rational -> Centi) <$> widthCost potWidth w
+                                  , (fromRational :: Rational -> Centi) <$> breakCost'
+                                  )
                     when (isFinite cost) $ do
                       minCost <- ST.readArray minima j
                       when (cost < minCost) $ do
@@ -372,66 +381,119 @@ examAutoOccurrence (hash -> seed) rule occurrences users
                       go i' $ succ j
                   | otherwise = return ()
              in go i' $ succ i'
+            traceM . show . map (fmap (fromRational :: Rational -> Centi)) =<< ST.getElems minima
             traceM . show =<< ST.getElems breaks
 
           let accumResult lineIx j (accCost, accMap) = do
                 i <- ST.readArray breaks j
                 accCost' <- (+) accCost <$> ST.readArray minima j
-                traceM $ show (accCost', lineIx, [i .. pred j])
-                let accMap' = Map.insertWith Set.union (lineIxs List.!! lineIx) (Set.fromList $ map (review wordIx) [i .. pred j]) accMap
+                traceM $ show ((fromRational :: Rational -> Centi) <$> accCost', lineIx, (i, pred j))
+                let accMap' = (lineIxs List.!! lineIx, map (review wordIx) [i .. pred j]) : accMap
                 if
                   | i > 0     -> accumResult (succ lineIx) i (accCost', accMap')
                   | otherwise -> return (accCost', accMap')
               lineIxs = reverse $ map (view _1) lineLengths
-           in accumResult 0 (Map.size wordMap) (0, Map.empty)
+           in accumResult 0 (Map.size wordMap) (0, [])
                 
 
         widthCost :: Natural -> Natural -> Extended Rational
         widthCost lineWidth w
           | lineWidth < w = PosInf
-          | otherwise = Finite (((fromIntegral lineWidth % fromIntegral w) - optimumRatio) * fromIntegral longestLine) ^ 2
+          | otherwise = Finite (max 1 . abs $ ((fromIntegral w % fromIntegral lineWidth) - optimumRatio) * fromIntegral longestLine) ^ 2
           where
-            optimumRatio = ((%) `on` fromIntegral . sum) (map (view _2) lineLengths) (map (view _2) wordLengths)
+            optimumRatio = ((%) `on` fromIntegral . sum) (map (view _2) wordLengths) (map (view _2) lineLengths)
 
+    charCost :: [CI Char] -> [CI Char] -> Extended Rational
+    charCost pA pB = Finite (max 1 $ List.genericLength (pA `lcp` pB) * eaocFinenessCost * fromIntegral longestLine) ^ 2
+      where
+        longestLine = maximum . mapNonNull (view _2) $ impureNonNull occurrences'
 
-    options :: [(Natural, (Natural, Map ExamOccurrenceId (Set [CI Char])))]
-    options = do
-      fineness <- [0..maximumFineness]
-
-      let usersGroups' = fromIntegral . Set.size <$> usersGroups fineness
-
-      traceM $ show usersGroups'
-      traceM . show $ map snd occurrences'
   
-      -- The algorithm used in `distribute` produces no usable result if the
-      -- situation occurs, that a single item does not fit within a bucket.
-      -- In a naive attempt to prevent this we ensure that all items fit into
-      -- all buckets.
-      guard . (\(fromIntegral -> maxSize) -> all ((>= maxSize) . view _2) occurrences') . maybe 0 maximum $ fromNullable usersGroups'
+    lcp :: Eq a => [a] -> [a] -> [a]
+    -- ^ Longest common prefix
+    lcp [] _ = []
+    lcp _ [] = []
+    lcp (a:as) (b:bs)
+      | a == b    = a:lcp as bs
+      | otherwise = []
 
-      let
-        packets :: [([CI Char], Natural)]
-        packets = Map.toAscList usersGroups'
-      (resultCost, result) <- hoistMaybe $ distribute packets occurrences'
+    bestOption :: Maybe [(ExamOccurrenceId, [[CI Char]])]
+    bestOption = do
+      (_cost, res) <- distribute (sortBy (RFC5051.compareUnicode `on` toListOf (_1 . folded . to CI.foldedCase)) . Map.toAscList $ fromIntegral . Set.size <$> users') occurrences' charCost
 
-      traceM $ show (fineness, finenessCost fineness, resultCost)
-      traceM . show . map (foldMap $ \prefix -> Sum $ usersGroups' Map.! prefix) $ Map.elems result
-  
-      return (fineness, (resultCost, result))
-    bestOption :: Maybe (Map ExamOccurrenceId (Set [CI Char]))
-    bestOption = options
-      & over _tail (takeWhile $ \(fineness, (resCost, _)) -> finenessCost fineness <= resCost)
-      & map (view $ _2 . _2)
-      & fmap last . fromNullable
+      -- traceM $ show cost
 
-    postprocess :: Map ExamOccurrenceId (Set [CI Char])
-                -> ( [(ExamOccurrenceId, [CI Char])]
+      return res
+
+    postprocess :: [(ExamOccurrenceId, [[CI Char]])]
+                -> ( Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription)
                    , Map UserId (Maybe ExamOccurrenceId)
                    )
     postprocess result = (resultAscList, resultUsers)
       where
-        resultAscList = sortOn (view _2) . map (over _2 Set.findMax) $ Map.toList result
+        resultAscList = Map.fromListWith Set.union $ accRes (pure <$> Set.lookupMin rangeAlphabet) result
+          where
+            accRes _ [] = []
+            accRes prevEnd ((occA, nsA) : (occB, nsB) : xs)
+              | Just minA <- prevEnd <|> preview _head nsA
+              , Just maxA <- nsA ^? _last
+              , Just minB <- nsB ^? _head
+              = let common = maxA `lcp` minB
+                    mayRange' = mayRange . max 1 . succ $ length common
+                    suffA = CI.foldedCase <$> drop (length common) maxA
+                    suffB = CI.foldedCase <$> drop (length common) minB
+                 in if
+                  | mayRange (succ $ length common) maxA
+                  , mayRange (succ $ length common) minA
+                  , mayRange (succ $ length common) minB
+                  , firstA : _ <- suffA
+                  , firstB : _ <- suffB
+                    -> let break' = (occSize occA * Char.ord firstA + occSize occB * Char.ord firstB) % (occSize occA + occSize occB)
+                             & floor
+                             & Char.chr
+                             & Char.toUpper
+                             & CI.mk
+                             & pure
+                             & (common ++)
+                           succBreak = fmap reverse . go $ reverse break'
+                             where
+                               go [] = Nothing
+                               go (c:cs)
+                                 | c' <- CI.map succ c
+                                 , c' `Set.member` rangeAlphabet
+                                 = Just $ c' : cs
+                                 | otherwise
+                                 = go cs
+                        in (occA, Set.insert (ExamOccurrenceMappingRange minA break') . Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ length common)) . Set.filter (not . mayRange') $ Set.fromList nsA) : accRes succBreak ((occB, nsB) : xs)
+                  | otherwise
+                    -> (occA, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ length common)) $ Set.fromList nsA) : accRes prevEnd ((occB, nsB) : xs)
+              | null nsA
+              = accRes prevEnd $ (occB, nsB) : xs
+              | otherwise -- null nsB
+              = accRes prevEnd $ (occA, nsA) : xs
+            accRes prevEnd [(occZ, nsZ)]
+              | Just minAlpha <- Set.lookupMin rangeAlphabet
+              , Just maxAlpha <- Set.lookupMax rangeAlphabet
+              , minZ <- fromMaybe (pure minAlpha) prevEnd
+              = let commonLength = max 1 $ length minZ
+                 in pure (occZ, Set.insert (ExamOccurrenceMappingRange minZ $ replicate commonLength maxAlpha) . Set.map (ExamOccurrenceMappingSpecial . take commonLength) . Set.filter (not . mayRange commonLength) $ Set.fromList nsZ)
+              | otherwise
+              = pure (occZ, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ maybe 0 length prevEnd)) $ Set.fromList nsZ)
         resultUsers = Map.fromList $ do
-          (occId, buckets) <- Map.toList result
-          user <- Set.toList $ foldMap (\b -> foldMap snd . filter (\(b', _) -> b `List.isPrefixOf` b') $ Map.toList users') buckets
+          (occId, buckets) <- result
+          user <- Set.toList $ foldMap (\b -> foldMap snd . filter (\(b', _) -> b == b') $ Map.toList users') buckets
           return (user, Just occId)
+
+        occSize :: Num a => ExamOccurrenceId -> a
+        occSize occId = fromIntegral . length $ Map.filter (== Just occId) resultUsers
+        
+        rangeAlphabet :: Set (CI Char)
+        rangeAlphabet
+          | ExamRoomSurname <- rule
+          = Set.fromList $ map CI.mk ['A'..'Z']
+          | ExamRoomMatriculation <- rule
+          = Set.fromList $ map CI.mk ['0'..'9']
+          | otherwise
+          = mempty
+        mayRange :: Int -> [CI Char] -> Bool
+        mayRange l = all (`Set.member` rangeAlphabet) . take l
diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs
index 994fe893d..be3e0424d 100644
--- a/src/Handler/Utils/Widgets.hs
+++ b/src/Handler/Utils/Widgets.hs
@@ -8,6 +8,8 @@ import Text.Hamlet (shamletFile)
 
 import Handler.Utils.DateTime
 
+import qualified Data.Char as Char
+
 
 ---------
 -- Simple utilities for consistent display
@@ -102,3 +104,14 @@ i18n :: forall m msg.
         , RenderMessage (HandlerSite m) msg
         ) => msg -> m ()
 i18n = toWidget . (SomeMessage :: msg -> SomeMessage (HandlerSite m))
+
+
+examOccurrenceMappingDescriptionWidget :: ExamOccurrenceRule -> Set ExamOccurrenceMappingDescription -> Widget
+examOccurrenceMappingDescriptionWidget rule descriptions = $(widgetFile "widgets/exam-occurrence-mapping-description")
+  where
+    titleCase = over _head Char.toUpper . map CI.foldedCase
+    doPrefix
+      | ExamRoomMatriculation <- rule
+      = False
+      | otherwise
+      = True
diff --git a/src/Model.hs b/src/Model.hs
index f59815c79..3821126b6 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -37,6 +37,12 @@ share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
 
+
+deriving newtype instance ToJSONKey UserId
+deriving newtype instance FromJSONKey UserId
+deriving newtype instance ToJSONKey ExamOccurrenceId
+deriving newtype instance FromJSONKey ExamOccurrenceId
+
 -- ToMarkup and ToMessage instances for displaying selected database primary keys
 
 instance ToMarkup (Key School) where
diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs
index e6186c2b0..59c4396dd 100644
--- a/src/Model/Types/Exam.hs
+++ b/src/Model/Types/Exam.hs
@@ -11,7 +11,14 @@ module Model.Types.Exam
   , _examResult
   , ExamBonusRule(..)
   , ExamOccurrenceRule(..)
+  , examOccurrenceRuleAutomatic
+  , ExamOccurrenceMappingDescription(..)
+  , _eaomrStart, _eaomrEnd, _eaomrSpecial
+  , _ExamOccurrenceMappingRange, _ExamOccurrenceMappingSpecial
   , ExamOccurrenceMapping(..)
+  , _examOccurrenceMappingRule
+  , _examOccurrenceMappingMapping
+  , traverseExamOccurrenceMapping
   , ExamGrade(..)
   , numberGrade
   , ExamGradeDefCenter(..)
@@ -28,6 +35,8 @@ import Import.NoModel
 import Model.Types.Common
 
 import qualified Data.Text as Text
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 import Utils.Lens.TH
 
@@ -44,6 +53,8 @@ import Text.Blaze (ToMarkup(..))
 
 import qualified Data.Foldable
 
+import Data.Aeson (genericToJSON, genericParseJSON)
+
 
 data ExamResult' res = ExamAttended { examResult :: res }
                      | ExamNoShow
@@ -152,18 +163,51 @@ deriveJSON defaultOptions
   , tagSingleConstructors = True
   } ''ExamOccurrenceRule
 derivePersistFieldJSON ''ExamOccurrenceRule
+makePrisms ''ExamOccurrenceRule
+
+examOccurrenceRuleAutomatic :: ExamOccurrenceRule -> Bool
+examOccurrenceRuleAutomatic x = or $ map ($ x)
+  [ is _ExamRoomSurname
+  , is _ExamRoomMatriculation
+  , is _ExamRoomRandom
+  ]
+
+data ExamOccurrenceMappingDescription
+  = ExamOccurrenceMappingRange { eaomrStart, eaomrEnd :: [CI Char] }
+  | ExamOccurrenceMappingSpecial { eaomrSpecial :: [CI Char] }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  , constructorTagModifier = camelToPathPiece' 3
+  } ''ExamOccurrenceMappingDescription
+
+makeLenses_ ''ExamOccurrenceMappingDescription
+makePrisms ''ExamOccurrenceMappingDescription
 
 data ExamOccurrenceMapping roomId = ExamOccurrenceMapping
   { examOccurrenceMappingRule :: ExamOccurrenceRule
-  , examOccurrenceMappingMapping :: [(roomId, [CI Char])]
+  , examOccurrenceMappingMapping :: Map roomId (Set ExamOccurrenceMappingDescription)
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 3
-  , constructorTagModifier = camelToPathPiece' 1
-  , tagSingleConstructors = False
-  } ''ExamOccurrenceMapping
+instance ToJSONKey roomId => ToJSON (ExamOccurrenceMapping roomId) where
+  toJSON = genericToJSON defaultOptions
+    { fieldLabelModifier = camelToPathPiece' 3
+    , constructorTagModifier = camelToPathPiece' 1
+    , tagSingleConstructors = False
+    }
+instance (FromJSONKey roomId, Ord roomId) => FromJSON (ExamOccurrenceMapping roomId) where
+  parseJSON = genericParseJSON defaultOptions
+    { fieldLabelModifier = camelToPathPiece' 3
+    , constructorTagModifier = camelToPathPiece' 1
+    , tagSingleConstructors = False
+    }
 derivePersistFieldJSON ''ExamOccurrenceMapping
 
+makeLenses_ ''ExamOccurrenceMapping
+
+traverseExamOccurrenceMapping :: Ord roomId'
+                              => Traversal (ExamOccurrenceMapping roomId) (ExamOccurrenceMapping roomId') roomId roomId'
+traverseExamOccurrenceMapping = _examOccurrenceMappingMapping . iso Map.toList (Map.fromListWith Set.union) . traverse . _1
+
 
 data ExamGrade
   = Grade50
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 52024081d..4b12d47b4 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -229,6 +229,7 @@ data FormIdentifier
   | FIDUserAuthMode
   | FIDAllUsersAction
   | FIDLanguage
+  | FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where
diff --git a/stack.yaml.lock b/stack.yaml.lock
index e67cca322..8e2842628 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -277,6 +277,13 @@ packages:
       sha256: 6d64803c639ed4c7204ea6fab0536b97d3ee16cdecb9b4a883cd8e56d3c61402
   original:
     hackage: wai-middleware-prometheus-1.0.0
+- completed:
+    hackage: extended-reals-0.2.3.0@sha256:78a498d703fffcecfba8e66cfb3e64c4307b2c126a442f6d28cfdd997829f1bf,1563
+    pantry-tree:
+      size: 398
+      sha256: 29629bb0ac41c49671b7f792e540165ee091eb24ffd0eaff229a2f40cc03f3af
+  original:
+    hackage: extended-reals-0.2.3.0
 snapshots:
 - completed:
     size: 498180
diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet
index 3652474ef..0b6bde895 100644
--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@@ -114,6 +114,22 @@ $if not (null occurrences)
                 _{MsgExamRoomAssigned}
               $if not occurrenceAssignmentsVisible
                 \ ^{isVisible False}
+          $if showOccurrenceMappingColumn
+            $case fmap examOccurrenceMappingRule examExamOccurrenceMapping
+              $of Just ExamRoomSurname
+                <th .table__th>
+                  _{MsgExamRoomMappingSurname}
+                  $if not occurrenceAssignmentsVisible
+                    \ ^{isVisible False}
+              $of Just ExamRoomMatriculation
+                <th .table__th>
+                  _{MsgExamRoomMappingMatriculation}
+                  $if not occurrenceAssignmentsVisible
+                    \ ^{isVisible False}
+              $of _
+                <th .table__td>
+                  $if not occurrenceAssignmentsVisible
+                    ^{isVisible False}
           <th .table__th>_{MsgExamRoomDescription}
       <tbody>
         $forall (occurrence, registered) <- occurrences
@@ -133,6 +149,10 @@ $if not (null occurrences)
                     $nothing
                       $if registered
                         #{iconOK}
+                $if showOccurrenceMappingColumn
+                  <td .table__td>
+                    $maybe mappingWgt <- occurrenceMapping examOccurrenceName
+                      ^{mappingWgt}
                 <td .table__td>
                   $maybe desc <- examOccurrenceDescription
                     #{desc}
diff --git a/templates/exam-users.hamlet b/templates/exam-users.hamlet
index 06e3e489f..68cc39d21 100644
--- a/templates/exam-users.hamlet
+++ b/templates/exam-users.hamlet
@@ -1,6 +1,9 @@
 $newline never
 <section>
   ^{closeWgt}
+$if examOccurrenceRuleAutomatic examOccurrenceRule
+  <section>
+    ^{examAutoOccurrenceCalculateWidget tid ssh csh examn}
 <section>
   $if computedValues
     ^{computedValuesTip}
diff --git a/templates/exam/auto-occurrence-confirm.hamlet b/templates/exam/auto-occurrence-confirm.hamlet
new file mode 100644
index 000000000..0e94455e7
--- /dev/null
+++ b/templates/exam/auto-occurrence-confirm.hamlet
@@ -0,0 +1,3 @@
+$newline never
+^{mappingWgt}
+^{confirmWidget}
diff --git a/templates/widgets/exam-occurrence-mapping-description.hamlet b/templates/widgets/exam-occurrence-mapping-description.hamlet
new file mode 100644
index 000000000..356911383
--- /dev/null
+++ b/templates/widgets/exam-occurrence-mapping-description.hamlet
@@ -0,0 +1,15 @@
+$newline never
+<ul .list--inline .list--comma-separated>
+  $forall desc <- descriptions
+    <li>
+      $case desc
+        $of ExamOccurrenceMappingRange minChars maxChars
+          $if doPrefix
+            #{titleCase minChars}… – #{titleCase maxChars}…
+          $else
+            …#{titleCase minChars} – …#{titleCase maxChars}
+        $of ExamOccurrenceMappingSpecial special
+          $if doPrefix
+            #{titleCase special}…
+          $else
+            …#{titleCase special}
diff --git a/templates/widgets/exam-occurrence-mapping.hamlet b/templates/widgets/exam-occurrence-mapping.hamlet
new file mode 100644
index 000000000..36f99950e
--- /dev/null
+++ b/templates/widgets/exam-occurrence-mapping.hamlet
@@ -0,0 +1,41 @@
+$newline never
+<table .table .table--striped .table--hover>
+  <thead>
+    <tr .table__row .table__row--head>
+      <th .table__th>
+        _{MsgExamRoomName}
+      <th .table__th>
+        _{MsgExamRoomLoad}
+      $maybe rule <- occMappingRule
+        $case rule
+          $of ExamRoomSurname
+            <th .table__th>
+              _{MsgExamRoomMappingSurname}
+          $of ExamRoomMatriculation
+            <th .table__th>
+              _{MsgExamRoomMappingMatriculation}
+          $of _
+            <th .table__td>
+      <th .table__th>
+        _{MsgExamRoom}
+      <th .table__th>
+        _{MsgExamRoomTime}
+      <th .table__th>
+        _{MsgExamRoomDescription}
+  <tbody>
+    $forall Entity occId ExamOccurrence{ examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription, examOccurrenceCapacity } <- occurrences
+      <tr .table__row>
+        <td .table__td>
+          _{examOccurrenceName}
+        <td .table__td>
+          _{loadProp (occLoad occId) examOccurrenceCapacity}
+        $maybe mappingWgt <- occMapping occId
+          <td .table__td>
+            ^{mappingWgt}
+        <td .table__td>
+          #{examOccurrenceRoom}
+        <td .table__td>
+          ^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
+        <td .table__td>
+          $maybe desc <- examOccurrenceDescription
+            #{desc}
diff --git a/test/Database.hs b/test/Database.hs
index 8335ef6ac..9038f14cb 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -505,6 +505,7 @@ fillDb = do
     , examGradingRule = Nothing
     , examBonusRule = Nothing
     , examOccurrenceRule = ExamRoomManual
+    , examExamOccurrenceMapping = Nothing
     , examVisibleFrom = Just now
     , examRegisterFrom = Just now
     , examRegisterTo = Just $ addUTCTime (14 * nominalDay) now