feat(allocations): explanations & introduce grade-ordinal-proportion

BREAKING CHANGE: influence of grades on allocation priority now
relative when priorities are ordinal

config/settings.yml

@@ -143,9 +143,10 @@ user-defaults:
 # This encodes the weight of the lecturer ratings on the same scale as the
 # centrally supplied priorities.
 allocation-grade-scale: 25
-# This encodes how many ordinal places lecturer ratings may move students up or
+# This encodes, as a proportion of the number of places, how many
-# down when central priorities are supplied as ordered list.
+# ordinal places lecturer ratings may move students up or down when
-allocation-grade-ordinal-places: 3
+# central priorities are supplied as ordered list.
+allocation-grade-ordinal-proportion: 0.075
 
 instance-id: "_env:INSTANCE_ID:instance"
 ribbon: "_env:RIBBON:"

frontend/src/app.sass

@@ -472,6 +472,10 @@ ul.list--inline
 .deflist__dt
   font-weight: 600
 
+  .deflist__explanation
+    color: var(--color-fontsec)
+    font-size: 0.9rem
+
 .deflist__dd
   font-size: 18px
   margin-bottom: 10px

messages/uniworx/de-de-formal.msg

@@ -2370,3 +2370,4 @@ AllocationPrioritiesTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid
 AllocationPrioritiesFile: CSV-Datei
 AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt
 AllocationPrioritiesMissing num@Int64: Für #{num} Bewerber ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"}
+AllocationMissingPrioritiesIgnored: Bewerber, für die keine zentrale Priorität angegeben wird, werden bei der Vergabe ignoriert!

src/Foundation.hs

@@ -3028,7 +3028,7 @@ pageActions (AllocationR tid ssh ash AUsersR) = return
       { navLabel       = MsgMenuAllocationPriorities
       , navRoute       = AllocationR tid ssh ash APriosR
       , navAccess'     = return True
-      , navType        = NavTypeLink { navModal = True }
+      , navType        = NavTypeLink { navModal = False }
       , navQuick'      = mempty
       , navForceActive = False
       }

src/Handler/Allocation/Prios.hs

@@ -49,8 +49,10 @@ postAPriosR tid ssh ash = do
         AllocationPrioritiesNumeric -> return $(i18nWidgetFile "allocation-priority-explanation/numeric")
         AllocationPrioritiesOrdinal -> return $(i18nWidgetFile "allocation-priority-explanation/ordinal")
 
+  ignoreWarningMsg <- messageIconI Warning IconMissingAllocationPriority MsgAllocationMissingPrioritiesIgnored
   ((priosRes, priosView), priosEnctype) <- runFormPost . renderAForm FormStandard $ (,)
     <$> apopt (explainedSelectionField Nothing (explainOptionList optionsFinite explainAllocationPrioMode)) (fslI MsgAllocationPrioritiesMode) (Just $ bool AllocationPrioritiesOrdinal AllocationPrioritiesNumeric doNumericPrios)
+    <*  aformMessage ignoreWarningMsg
     <*> areq fileField (fslI MsgAllocationPrioritiesFile) Nothing
 
   formResult priosRes $ \(mode, fInfo) -> do
@@ -76,7 +78,11 @@ postAPriosR tid ssh ash = do
   siteLayoutMsg MsgMenuAllocationPriorities $ do
     setTitleI $ MsgAllocationPrioritiesTitle tid ssh ash
 
-    wrapForm priosView def
+    let priosForm = wrapForm priosView def
-      { formEncoding = priosEnctype
+          { formEncoding = priosEnctype
-      , formAction = Just . SomeRoute $ AllocationR tid ssh ash APriosR
+          , formAction = Just . SomeRoute $ AllocationR tid ssh ash APriosR
-      }
+          }
+    gradeScale <- getsYesod $ view _appAllocationGradeScale
+    gradeOrdinalProportion <- getsYesod $ view _appAllocationGradeOrdinalProportion
+
+    $(i18nWidgetFile "allocation-priorities")

src/Handler/Allocation/Users.hs

@@ -10,7 +10,7 @@ import Handler.Utils
 import Handler.Utils.Allocation
 
 import qualified Database.Esqueleto as E
-import qualified Database.Esqueleto.Utils.TH as E
+import qualified Database.Esqueleto.Utils as E
 
 import qualified Data.Csv as Csv
 
@@ -103,11 +103,15 @@ instance CsvColumnsExplained AllocationUserTableCsv where
 getAUsersR, postAUsersR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
 getAUsersR = postAUsersR
 postAUsersR tid ssh ash = do
-  usersTable <- runDB $ do
+  (usersTable, missingPriorities) <- runDB $ do
     Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
     now <- liftIO getCurrentTime
     resultsDone <- (<= NTop (Just now)) . NTop <$> allocationDone aId
 
+    missingPriorities <- E.selectExists . E.from $ \allocationUser ->
+      E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
+           E.&&. E.isNothing (allocationUser E.^. AllocationUserPriority)
+
     csvName <- getMessageRender <*> pure (MsgAllocationUsersCsvName tid ssh ash)
 
     let
@@ -220,9 +224,12 @@ postAUsersR tid ssh ash = do
         & defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"]
         & defaultPagesize PagesizeAll
 
-    dbTableDB' allocationUsersDBTableValidator allocationUsersDBTable
+    usersTable <- dbTableDB' allocationUsersDBTableValidator allocationUsersDBTable
+    return (usersTable, missingPriorities)
 
   siteLayoutMsg MsgMenuAllocationUsers $ do
     setTitleI $ MsgAllocationUsersTitle tid ssh ash
 
+    when missingPriorities $
+      notification NotificationBroad =<< messageIconI Warning IconMissingAllocationPriority MsgAllocationMissingPrioritiesIgnored
     usersTable

src/Handler/Utils/Allocation.hs

@@ -119,7 +119,13 @@ computeAllocation allocId cRestr = do
         return ((courseApplicationUser, courseApplicationCourse), (courseApplicationAllocationPriority, courseApplicationRatingPoints))
 
   gradeScale <- getsYesod $ view _appAllocationGradeScale
-  gradeOrdinalPlaces <- getsYesod $ view _appAllocationGradeOrdinalPlaces
+  gradeOrdinalProportion <- getsYesod $ view _appAllocationGradeOrdinalProportion
+  let ordinalUsers = getSum . flip foldMap users'' $ \(_, prio) -> case prio of
+        AllocationPriorityOrdinal{} -> Sum 1
+        _other -> mempty
+      gradeOrdinalPlaces :: Natural
+      gradeOrdinalPlaces = round . abs $ ordinalUsers * gradeOrdinalProportion
+  
   let centralNudge user cloneIndex grade = case allocationPrio user of
         AllocationPriorityNumeric{..}
           -> let allocationPriorities' = under vector (sortOn Down) allocationPriorities

src/Settings.hs

@@ -125,8 +125,8 @@ data AppSettings = AppSettings
 
     , appTransactionLogIPRetentionTime :: NominalDiffTime
 
-    , appAllocationGradeScale :: Rational
+    , appAllocationGradeScale
-    , appAllocationGradeOrdinalPlaces :: Natural
+    , appAllocationGradeOrdinalProportion :: Rational
 
     , appReloadTemplates        :: Bool
     -- ^ Use the reload version of templates
@@ -423,7 +423,7 @@ instance FromJSON AppSettings where
         appTransactionLogIPRetentionTime <- o .:  "ip-retention-time"
 
         appAllocationGradeScale   <- o .: "allocation-grade-scale" <|> fmap toRational (o .: "allocation-grade-scale" :: Aeson.Parser Scientific)
-        appAllocationGradeOrdinalPlaces <- o .: "allocation-grade-ordinal-places"
+        appAllocationGradeOrdinalProportion <- o .: "allocation-grade-ordinal-proportion" <|> fmap toRational (o .: "allocation-grade-ordinal-proportion" :: Aeson.Parser Scientific)
 
         appUserDefaults           <- o .:  "user-defaults"
         appAuthPWHash             <- o .:  "auth-pw-hash"

src/Utils/Icon.hs

@@ -82,6 +82,7 @@ data Icon
   | IconMenuAdmin
   | IconPageActionPrimaryExpand | IconPageActionSecondary
   | IconBreadcrumbSeparator
+  | IconMissingAllocationPriority
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
 
 iconText :: Icon -> Text
@@ -142,6 +143,7 @@ iconText = \case
     IconPageActionPrimaryExpand -> "bars"
     IconPageActionSecondary     -> "ellipsis-h"
     IconBreadcrumbSeparator     -> "angle-right"
+    IconMissingAllocationPriority -> "empty-set"
 
 instance Universe Icon
 instance Finite   Icon

src/Utils/Message.hs

@@ -6,7 +6,7 @@ module Utils.Message
   , addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget
   , statusToUrgencyClass
   , Message(..)
-  , messageIconI, messageIconIHamlet, messageIconWidget
+  , messageIconI, messageIconIHamlet, messageIconFile, messageIconWidget
   , messageI, messageIHamlet, messageFile, messageWidget, messageTooltip
   ) where
 
@@ -178,6 +178,9 @@ addMessageFile mc tPath = [e|addMessageIHamlet mc $(ihamletFile tPath)|]
 messageFile :: MessageStatus -> FilePath -> ExpQ
 messageFile mc tPath = [e|messageIHamlet mc $(ihamletFile tPath)|]
 
+messageIconFile :: MessageStatus -> Icon -> FilePath -> ExpQ
+messageIconFile mc mi tPath = [e|messageIHamlet mc mi $(ihamletFile tPath)|]
+
 addMessageWidget :: forall m site.
                     ( MonadHandler m
                     , HandlerSite m ~ site

templates/i18n/allocation-priorities/de-de-formal.hamlet

@@ -0,0 +1,23 @@
+$newline never
+<section>
+  ^{priosForm}
+<section>
+  <dl .deflist>
+    <dt .deflist__dt>
+      Einfluss von Bewertungen bei numerischen Dringlichkeiten
+      <p .deflist__explanation>
+        Dozenten können, durch Hinterlegen von Bewertungen, die Vergabe #
+        in einem Maße beeinflussen, das einer Abweichung der #
+        zentralen Dringlichkeit um plus bzw. minus diesen Wert, #
+        entspricht.
+    <dd .deflist__dd>
+      #{rationalToFixed2 gradeScale}
+    <dt .deflist__dt>
+      Einfluss von Bewertungen bei Dringlichkeiten durch Sortierung
+      <p .deflist__explanation>
+        Dozenten können, durch Hinterlegen von Bewertungen, die #
+        Vergabe in einem Maße beeinflussen, das einer Verschiebung des #
+        Bewerbers (auf- bzw. abwärts) um diese Proportion, in der nach #
+        Dringlichkeit sortierten Bewerberliste, entspricht.
+    <dd .deflist__dd>
+      #{textPercent gradeOrdinalProportion 1}

templates/i18n/allocation-priority-explanation/numeric/de-de-formal.hamlet

@@ -9,10 +9,15 @@ Alle weiteren Spalten werden als ganze Zahlen interpretiert und #
 kodieren die jeweilige zentrale Dringlichkeit bei der Vergabe der #
 Plätze. #
 
-Hierbei wird die erste Dringlichkeits-Spalte verwendet zur Vergabe des #
+Größere Zahlen kodieren eine höhere Dringlichkeit. #
-jeweils ersten Platzes, die zweite Spalte für den zweiten Platz, usw. #
 
-Größere Zahlen kodieren eine höhere Dringlichkeit.
+Hierbei wird die höchste der jeweiligen Dringlichkeiten verwendet zur #
+Vergabe des jeweils ersten Platzes, die nächst niedrigere für den #
+zweiten Platz, usw.. #
+
+Werden für einen Bewerber mehr Plätze in Betracht gezogen, als #
+Dringlichkeiten für ihn angegeben wurden, so wird hierfür die #
+niedrigste Dringlichkeit verwendet.
 
 <br />
 

templates/i18n/allocation-priority-explanation/ordinal/de-de-formal.hamlet

@@ -9,8 +9,11 @@ Die zentrale Dringlichkeit ergibt sich ausschließlich anhand der #
 Sortierung der CSV-Datei. #
 
 Bewerber, deren Matrikelnummer später in der Datei vorkommt, erhalten #
-für alle ihre Plätze eine höhere Dringlichkeit, als Bewerber, deren #
+eine höhere Dringlichkeit, als Bewerber, deren Matrikelnummern in der #
-Matrikelnummern in der Datei früher vorkommen. #
+Datei früher vorkommen. #
+
+Für ihren zweiten Platz haben alle Bewerber eine niedrigere #
+Dringlichkeit als andere Bewerber für ihren ersten Platz, usw..
 
 <br />