From a4bd1159c2e14696d3fc8f937d82b460d8e8b5ac Mon Sep 17 00:00:00 2001 From: ros Date: Thu, 13 May 2021 16:18:59 +0200 Subject: [PATCH 1/8] refactor(utils.set): new utils.set folder with set-functions added --- src/Utils.hs | 27 +---------------------- src/Utils/Set.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 26 deletions(-) create mode 100644 src/Utils/Set.hs diff --git a/src/Utils.hs b/src/Utils.hs index ed364adc1..cdd3ee440 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -40,6 +40,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,6 @@ withoutSubsequenceBy cmp = go [] | 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 - ---------- -- Maps -- ---------- diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs new file mode 100644 index 000000000..1926c51b9 --- /dev/null +++ b/src/Utils/Set.hs @@ -0,0 +1,56 @@ +module Utils.Set +( setIntersectAll +, setIntersectNotOne +, setIntersections +, setMapMaybe +, setSymmDiff +, setProduct +, setPartitionEithers +, setFromFunc +) where + +import qualified Data.Set as Set +import qualified Data.Map.Strict() +import ClassyPrelude +import Data.Universe +import Control.Lens.Prism +import Control.Lens + +-- Mächtigkeit Schnittmenge +setIntersectAll :: Ord a => [Set.Set a] -> Int +setIntersectAll [] = 0 +setIntersectAll [x] = Set.size x +setIntersectAll (x:y:z) = setIntersectAll (xy:z) where xy = Set.intersection x y + +-- Mächtigkeit Schnittmenge Set, Liste von Sets +setIntersectNotOne :: Ord a => Set.Set a -> [Set.Set a] -> Int +setIntersectNotOne _ [] = 0 +setIntersectNotOne k r = Set.size $ Set.intersection k others where others = setUnionOthers r + +-- Vereinigung von Sets +setUnionOthers :: Ord a => [Set.Set a] -> Set.Set a +setUnionOthers [] = Set.empty +setUnionOthers [x] = x +setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y + +-- | 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 From b96327b18dafcd020c94bb84c6aafffb53544076 Mon Sep 17 00:00:00 2001 From: ros Date: Fri, 21 May 2021 16:55:02 +0200 Subject: [PATCH 2/8] feat(participants): basic funktions added --- src/Handler/Participants.hs | 7 ++++--- src/Utils/Set.hs | 40 +++++++++++++++++++++++++++++++++---- 2 files changed, 40 insertions(+), 7 deletions(-) diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 569d8ea46..c3bd086bb 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-incomplete-uni-patterns -Wno-error=deprecations #-} module Handler.Participants ( getParticipantsListR , getParticipantsR @@ -109,8 +109,9 @@ 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 - + intersections' = Map.union intersections selfIntersections + let allUsers = setIntersectAll $ Map.elems courseUsers + let mapIntersect = mapIntersectNotOne courseUsers return (courses, intersections') let diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs index 1926c51b9..6fc598ab2 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -7,32 +7,64 @@ module Utils.Set , setProduct , setPartitionEithers , setFromFunc +, mapIntersectNotOne +, getAllUserIdsSetList ) 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 --- Mächtigkeit Schnittmenge +-- | cardinal number of a Set setIntersectAll :: Ord a => [Set.Set a] -> Int setIntersectAll [] = 0 setIntersectAll [x] = Set.size x -setIntersectAll (x:y:z) = setIntersectAll (xy:z) where xy = Set.intersection x y +setIntersectAll (x:y:z) = setIntersectAll (xy:z) where xy = Set.union x y --- Mächtigkeit Schnittmenge Set, Liste von Sets +-- | cardinal number of an intersection of a set and a list of sets setIntersectNotOne :: Ord a => Set.Set a -> [Set.Set a] -> Int setIntersectNotOne _ [] = 0 setIntersectNotOne k r = Set.size $ Set.intersection k others where others = setUnionOthers r --- Vereinigung von Sets +-- | Union of a list of sets setUnionOthers :: Ord a => [Set.Set a] -> Set.Set a setUnionOthers [] = Set.empty setUnionOthers [x] = x setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y +-- Fkt für Tabelle +-- | list of values of a Map with Sets as values +getAllUserIdsSetList :: Map.Map a (Set b) -> [Set b] +getAllUserIdsSetList m = loop (Map.toList m) [] where + loop [] uids = uids + loop ((_,v):xs) uids = loop xs $ uids ++ [v] + +-- | value of a Map with given key +getUserIdsOfOneCourse :: (Ord a, Ord b) => Map.Map a (Set b) -> a -> Set b +getUserIdsOfOneCourse m cid + |m == Map.empty = Set.empty + |otherwise = m Map.! cid + +-- | extracts from a map a list of values (sets) without one specific entry (a) +getAllUserIdsWithoutOne :: (Ord a, Ord b) => Map.Map a (Set b) -> a -> [Set b] +getAllUserIdsWithoutOne m cid + |m == Map.empty = [] + |otherwise = getAllUserIdsSetList $ 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 :: (Ord a, Ord b) => Map.Map a (Set b) -> Map.Map a Int +mapIntersectNotOne m = loop (Map.toList m) Map.empty where + loop [] ino = ino + loop ((k,_):xs) ino = loop xs $ Map.insert k (setIntersectNotOne (getUserIdsOfOneCourse m k) (getAllUserIdsWithoutOne m k)) ino + +----------------------------- +-- Functions from Utils.hs -- +----------------------------- + -- | Intersection of multiple sets. Returns empty set for empty input list setIntersections :: Ord a => [Set a] -> Set a setIntersections [] = Set.empty From eced7781ae346e285b7f3949917f23883b4dfaa8 Mon Sep 17 00:00:00 2001 From: ros Date: Fri, 21 May 2021 17:23:38 +0200 Subject: [PATCH 3/8] feat(participants): small Name-change --- src/Utils/Set.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs index 6fc598ab2..5a59be271 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -1,5 +1,5 @@ module Utils.Set -( setIntersectAll +( setUnionAll , setIntersectNotOne , setIntersections , setMapMaybe @@ -20,10 +20,10 @@ import Control.Lens.Prism import Control.Lens -- | cardinal number of a Set -setIntersectAll :: Ord a => [Set.Set a] -> Int -setIntersectAll [] = 0 -setIntersectAll [x] = Set.size x -setIntersectAll (x:y:z) = setIntersectAll (xy:z) where xy = Set.union x y +setUnionAll :: Ord a => [Set.Set a] -> Int +setUnionAll [] = 0 +setUnionAll [x] = Set.size x +setUnionAll (x:y:z) = setUnionAll (xy:z) where xy = Set.union x y -- | cardinal number of an intersection of a set and a list of sets setIntersectNotOne :: Ord a => Set.Set a -> [Set.Set a] -> Int From 6f3243d90bdc137e7f2ea9fe8e271f1cdc32dfbd Mon Sep 17 00:00:00 2001 From: ros Date: Sat, 22 May 2021 11:59:46 +0200 Subject: [PATCH 4/8] feat(participants): small Name-change --- src/Application.hs | 1 + src/Handler/Participants.hs | 4 ++-- templates/participants-intersect.hamlet | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index bcaf1edda..0da9b1248 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -708,3 +708,4 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength void $ insert User{..} + diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index c3bd086bb..297f535d9 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -110,8 +110,8 @@ postParticipantsIntersectR = do -> 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 - let allUsers = setIntersectAll $ Map.elems courseUsers - let mapIntersect = mapIntersectNotOne courseUsers + -- let allUsers = setUnionAll $ Map.elems courseUsers + -- let mapIntersect = mapIntersectNotOne courseUsers return (courses, intersections') let diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet index 5e24254ed..8519ba33b 100644 --- a/templates/participants-intersect.hamlet +++ b/templates/participants-intersect.hamlet @@ -23,4 +23,4 @@ $maybe (courses, intersections) <- intersectionsRes $with n <- symmIntersection intersections lCid uCid $if showNumber n lCid uCid - #{n} + #{n} \ No newline at end of file From 0a3fd23e22a81b3636fb3ac224dce52df3f752f2 Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 24 May 2021 11:45:28 +0200 Subject: [PATCH 5/8] feat(participants): first finished verson --- .../categories/courses/participants/de-de-formal.msg | 4 +++- .../categories/courses/participants/en-eu.msg | 2 ++ src/Application.hs | 1 - src/Handler/Participants.hs | 6 +++--- src/Utils/Set.hs | 5 ++++- templates/participants-intersect.hamlet | 12 ++++++++++-- 6 files changed, 22 insertions(+), 8 deletions(-) diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg index ae957c977..98827240b 100644 --- a/messages/uniworx/categories/courses/participants/de-de-formal.msg +++ b/messages/uniworx/categories/courses/participants/de-de-formal.msg @@ -5,4 +5,6 @@ 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 +AllUsers: Vereinigung aller Teilnehmer: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..3183e260e 100644 --- a/messages/uniworx/categories/courses/participants/en-eu.msg +++ b/messages/uniworx/categories/courses/participants/en-eu.msg @@ -6,3 +6,5 @@ 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 +AllUsers: Union of all participants: \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 0da9b1248..bcaf1edda 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -708,4 +708,3 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength void $ insert User{..} - diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 3271fd9d5..319c758cc 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -110,9 +110,9 @@ postParticipantsIntersectR = do -> 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 - -- let allUsers = setUnionAll $ Map.elems courseUsers - -- let mapIntersect = mapIntersectNotOne courseUsers - return (courses, intersections') + let allUsers = setUnionAll $ Map.elems courseUsers + let mapIntersect = mapIntersectNotOne courseUsers + return (courses, intersections', mapIntersect, allUsers) let symmIntersection intersections lCid uCid = fromMaybe 0 $ intersections !? (lCid, uCid) <|> intersections !? (uCid, lCid) diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs index 5a59be271..2697b183a 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -36,7 +36,10 @@ setUnionOthers [] = Set.empty setUnionOthers [x] = x setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y --- Fkt für Tabelle +---------------------------------- +-- Functions fro Particiants.hs -- +---------------------------------- + -- | list of values of a Map with Sets as values getAllUserIdsSetList :: Map.Map a (Set b) -> [Set b] getAllUserIdsSetList m = loop (Map.toList m) [] where diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet index 8519ba33b..a2586a7a2 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, allUsers) <- 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 @@ -23,4 +25,10 @@ $maybe (courses, intersections) <- intersectionsRes $with n <- symmIntersection intersections lCid uCid
#{courseTerm}-#{courseSchool}-#{courseShorthand} + + _{MsgParticipantsIntersectNotOne}
$if showNumber n lCid uCid - #{n} \ No newline at end of file + #{n} + $maybe num <- Map.lookup lCid mapIntersect + + #{num} +

+ _{MsgAllUsers} + #{allUsers} \ No newline at end of file From 02354f0998e61c236bc982848b9d709c927690f5 Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 24 May 2021 12:20:26 +0200 Subject: [PATCH 6/8] feat(participants): second version, Intersection added --- .../categories/courses/participants/de-de-formal.msg | 3 ++- .../uniworx/categories/courses/participants/en-eu.msg | 3 ++- src/Application.hs | 2 +- src/Handler/Participants.hs | 5 +++-- src/Utils/Set.hs | 7 +++++++ templates/participants-intersect.hamlet | 9 ++++++--- 6 files changed, 21 insertions(+), 8 deletions(-) diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg index 98827240b..0a169d688 100644 --- a/messages/uniworx/categories/courses/participants/de-de-formal.msg +++ b/messages/uniworx/categories/courses/participants/de-de-formal.msg @@ -7,4 +7,5 @@ CourseParticipantsRegisteredWithoutField n@Int: #{n} #{pluralDE n "Teilnehmeri:i ParticipantsCsvSheetName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Kursteilnehmer:innen CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer:innen ParticipantsIntersectNotOne: Schnitt -AllUsers: Vereinigung aller Teilnehmer:innen: \ No newline at end of file +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 3183e260e..3d110bd7e 100644 --- a/messages/uniworx/categories/courses/participants/en-eu.msg +++ b/messages/uniworx/categories/courses/participants/en-eu.msg @@ -7,4 +7,5 @@ CourseParticipantsRegisteredWithoutField n: #{n} #{pluralEN n "participant was" ParticipantsCsvSheetName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Participants CourseParticipants n: Currently #{n} course #{pluralEN n "participant" "participants"} ParticipantsIntersectNotOne: Intersection -AllUsers: Union of all participants: \ No newline at end of file +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 319c758cc..83842fa77 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -110,9 +110,10 @@ postParticipantsIntersectR = do -> 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 - let allUsers = setUnionAll $ Map.elems courseUsers + let allUsersUnion = setUnionAll $ Map.elems courseUsers let mapIntersect = mapIntersectNotOne courseUsers - return (courses, intersections', mapIntersect, allUsers) + let allUsersIntersection = setIntersectionAll $ 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/Set.hs b/src/Utils/Set.hs index 2697b183a..c612dbd82 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -1,5 +1,6 @@ module Utils.Set ( setUnionAll +, setIntersectionAll , setIntersectNotOne , setIntersections , setMapMaybe @@ -36,6 +37,12 @@ setUnionOthers [] = Set.empty setUnionOthers [x] = x setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y +-- | cardinal number of a Set +setIntersectionAll :: Ord a => [Set.Set a] -> Int +setIntersectionAll [] = 0 +setIntersectionAll [x] = Set.size x +setIntersectionAll (x:y:z) = setIntersectionAll (xy:z) where xy = Set.intersection x y + ---------------------------------- -- Functions fro Particiants.hs -- ---------------------------------- diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet index a2586a7a2..573c8726f 100644 --- a/templates/participants-intersect.hamlet +++ b/templates/participants-intersect.hamlet @@ -1,7 +1,7 @@ $newline never

^{formWidget} -$maybe (courses, intersections, mapIntersect, allUsers) <- intersectionsRes +$maybe (courses, intersections, mapIntersect, allUsersUnion, allUsersIntersection) <- intersectionsRes
@@ -30,5 +30,8 @@ $maybe (courses, intersections, mapIntersect, allUsers) <- intersectionsRes
#{num}

- _{MsgAllUsers} - #{allUsers} \ No newline at end of file + _{MsgAllUsersUnion} + #{allUsersUnion} +

+ _{MsgAllUsersIntersection} + #{allUsersIntersection} \ No newline at end of file From fd111215447aff817399db379a4ca8e90eb73cff Mon Sep 17 00:00:00 2001 From: ros Date: Tue, 25 May 2021 17:14:36 +0200 Subject: [PATCH 7/8] feat(participants): corrections --- src/Handler/Participants.hs | 6 ++--- src/Utils.hs | 4 ++++ src/Utils/Set.hs | 46 +++++-------------------------------- 3 files changed, 13 insertions(+), 43 deletions(-) diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 83842fa77..8b8ac1c65 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-incomplete-uni-patterns -Wno-error=deprecations #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-incomplete-uni-patterns #-} module Handler.Participants ( getParticipantsListR , getParticipantsR @@ -110,9 +110,9 @@ postParticipantsIntersectR = do -> 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 - let allUsersUnion = setUnionAll $ Map.elems courseUsers + let allUsersUnion = Set.size.Set.unions $ Map.elems courseUsers let mapIntersect = mapIntersectNotOne courseUsers - let allUsersIntersection = setIntersectionAll $ Map.elems courseUsers + let allUsersIntersection = Set.size.setIntersections $ Map.elems courseUsers return (courses, intersections', mapIntersect, allUsersUnion, allUsersIntersection) let diff --git a/src/Utils.hs b/src/Utils.hs index 5d53dc624..e87607e96 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -563,6 +563,10 @@ withoutSubsequenceBy cmp = go [] | x `cmp` y = go acc a' b | otherwise = go (y:acc) a b +---------- +-- Sets -- +---------- +-- all functions that used to be here are now in Utils/Set.hs ---------- -- Maps -- diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs index c612dbd82..a74a1db58 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -1,7 +1,5 @@ module Utils.Set -( setUnionAll -, setIntersectionAll -, setIntersectNotOne +( setIntersectNotOne , setIntersections , setMapMaybe , setSymmDiff @@ -9,7 +7,6 @@ module Utils.Set , setPartitionEithers , setFromFunc , mapIntersectNotOne -, getAllUserIdsSetList ) where import qualified Data.Set as Set @@ -20,56 +17,25 @@ import Data.Universe import Control.Lens.Prism import Control.Lens --- | cardinal number of a Set -setUnionAll :: Ord a => [Set.Set a] -> Int -setUnionAll [] = 0 -setUnionAll [x] = Set.size x -setUnionAll (x:y:z) = setUnionAll (xy:z) where xy = Set.union x y -- | cardinal number of an intersection of a set and a list of sets setIntersectNotOne :: Ord a => Set.Set a -> [Set.Set a] -> Int setIntersectNotOne _ [] = 0 -setIntersectNotOne k r = Set.size $ Set.intersection k others where others = setUnionOthers r - --- | Union of a list of sets -setUnionOthers :: Ord a => [Set.Set a] -> Set.Set a -setUnionOthers [] = Set.empty -setUnionOthers [x] = x -setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y - --- | cardinal number of a Set -setIntersectionAll :: Ord a => [Set.Set a] -> Int -setIntersectionAll [] = 0 -setIntersectionAll [x] = Set.size x -setIntersectionAll (x:y:z) = setIntersectionAll (xy:z) where xy = Set.intersection x y +setIntersectNotOne k r = Set.size $ Set.intersection k others where others = Set.unions r ---------------------------------- --- Functions fro Particiants.hs -- +-- Functions for Particiants.hs -- ---------------------------------- --- | list of values of a Map with Sets as values -getAllUserIdsSetList :: Map.Map a (Set b) -> [Set b] -getAllUserIdsSetList m = loop (Map.toList m) [] where - loop [] uids = uids - loop ((_,v):xs) uids = loop xs $ uids ++ [v] - --- | value of a Map with given key -getUserIdsOfOneCourse :: (Ord a, Ord b) => Map.Map a (Set b) -> a -> Set b -getUserIdsOfOneCourse m cid - |m == Map.empty = Set.empty - |otherwise = m Map.! cid - -- | extracts from a map a list of values (sets) without one specific entry (a) -getAllUserIdsWithoutOne :: (Ord a, Ord b) => Map.Map a (Set b) -> a -> [Set b] -getAllUserIdsWithoutOne m cid - |m == Map.empty = [] - |otherwise = getAllUserIdsSetList $ Map.delete cid m +getAllElemsWithoutOne :: (Ord a) => Map.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 :: (Ord a, Ord b) => Map.Map a (Set b) -> Map.Map a Int mapIntersectNotOne m = loop (Map.toList m) Map.empty where loop [] ino = ino - loop ((k,_):xs) ino = loop xs $ Map.insert k (setIntersectNotOne (getUserIdsOfOneCourse m k) (getAllUserIdsWithoutOne m k)) ino + loop ((k,_):xs) ino = loop xs $ Map.insert k (setIntersectNotOne (Map.findWithDefault Set.empty k m) (getAllElemsWithoutOne m k)) ino ----------------------------- -- Functions from Utils.hs -- From d6ce0c47d92fac76ccdc59805fcdbd3ad932d3e3 Mon Sep 17 00:00:00 2001 From: ros Date: Wed, 26 May 2021 17:16:47 +0200 Subject: [PATCH 8/8] feat(participants): corrections 2 --- .../courses/participants/de-de-formal.msg | 4 +-- .../categories/courses/participants/en-eu.msg | 4 +-- src/Handler/Participants.hs | 4 +-- src/Utils.hs | 2 +- src/Utils/Set.hs | 26 +++++++++---------- templates/participants-intersect.hamlet | 4 +-- 6 files changed, 22 insertions(+), 22 deletions(-) diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg index 0a169d688..023280fb6 100644 --- a/messages/uniworx/categories/courses/participants/de-de-formal.msg +++ b/messages/uniworx/categories/courses/participants/de-de-formal.msg @@ -7,5 +7,5 @@ CourseParticipantsRegisteredWithoutField n@Int: #{n} #{pluralDE n "Teilnehmeri:i ParticipantsCsvSheetName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Kursteilnehmer:innen 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 +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 3d110bd7e..e67ae634c 100644 --- a/messages/uniworx/categories/courses/participants/en-eu.msg +++ b/messages/uniworx/categories/courses/participants/en-eu.msg @@ -7,5 +7,5 @@ CourseParticipantsRegisteredWithoutField n: #{n} #{pluralEN n "participant was" 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 +AllUsersUnion: Union of all participants +AllUsersIntersection: Intersection of all participants \ No newline at end of file diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 8b8ac1c65..cbeb69ab2 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -110,9 +110,9 @@ postParticipantsIntersectR = do -> 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 - let allUsersUnion = Set.size.Set.unions $ Map.elems courseUsers + let allUsersUnion = Set.size . Set.unions $ Map.elems courseUsers let mapIntersect = mapIntersectNotOne courseUsers - let allUsersIntersection = Set.size.setIntersections $ Map.elems courseUsers + let allUsersIntersection = Set.size . setIntersections $ Map.elems courseUsers return (courses, intersections', mapIntersect, allUsersUnion, allUsersIntersection) let diff --git a/src/Utils.hs b/src/Utils.hs index e87607e96..0ba53c9fc 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -566,7 +566,7 @@ withoutSubsequenceBy cmp = go [] ---------- -- Sets -- ---------- --- all functions that used to be here are now in Utils/Set.hs +-- 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 index a74a1db58..01794701e 100644 --- a/src/Utils/Set.hs +++ b/src/Utils/Set.hs @@ -19,27 +19,27 @@ import Control.Lens -- | cardinal number of an intersection of a set and a list of sets -setIntersectNotOne :: Ord a => Set.Set a -> [Set.Set a] -> Int +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 Particiants.hs -- ----------------------------------- +---------------------------------------- +-- Functions for Handler.Participants -- +---------------------------------------- -- | extracts from a map a list of values (sets) without one specific entry (a) -getAllElemsWithoutOne :: (Ord a) => Map.Map a (Set b) -> a -> [Set b] +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 :: (Ord a, Ord b) => Map.Map a (Set b) -> Map.Map a Int -mapIntersectNotOne m = loop (Map.toList m) Map.empty where - loop [] ino = ino - loop ((k,_):xs) ino = loop xs $ Map.insert k (setIntersectNotOne (Map.findWithDefault Set.empty k m) (getAllElemsWithoutOne m k)) ino - ------------------------------ --- Functions from Utils.hs -- ------------------------------ +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 diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet index 573c8726f..eeaa544a0 100644 --- a/templates/participants-intersect.hamlet +++ b/templates/participants-intersect.hamlet @@ -30,8 +30,8 @@ $maybe (courses, intersections, mapIntersect, allUsersUnion, allUsersIntersectio

#{num}

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

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