1import Data.List (nub)
 2import qualified Data.Map.Strict as Map
 3import qualified Data.Set as Set
 4
 5type Vertex = Int
 6type Edge = (Vertex, Vertex)
 7newtype Lists = Lists ([Vertex], [Edge]) deriving (Eq, Show)
 8newtype Adjacency = Adjacency [(Vertex, [Vertex])] deriving (Eq, Show)
 9newtype Paths = Paths [[Vertex]] deriving (Eq, Show)
10newtype G = G (Map.Map Vertex (Set.Set Vertex)) deriving (Eq, Show)
11
12normalize (u,v) | u <= v = (u,v)
13                | otherwise = (v,u)

 1class ConvertibleGraph g where
 2  canonical :: g -> (Set.Set Vertex, Set.Set Edge)
 3
 4instance ConvertibleGraph Lists where
 5  canonical (Lists (vs,es)) =
 6    (Set.fromList vs, Set.fromList (map normalize es))
 7
 8instance ConvertibleGraph Adjacency where
 9  canonical (Adjacency rows) =
10    (Set.fromList (map fst rows),
11     Set.fromList [normalize (u,v) | (u,ns) <- rows, v <- ns])
12
13instance ConvertibleGraph Paths where
14  canonical (Paths ps) =
15    (Set.fromList (concat ps),
16     Set.fromList [normalize e | path <- ps, e <- zip path (drop 1 path)])
17
18instance ConvertibleGraph G where
19  canonical (G graph) =
20    (Map.keysSet graph,
21     Set.fromList [normalize (u,v) | (u,ns) <- Map.toList graph
22                                   , v <- Set.toList ns])

 1toLists graph = Lists (Set.toList vs, Set.toList es)
 2  where (vs,es) = canonical graph
 3
 4toAdjacency graph = Adjacency
 5  [(v, [other v e | e <- Set.toList es, contains v e]) | v <- Set.toList vs]
 6  where
 7    (vs,es) = canonical graph
 8    contains v (a,b) = v == a || v == b
 9    other v (a,b) = if v == a then b else a
10
11toPaths graph = Paths
12  (map (\(u,v) -> [u,v]) (Set.toList es) ++ map (:[]) isolated)
13  where
14    (vs,es) = canonical graph
15    touched = Set.fromList [x | (u,v) <- Set.toList es, x <- [u,v]]
16    isolated = Set.toList (Set.difference vs touched)
17
18toG graph = G $ Set.foldl addEdge base es
19  where
20    (vs,es) = canonical graph
21    base = Map.fromSet (const Set.empty) vs
22    addEdge m (u,v) = Map.insertWith Set.union u (Set.singleton v)
23                    $ Map.insertWith Set.union v (Set.singleton u) m

 1class ToAdjacencyMap g where
 2  adjacencyMap :: g -> Map.Map Vertex (Set.Set Vertex)
 3
 4instance ToAdjacencyMap Lists where
 5  adjacencyMap (Lists (vertices, edges)) = foldl addUndirected base edges
 6    where base = Map.fromList [(vertex, Set.empty) | vertex <- vertices]
 7
 8instance ToAdjacencyMap Adjacency where
 9  adjacencyMap (Adjacency rows) = foldl addUndirected base edges
10    where
11      base = Map.fromList [(vertex, Set.empty) | (vertex, _) <- rows]
12      edges = [(vertex, neighbor) | (vertex, neighbors) <- rows
13                                  , neighbor <- neighbors]
14
15instance ToAdjacencyMap Paths where
16  adjacencyMap (Paths paths) = foldl addUndirected base edges
17    where
18      base = Map.fromList [(vertex, Set.empty) | vertex <- concat paths]
19      edges = concatMap (\path -> zip path (drop 1 path)) paths
20
21instance ToAdjacencyMap G where
22  adjacencyMap (G graph) = graph
23
24addUndirected :: Map.Map Vertex (Set.Set Vertex) -> Edge
25              -> Map.Map Vertex (Set.Set Vertex)
26addUndirected graph (u, v) =
27  Map.insertWith Set.union u (Set.singleton v)
28    (Map.insertWith Set.union v (Set.singleton u) graph)
29
30toListsViaMap :: ToAdjacencyMap g => g -> Lists
31toListsViaMap graph = Lists (Map.keys table, edges)
32  where
33    table = adjacencyMap graph
34    edges = [(u, v) | (u, neighbors) <- Map.toList table
35                    , v <- Set.toList neighbors, u <= v]
36
37toAdjacencyViaMap :: ToAdjacencyMap g => g -> Adjacency
38toAdjacencyViaMap graph = Adjacency
39  [(vertex, Set.toList neighbors)
40  | (vertex, neighbors) <- Map.toList (adjacencyMap graph)]
41
42toPathsViaMap :: ToAdjacencyMap g => g -> Paths
43toPathsViaMap graph = Paths
44  (map (\(u, v) -> [u, v]) edges ++ map (:[]) isolated)
45  where
46    table = adjacencyMap graph
47    Lists (_, edges) = toListsViaMap graph
48    isolated = [vertex | (vertex, neighbors) <- Map.toList table
49                       , Set.null neighbors]
50
51toGViaMap :: ToAdjacencyMap g => g -> G
52toGViaMap = G . adjacencyMap

1>>> canonical (toG (Paths [[1,2,3],[1,3],[4]])) ==
2... canonical (Lists ([1,2,3,4],[(1,2),(2,3),(1,3)]))
3True
4>>> canonical (toGViaMap (Paths [[1,2,3],[1,3],[4]])) ==
5... canonical (toG (Paths [[1,2,3],[1,3],[4]]))
6True