feat(participants): basic funktions added
This commit is contained in:
parent
a4bd1159c2
commit
b96327b18d
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user