-
Notifications
You must be signed in to change notification settings - Fork 0
/
HyperGraph.hs
59 lines (46 loc) · 1.91 KB
/
HyperGraph.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
import Concepts
import qualified Data.Set as Set
data Graph a = Graph (Set.Set (Node a)) (Set.Set (Edge a a))
data Edge a b = Edge (Node a) (Node b)
deriving (Eq, Ord)
data Node a = Node a
deriving (Eq, Ord)
data BipartiteGraph a b = BipartiteGraph
(Set.Set (Node a)) -- Node set a
(Set.Set (Node b)) -- Node set b
(Set.Set (Edge a b)) -- Edges from a to b
(Set.Set (Edge b a)) -- Edges from b to a
instance Show a => Show (Graph a) where
show (Graph ns es) = "digraph G {\n"
++ (unlines $ map show $ Set.toList ns)
++ (unlines $ map show $ Set.toList es)
++ "}"
instance (Show a, Show b) => Show (Edge a b) where
show (Edge n n') = (show n) ++ " -> " ++ (show n')
instance Show a => Show (Node a) where
show (Node n) = map (\c -> if c == ' ' || c == '"' then '_' else c) $ show n
instance (Show a, Show b) => Show (BipartiteGraph a b) where
show (BipartiteGraph ns ns' es es') = "digraph G {\n"
++ "{ node [shape=box]\n"
++ (unlines $ map show $ Set.toList ns)
++ "}\n\n"
++ "{ node [shape=ellipse]\n"
++ (unlines $ map show $ Set.toList ns')
++ "}\n\n"
++ (unlines $ map show $ Set.toList es)
++ "\n"
++ (unlines $ map show $ Set.toList es')
++ "}"
main :: IO ()
main = do
print graph
where
graph = BipartiteGraph
(Set.fromList resourceNodes) (Set.fromList conceptNodes)
(Set.fromList resourceEdges) (Set.fromList conceptEdges)
resourceNodes = map Node resources
conceptNodes = map Node concepts
resourceEdges = map (\(ResourceMap _ r c) -> Edge (Node r) (Node c))
$ filter (\(ResourceMap d _ _) -> d == Teaches) resourceMaps
conceptEdges = map (\(ResourceMap _ r c) -> Edge (Node c) (Node r))
$ filter (\(ResourceMap d _ _) -> d == Requires) resourceMaps