diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg index ae957c977..023280fb6 100644 --- a/messages/uniworx/categories/courses/participants/de-de-formal.msg +++ b/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 \ No newline at end of file +CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer:innen +ParticipantsIntersectNotOne: Schnitt +AllUsersUnion: Vereinigung aller Teilnehmer:innen +AllUsersIntersection: Schnitt aller Teilneher:innen \ No newline at end of file diff --git a/messages/uniworx/categories/courses/participants/en-eu.msg b/messages/uniworx/categories/courses/participants/en-eu.msg index 59ea336fb..e67ae634c 100644 --- a/messages/uniworx/categories/courses/participants/en-eu.msg +++ b/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 \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index bcaf1edda..ab3bb8886 100644 --- a/src/Application.hs +++ b/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{..} \ No newline at end of file diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 70bd2383f..cbeb69ab2 100644 --- a/src/Handler/Participants.hs +++ b/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) diff --git a/src/Utils.hs b/src/Utils.hs index 60fc69175..0ba53c9fc 100644 --- a/src/Utils.hs +++ b/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 -- diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs new file mode 100644 index 000000000..01794701e --- /dev/null +++ b/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 \ No newline at end of file diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet index 5e24254ed..eeaa544a0 100644 --- a/templates/participants-intersect.hamlet +++ b/templates/participants-intersect.hamlet @@ -1,7 +1,7 @@ $newline never
^{formWidget} -$maybe (courses, intersections) <- intersectionsRes +$maybe (courses, intersections, mapIntersect, allUsersUnion, allUsersIntersection) <- intersectionsRes
@@ -11,6 +11,8 @@ $maybe (courses, intersections) <- intersectionsRes $forall Entity _ Course{courseTerm, courseSchool, courseShorthand} <- courses $forall (l, Entity lCid Course{courseTerm, courseSchool, courseShorthand}) <- lIxed courses @@ -24,3 +26,12 @@ $maybe (courses, intersections) <- intersectionsRes
#{courseTerm}-#{courseSchool}-#{courseShorthand} + + _{MsgParticipantsIntersectNotOne}
$if showNumber n lCid uCid #{n} + $maybe num <- Map.lookup lCid mapIntersect + + #{num} +

+ _{MsgAllUsersUnion}: # + #{allUsersUnion} +

+ _{MsgAllUsersIntersection}: # + #{allUsersIntersection} \ No newline at end of file