Merge branch '663-teilnehmerschnitt' into 'master'

Resolve "Teilnehmerschnitt von Lehrveranstaltungen; wie viele Leute sind in allen Veranstaltungen"

Closes #663

See merge request uni2work/uni2work!39

messages/uniworx/categories/courses/participants/de-de-formal.msg

@@ -5,4 +5,7 @@ ParticipantsIntersectCourseOption tid@TermId ssh@SchoolId coursen@CourseName !id
 ParticipantsIntersectCourses: Kurse
 CourseParticipantsRegisteredWithoutField n@Int: #{n} #{pluralDE n "Teilnehmeri:in wurde ohne assoziiertes Studienfach" "Teilnehmer:innen wurden ohne assoziierte Studienfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
 ParticipantsCsvSheetName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Kursteilnehmer:innen
-CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer:innen
+CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer:innen
+ParticipantsIntersectNotOne: Schnitt 
+AllUsersUnion: Vereinigung aller Teilnehmer:innen
+AllUsersIntersection: Schnitt aller Teilneher:innen

messages/uniworx/categories/courses/participants/en-eu.msg

@@ -6,3 +6,6 @@ ParticipantsIntersectCourses: Courses
 CourseParticipantsRegisteredWithoutField n: #{n} #{pluralEN n "participant was" "participants were"} registered without #{pluralEN n "an associated field of study" "associated fields of study"}, because #{pluralEN n "it" "they"} could not be determined uniquely.
 ParticipantsCsvSheetName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Participants
 CourseParticipants n: Currently #{n} course #{pluralEN n "participant" "participants"}
+ParticipantsIntersectNotOne: Intersection
+AllUsersUnion: Union of all participants 
+AllUsersIntersection: Intersection of all participants 

src/Application.hs

@@ -707,4 +707,4 @@ addPWEntry :: User
 addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do
   PWHashConf{..} <- getsYesod $ view _appAuthPWHash
   (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength
-  void $ insert User{..}
+  void $ insert User{..}

src/Handler/Participants.hs

@@ -109,9 +109,11 @@ postParticipantsIntersectR = do
         intersections = flip Map.fromSet coursePairs $ \(lCid, uCid)
           -> Set.size $ Map.findWithDefault Set.empty lCid courseUsers `Set.intersection` Map.findWithDefault Set.empty uCid courseUsers
         selfIntersections = Map.mapKeysMonotonic (\cid -> (cid, cid)) $ Set.size <$> courseUsers
-        intersections' = Map.union intersections selfIntersections
-
-    return (courses, intersections')
+        intersections' = Map.union intersections selfIntersections 
+    let allUsersUnion = Set.size . Set.unions $ Map.elems courseUsers
+    let mapIntersect = mapIntersectNotOne courseUsers
+    let allUsersIntersection = Set.size . setIntersections $ Map.elems courseUsers
+    return (courses, intersections', mapIntersect, allUsersUnion, allUsersIntersection)
 
   let
     symmIntersection intersections lCid uCid = fromMaybe 0 $ intersections !? (lCid, uCid) <|> intersections !? (uCid, lCid)

src/Utils.hs

@@ -41,6 +41,7 @@ import Utils.HttpConditional as Utils
 import Utils.Persist as Utils
 import Utils.ARC as Utils
 import Utils.LRU as Utils
+import Utils.Set as Utils
 
 import Text.Blaze (Markup, ToMarkup(..))
 
@@ -562,32 +563,10 @@ withoutSubsequenceBy cmp = go []
           | x `cmp` y = go acc a' b
           | otherwise = go (y:acc) a b
         
-
 ----------
 -- Sets --
 ----------
-
--- | Intersection of multiple sets. Returns empty set for empty input list
-setIntersections :: Ord a => [Set a] -> Set a
-setIntersections []    = Set.empty
-setIntersections (h:t) = foldl' Set.intersection h t
-
-setMapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b
-setMapMaybe f = Set.fromList . mapMaybe f . Set.toList
-
--- | Symmetric difference of two sets.
-setSymmDiff :: Ord a => Set a -> Set a -> Set a
-setSymmDiff x y = (x `Set.difference` y) `Set.union` (y `Set.difference` x)
-
-setProduct :: Set a -> Set b -> Set (a, b)
--- ^ Depends on the valid internal structure of the given sets
-setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList $ (,) <$> as <*> bs
-
-setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b)
-setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right)
-
-setFromFunc :: (Finite k, Ord k) => (k -> Bool) -> Set k
-setFromFunc = Set.fromList . flip filter universeF
+-- all functions that used to be here are now in Utils.Set
 
 ----------
 -- Maps --

src/Utils/Set.hs

@@ -0,0 +1,64 @@
+module Utils.Set
+( setIntersectNotOne
+, setIntersections
+, setMapMaybe
+, setSymmDiff
+, setProduct
+, setPartitionEithers
+, setFromFunc
+, mapIntersectNotOne
+) where 
+
+import qualified Data.Set as Set
+import qualified Data.Map.Strict()
+import qualified Data.Map as Map
+import ClassyPrelude
+import Data.Universe
+import Control.Lens.Prism
+import Control.Lens
+
+
+-- | cardinal number of an intersection of a set and a list of sets
+setIntersectNotOne :: Ord a => Set a -> [Set a] -> Int 
+setIntersectNotOne _ [] = 0
+setIntersectNotOne k r = Set.size $ Set.intersection k others where others = Set.unions r
+
+----------------------------------------
+-- Functions for Handler.Participants --
+----------------------------------------
+
+-- | extracts from a map a list of values (sets) without one specific entry (a)
+getAllElemsWithoutOne :: (Ord a) => Map a (Set b) -> a -> [Set b]
+getAllElemsWithoutOne m cid = Map.elems $ Map.delete cid m 
+
+-- | transforms values (sets) of a map to integers. The number gives information about how many entreis are not only in this one 
+mapIntersectNotOne :: forall a b. (Ord a, Ord b) => Map a (Set b) -> Map a Int 
+mapIntersectNotOne m = Map.mapWithKey f m where 
+    f :: a -> Set b -> Int
+    f k _ = setIntersectNotOne (Map.findWithDefault Set.empty k m) (getAllElemsWithoutOne m k)
+ 
+--------------------------
+-- Functions from Utils --
+--------------------------
+
+-- | Intersection of multiple sets. Returns empty set for empty input list
+setIntersections :: Ord a => [Set a] -> Set a
+setIntersections []    = Set.empty
+setIntersections (h:t) = foldl' Set.intersection h t
+
+setMapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b
+setMapMaybe f = Set.fromList . mapMaybe f . Set.toList
+
+-- | Symmetric difference of two sets.
+setSymmDiff :: Ord a => Set a -> Set a -> Set a
+setSymmDiff x y = (x `Set.difference` y) `Set.union` (y `Set.difference` x)
+
+setProduct :: Set a -> Set b -> Set (a, b)
+-- ^ Depends on the valid internal structure of the given sets
+setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList $ (,) <$> as <*> bs
+
+setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b)
+setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right)
+
+setFromFunc :: (Finite k, Ord k) => (k -> Bool) -> Set k
+setFromFunc = Set.fromList . flip filter universeF

templates/participants-intersect.hamlet

@@ -1,7 +1,7 @@
 $newline never
 <section>
   ^{formWidget}
-$maybe (courses, intersections) <- intersectionsRes
+$maybe (courses, intersections, mapIntersect, allUsersUnion, allUsersIntersection) <- intersectionsRes
   <section>
     <div .scrolltable .scrolltable--bordered>
       <table .table .table--hover .table--condensed>
@@ -11,6 +11,8 @@ $maybe (courses, intersections) <- intersectionsRes
             $forall Entity _ Course{courseTerm, courseSchool, courseShorthand} <- courses
               <th .table__th .text--center>
                 #{courseTerm}-#{courseSchool}-#{courseShorthand}
+            <th .table__th .text--center>
+              _{MsgParticipantsIntersectNotOne}
         <tbody>
           $forall (l, Entity lCid Course{courseTerm, courseSchool, courseShorthand}) <- lIxed courses
             <tr .table__row>
@@ -24,3 +26,12 @@ $maybe (courses, intersections) <- intersectionsRes
                     <td .table__td .text--center :uCid == lCid:.table__td--automatic :uCid /= lCid:.heated :uCid /= lCid:style="--hotness: #{toPathPiece (intersectionHotness intersections lCid uCid)}">
                       $if showNumber n lCid uCid
                         #{n}
+              $maybe num <- Map.lookup lCid mapIntersect
+                <td .table__td .text--center .table__td--automatic>
+                  #{num}
+  <p> 
+    _{MsgAllUsersUnion}: #
+    #{allUsersUnion}
+  <p> 
+    _{MsgAllUsersIntersection}: #
+    #{allUsersIntersection}