+%************************************************************************
+%* *
+%* Graphs and Graph Construction
+%* *
+%************************************************************************
+
+Note [Nodes, keys, vertices]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * A 'node' is a big blob of client-stuff
+
+ * Each 'node' has a unique (client) 'key', but the latter
+ is in Ord and has fast comparison
+
+ * Digraph then maps each 'key' to a Vertex (Int) which is
+ arranged densely in 0.n
+
+\begin{code}
+data Graph node = Graph {
+ gr_int_graph :: IntGraph,
+ gr_vertex_to_node :: Vertex -> node,
+ gr_node_to_vertex :: node -> Maybe Vertex
+ }
+
+data Edge node = Edge node node
+
+emptyGraph :: Graph a
+emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
+
+graphFromVerticesAndAdjacency
+ :: Ord key
+ => [(node, key)]
+ -> [(key, key)] -- First component is source vertex key,
+ -- second is target vertex key (thing depended on)
+ -- Unlike the other interface I insist they correspond to
+ -- actual vertices because the alternative hides bugs. I can't
+ -- do the same thing for the other one for backcompat reasons.
+ -> Graph (node, key)
+graphFromVerticesAndAdjacency [] _ = emptyGraph
+graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vertex . key_extractor)
+ where key_extractor = snd
+ (bounds, vertex_node, key_vertex, _) = reduceNodesIntoVertices vertices key_extractor
+ key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a,
+ expectJust "graphFromVerticesAndAdjacency" $ key_vertex b)
+ reduced_edges = map key_vertex_pair edges
+ graph = buildG bounds reduced_edges
+
+graphFromEdgedVertices
+ :: Ord key
+ => [(node, key, [key])] -- The graph; its ok for the
+ -- out-list to contain keys which arent
+ -- a vertex key, they are ignored
+ -> Graph (node, key, [key])
+graphFromEdgedVertices [] = emptyGraph
+graphFromEdgedVertices edged_vertices = Graph graph vertex_fn (key_vertex . key_extractor)
+ where key_extractor (_, k, _) = k
+ (bounds, vertex_fn, key_vertex, numbered_nodes) = reduceNodesIntoVertices edged_vertices key_extractor
+ graph = array bounds [(v, mapMaybe key_vertex ks) | (v, (_, _, ks)) <- numbered_nodes]
+
+reduceNodesIntoVertices
+ :: Ord key
+ => [node]
+ -> (node -> key)
+ -> (Bounds, Vertex -> node, key -> Maybe Vertex, [(Int, node)])
+reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_vertex, numbered_nodes)
+ where
+ max_v = length nodes - 1
+ bounds = (0, max_v) :: (Vertex, Vertex)
+
+ sorted_nodes = let n1 `le` n2 = (key_extractor n1 `compare` key_extractor n2) /= GT
+ in sortLe le nodes
+ numbered_nodes = zipWith (,) [0..] sorted_nodes
+
+ key_map = array bounds [(i, key_extractor node) | (i, node) <- numbered_nodes]
+ vertex_map = array bounds numbered_nodes
+
+ --key_vertex :: key -> Maybe Vertex
+ -- returns Nothing for non-interesting vertices
+ key_vertex k = find 0 max_v
+ where
+ find a b | a > b = Nothing
+ | otherwise = let mid = (a + b) `div` 2
+ in case compare k (key_map ! mid) of
+ LT -> find a (mid - 1)
+ EQ -> Just mid
+ GT -> find (mid + 1) b
+\end{code}