This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.

Graph

This module contains the primitives to build, update and traverse graphs. If you find that this module is hard to use or the documentation is insufficient, consider opening an issue for that (and possibly even a pull request :)).

Internally, we use the elm-intdict package for efficient dynamic graph representation.

Data

type alias NodeId = Int

The type used for identifying nodes, an integer.

type alias Node n = { id : NodeId , label : n }

The type representing a node: An identifier with a label.

type alias Edge e = { from : NodeId , to : NodeId , label : e }

Represents a directd edge in the graph. In addition to start and end node identifiers, a label value can be attached to an edge.

type alias Adjacency e = IntDict e

Adjacency is represented as an ordered dictionary rather than as an ordered list. This enables more dynamic graphs with efficient edge removal and insertion on the run.

type alias NodeContext n e = { node : Node n , incoming : Adjacency e , outgoing : Adjacency e }

Represents a node with its incoming and outgoing edges (predecessors and successors).

type Graph n e = Graph (GraphRep n e)

The central graph type. It is parameterized both over the node label type n and the edge label type e.

One can build such a graph with the primitives under Build. Most of the time fromNodesAndEdges works fairly well.

For simplicity, this library just uses a patricia trie based graph representation, which means it is just an efficient version of Dict NodeId (NodeContext n e). This allows efficient insertion and removal of nodes of the graph after building.

Building

empty : Graph n e

An empty graph.

size empty == 0
update : NodeId -> (Maybe (NodeContext n e) -> Maybe (NodeContext n e)) -> Graph n e -> Graph n e

Analogous to Dict.update, update nodeId updater graph will find the node context of the node with id nodeId in graph. It will then call updater with Just that node context if that node was found and Nothing otherwise. updater can then return Just an updated node context (modifying edges is also permitted!) or delete the node by returning Nothing. The updated graph is returned.

This is the most powerful building function since all possible per-node operations are possible (node removal, insertion and updating of context properties).

The other operations can be implemented in terms of update like this:

remove nodeId graph =
  update nodeId (always Nothing) graph
insert nodeContext graph =
  update nodeContext.node.id (always (Just nodeContext)) graph
insert : NodeContext n e -> Graph n e -> Graph n e

Analogous to Dict.insert, insert nodeContext graph inserts a fresh node with its context (label, id and edges) into graph. If there was already a node with the same id, it will be replaced by the new node context.

graph1 = fromNodesAndEdges [Node 1 "1"] []
newNode =
  { node = Node 2 "2"
  , incoming = IntDict.singleton 1 () -- so there will be an edge from 1 to 2
  , outgoing = IntDict.empty
  }
graph2 = insert newNode graph1
size graph2 == 2

It's possible to build up whole graphs this way, but a lot less tedious way would be simply to use fromNodesAndEdges.

remove : NodeId -> Graph n e -> Graph n e

Analogous to Dict.remove, remove nodeId graph returns a version of graph without a node with id nodeId. If there was no node with that id, then remove is a no-op:

graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 ()]
graph == remove 42 graph
graph |> remove 2 |> size == 1
inducedSubgraph : List NodeId -> Graph n e -> Graph n e

The induced subgraph of a number of node ids.

Query

isEmpty : Graph n e -> Bool

isEmpty graph is true if and only if there are no nodes in the graph. Some properties to reason about in code, which hold for any graph:

isEmpty graph =
  graph == empty
isEmpty graph =
  size graph == 0
size : Graph n e -> Int

size graph returns the number of nodes in graph.

size empty == 0
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
size graph == 2
member : NodeId -> Graph n e -> Bool

Analogous to Dict.member, member nodeId graph is true, if and only if there is a node with id nodeId in graph.

graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
member 42 graph == False
member 1 graph == True
get : NodeId -> Graph n e -> Maybe (NodeContext n e)

Analogous to Dict.get, get nodeId graph returns the Just the node context with id nodeId in graph if there is one and Nothing otherwise.

graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
get 42 graph == Nothing
get 1 graph == Just <node context of node 1>
nodeIdRange : Graph n e -> Maybe (NodeId, NodeId)

nodeIdRange graph returns Just (minNodeId, maxNodeId) if graph is not empty and Nothing otherwise.

This is useful for finding unoccupied node ids without trial and error.

nodeIdRange empty == Nothing
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
nodeIdRange graph == Just (1, 2)

List representations

nodeIds : Graph n e -> List (NodeId)

nodeIds graph returns a list of all nodes' ids in graph.

nodeIds empty == []
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
nodeIds graph == [1, 2]
nodes : Graph n e -> List (Node n)

nodes graph returns a list of all Nodes (e.g. id and label) in graph.

nodes empty == []
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
nodes graph == [Node 1 "1", Node 2 "2"]
edges : Graph n e -> List (Edge e)

edges graph returns a list of all Edges (e.g. a record of from and to ids and a label) in graph.

edges empty == []
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
edges graph == [Edge 1 2 "->"]
fromNodesAndEdges : List (Node n) -> List (Edge e) -> Graph n e

fromNodesAndEdges nodes edges constructs a graph from the supplied nodes and edges. This is the most comfortable way to construct a graph as a whole. Oftentimes it is even more convenient to use fromNodeLabelsAndEdgePairs when edges are unlabeled anyway and auto incremented node ids are OK.

The following constructs a graph with 2 nodes with a string label, connected by an edge labeled "->".

graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
fromNodeLabelsAndEdgePairs : List n -> List (NodeId, NodeId) -> Graph n ()

A more convenient version of fromNodesAndEdges, when edges are unlabeled and there are no special requirements on node ids.

fromNodeLabelsAndEdgePairs labels edges implicitly assigns node ids according to the label's index in labels and the list of edge pairs is converted to unlabeled Edges.

graph = fromNodeLabelsAndEdgePairs ['a', 'b'] [(0, 1)]

Foci

id : Focus { record | id : field } field

Focus for the id field of Node.

label : Focus { record | label : field } field

Focus for the label field of Node and Edge.

from : Focus { record | from : field } field

Focus for the from field of Edge.

to : Focus { record | to : field } field

Focus for the to field of Edge.

node : Focus { record | node : field } field

Focus for the node field of NodeContext.

incoming : Focus { record | incoming : field } field

Focus for the incoming field of NodeContext.

outgoing : Focus { record | outgoing : field } field

Focus for the outgoing field of NodeContext.

nodeById : NodeId -> Focus (Graph n e) (Maybe (NodeContext n e))

nodeById nodeId focuses on the node with id nodeId with a Graph. Since the node might or might not exist, the small part on which we focus wraps the NodeContext in a Maybe.

This is a combination of the get and update functions which is handy for composition of foci deep into a graph. Unfortunately, we need a combinator which would get rid of the Maybe wrapping (that would be the task of a prism I think), but suppose we have something like Focus.withDefault : a -> Focus (Maybe a) a, then we could define

ctx = NodeContext (Node 2 "2") IntDict.empty IntDict.empty
focus = nodeById 2 => Focus.withDefault ctx => node => label
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
graph1 = Focus.set focus graph "="
Focus.get focus graph1 == "="

Well, I hope I could bring over the point.

anyNode : Focus (Graph n e) (Maybe (NodeContext n e))

Focuses on an arbitrary NodeContext of a Graph. This exists for the same purposes as nodeById, but this focuses on an arbitrary node rather than on a node with a specific id.

Transforms

fold : (NodeContext n e -> acc -> acc) -> acc -> Graph n e -> acc

A fold over all node contexts. The accumulated value is computed lazily, so that the fold can exit early when the suspended accumulator is not forced.

hasLoop ctx = IntDict.member ctx.node.id ctx.incoming
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
-- The graph should not have any loop.
fold (\ctx acc -> acc || hasLoop ctx) False graph == False
mapContexts : (NodeContext n1 e1 -> NodeContext n2 e2) -> Graph n1 e1 -> Graph n2 e2

Maps each node context to another one. This may change edge and node labels (including their types), possibly the node ids and also add or remove edges entirely through modifying the adjacency lists.

The following is a specification for reverseEdges:

flipEdges ctx = { ctx | incoming = ctx.outgoing, outgoing = ctx.incoming }
graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
reverseEdges graph == mapContexts flipEdges graph
mapNodes : (n1 -> n2) -> Graph n1 e -> Graph n2 e

Maps over node labels, possibly changing their types. Leaves the graph topology intact.

mapEdges : (e1 -> e2) -> Graph n e1 -> Graph n e2

Maps over edge labels, possibly chaing their types. Leaves the graph topology intact.

reverseEdges : Graph n e -> Graph n e

Reverses the direction of every edge in the graph.

symmetricClosure : (NodeId -> NodeId -> e -> e -> e) -> Graph n e -> Graph n e

symmetricClosure edgeMerger graph is the symmetric closure of graph, e.g. the undirected equivalent, where for every edge in graph there is also a corresponding reverse edge. This implies that ctx.incoming == ctx.outgoing for each node context ctx.

edgeMerger resolves conflicts for when there are already edges in both directions, e.g. the graph isn't truly directed. It is guaranteed that edgeMerger will only be called with the smaller node id passed in first to enforce consitency of merging decisions.

graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
onlyUndirectedEdges ctx =
  ctx.incoming == ctx.outgoing
merger from to outgoingLabel incomingLabel =
  outgoingLabel -- quite arbitrary, will not be called for the above graph
fold
  (\ctx acc -> acc && onlyUndirectedEdges ctx)
  True
  (symmetricClosure merger graph)
  == True

Characterization

Traversals

Neighbor selectors and node visitors

type alias NeighborSelector n e = NodeContext n e -> List NodeId

Selects the next neighbors for the currently visited node in the traversal.

alongOutgoingEdges : NeighborSelector n e

A good default for selecting neighbors is to just go along outgoing edges:

alongOutgoingEdges ctx =
  IntDict.keys (ctx.outgoing)

dfs/bfs use this as their selecting strategy.

alongIncomingEdges : NeighborSelector n e

A less common way for selecting neighbors is to follow incoming edges:

alongIncomingEdges ctx =
  IntDict.keys (ctx.incoming)
type alias SimpleNodeVisitor n e acc = NodeContext n e -> acc -> acc

A generic node visitor just like that in the ordinary fold function. There are combinators that make these usable for both depth-first traversal (onDiscovery, onFinish) and breadth-first traversal (ignorePath).

Depth-first

type alias DfsNodeVisitor n e acc = NodeContext n e -> acc -> (acc, acc -> acc)

A node visitor specialized for depth-first traversal. Along with the node context of the currently visited node, the current accumulated value is passed. The visitor then has the chance to both modify the value at discovery of the node through the first return value and also provide a finishing transformation which is called with the value after all children were processed and the node is about to be finished.

In the cases where you don't need access to the value both at dicovery and at finish, look into onDiscovery and onFinish.

onDiscovery : SimpleNodeVisitor n e acc -> DfsNodeVisitor n e acc

Transform a SimpleNodeVisitor into an equivalent DfsNodeVisitor, which will be called upon node discovery. This eases providing DfsNodeVisitors in the default case:

dfsPostOrder : Graph n e  -> List (NodeContext n e)
dfsPostOrder graph =
  dfs (onDiscovery (::)) [] graph
onFinish : SimpleNodeVisitor n e acc -> DfsNodeVisitor n e acc

Transform a SimpleNodeVisitor into an equivalent DfsNodeVisitor, which will be called upon node finish. This eases providing DfsNodeVisitors in the default case:

dfsPreOrder : Graph n e  -> List (NodeContext n e)
dfsPreOrder graph =
  dfs (onFinish (::)) [] graph
dfs : DfsNodeVisitor n e acc -> acc -> Graph n e -> acc

An off-the-shelf depth-first traversal. It will visit all components of the graph in no guaranteed order, discovering nodes alongOutgoingEdges. See the docs of DfsNodeVisitor on how to supply such a beast. There are also examples on how to use dfs.

dfsTree : NodeId -> Graph n e -> Tree (NodeContext n e)

dfsTree seed graph computes a depth-first spanning tree of the component in graph starting from seed alongOutgoingEdges. This function is exemplary for needing to utilize the whole power of DfsNodeVisitor.

dfsForest : List NodeId -> Graph n e -> Forest (NodeContext n e)

dfsForest seeds graph computes a depth-first spanning Forest of the components in graph spanned by seeds alongOutgoingEdges.

A traversal over this forest would be equivalent to a depth-first traversal over the original graph.

guidedDfs : NeighborSelector n e -> DfsNodeVisitor n e acc -> List NodeId -> acc -> Graph n e -> (acc, Graph n e)

The dfs* functions are not powerful enough? Go for this beast.

guidedDfs selectNeighbors visitNode seeds acc graph will perform a depth-first traversal on graph starting with a stack of seeds. The children of each node will be selected with selectNeighbors (see NeighborSelector), the visiting of nodes is handled by visitNode (c.f. DfsNodeVisitor), folding acc over the graph.

When there are not any more nodes to be visited, the function will return the accumulated value together with the unvisited rest of graph.

dfsPreOrder graph =
  -- NodeId 1 is just a wild guess here
  guidedDfs alongOutgoingEdges (onDiscovery (::)) [1] [] graph

Breadth-first

type alias BfsNodeVisitor n e acc = List (NodeContext n e) -> Int -> acc -> acc

A specialized node visitor for breadth-first traversal. Compared to a SimpleNodeVisitor, the path of contexts from the root to the current node is passed instead of just the current node's context. Additionally, the distance from the root is passed as an Int (the root has distance 0 and it holds always that length path == distance - 1).

If you don't need the additional information, you can turn a SimpleNodeVisitor into a BfsNodeVisitor by calling ignorePath.

ignorePath : SimpleNodeVisitor n e acc -> BfsNodeVisitor n e acc

Turns a SimpleNodeVisitor into a BfsNodeVisitor by ignoring the path and distance parameters. This is useful for when the visitor should be agnostic of the traversal (breadth-first or depth-first or even just fold).

bfsLevelOrder : List (NodeContext n e)
bfsLevelOrder graph =
  graph
    |> bfs (ignorePath (::)) []
    |> List.reverse
bfs : BfsNodeVisitor n e acc -> acc -> Graph n e -> acc

An off-the-shelf breadth-first traversal. It will visit all components of the graph in no guaranteed order, discovering nodes alongOutgoingEdges. See the docs of BfsNodeVisitor on how to supply such a beast. There are also examples on how to use bfs.

guidedBfs : NeighborSelector n e -> BfsNodeVisitor n e acc -> List NodeId -> acc -> Graph n e -> (acc, Graph n e)

The bfs function is not powerful enough? Go for this beast.

guidedBfs selectNeighbors visitNode seeds acc graph will perform a breadth-first traversal on graph starting with a queue of seeds. The children of each node will be selected with selectNeighbors (see NeighborSelector), the visiting of nodes is handled by visitNode (c.f. BfsNodeVisitor), folding acc over the graph.

When there are not any more nodes to be visited, the function will return the accumulated value together with the unvisited rest of graph.

bfsLevelOrder graph =
  -- NodeId 1 is just a wild guess here
  guidedBfs alongOutgoingEdges (ignorePath (::)) [1] [] graph

Topological Sort

topologicalSort : Graph n e -> List (NodeContext n e)

Computes a topological ordering of the given graph.

heightLevels : Graph n e -> List (List (NodeContext n e))

Computes the height function of a given graph. This is a more general topological sort, where independent nodes are in the same height level (e.g. the same list index). A valid topological sort is trivially obtained by flattening the result of this function.

The height function is useful for solving the maximal clique problem for certain perfect graphs (comparability graphs). There is the excellent reference Algorithmic Graph Theory and Perfect Graphs.

Strongly Connected Components

stronglyConnectedComponents : Graph n e -> List (Graph n e)

Decomposes a graph into its strongly connected components. The resulting list is a topological ordering of the component graph.

String representation

module Graph exposing
  -- Data
  ( NodeId, Node, Edge, Adjacency, NodeContext, Graph
  -- Building
  , empty, update, insert, remove, inducedSubgraph
  -- Query
  , isEmpty, size, member, get, nodeIdRange
  -- List representations
  , nodeIds, nodes, edges, fromNodesAndEdges, fromNodeLabelsAndEdgePairs
  -- Foci
  , id, label, from, to, node, incoming, outgoing
  , nodeById, anyNode

  -- Transforms
  , fold, mapContexts, mapNodes, mapEdges
  , symmetricClosure, reverseEdges

  -- Characterization

  -- Traversals
  , NeighborSelector, alongOutgoingEdges, alongIncomingEdges, SimpleNodeVisitor
  -- DFS
  , DfsNodeVisitor, onDiscovery, onFinish, dfs, dfsTree, dfsForest, guidedDfs
  -- BFS
  , BfsNodeVisitor, ignorePath, bfs, guidedBfs

  -- Topological sort
  , heightLevels, topologicalSort
  -- Strongly connected components
  , stronglyConnectedComponents

  -- String representation
  , toString'
  )

{-| This module contains the primitives to build, update and traverse graphs.
If you find that this module is hard to use or the documentation
is insufficient, consider opening an issue for that (and possibly even a
pull request :)).

Internally, we use the `elm-intdict` package for efficient dynamic graph
representation.

# Data
@docs NodeId, Node, Edge, Adjacency, NodeContext, Graph

# Building
@docs empty, update, insert, remove, inducedSubgraph

# Query
@docs isEmpty, size, member, get, nodeIdRange

# List representations
@docs nodeIds, nodes, edges, fromNodesAndEdges, fromNodeLabelsAndEdgePairs

# Foci
@docs id, label, from, to, node, incoming, outgoing, nodeById, anyNode

# Transforms
@docs fold, mapContexts, mapNodes, mapEdges, reverseEdges, symmetricClosure

# Characterization

# Traversals
## Neighbor selectors and node visitors
@docs NeighborSelector, alongOutgoingEdges, alongIncomingEdges, SimpleNodeVisitor
## Depth-first
@docs DfsNodeVisitor, onDiscovery, onFinish, dfs, dfsTree, dfsForest, guidedDfs
## Breadth-first
@docs BfsNodeVisitor, ignorePath, bfs, guidedBfs

# Topological Sort
@docs topologicalSort, heightLevels

# Strongly Connected Components
@docs stronglyConnectedComponents

# String representation
@docs toString'

-}

import Graph.Tree as Tree exposing (Tree, Forest)
import IntDict as IntDict exposing (IntDict)
import Maybe as Maybe exposing (Maybe)
import Focus as Focus exposing (Focus, (=>))
import Queue as Queue exposing (Queue)
import Debug


{-| The type used for identifying nodes, an integer.
-}
type alias NodeId =
  Int


{-| The type representing a node: An identifier with
a label.
-}
type alias Node n =
  { id : NodeId
  , label : n
  }


{-| Represents a directd edge in the graph. In addition
to start and end node identifiers, a label value can
be attached to an edge.
-}
type alias Edge e =
  { from : NodeId
  , to : NodeId
  , label : e
  }


{-| Adjacency is represented as an ordered dictionary
rather than as an ordered list. This enables more dynamic
graphs with efficient edge removal and insertion on the run.
-}
type alias Adjacency e =
  IntDict e


{-| Represents a node with its incoming and outgoing edges
(predecessors and successors).
-}
type alias NodeContext n e =
  { node : Node n
  , incoming : Adjacency e
  , outgoing : Adjacency e
  }


-- We will only have the Patricia trie based DynGraph implementation for simplicity.
-- Also, there is no real practical reason to separate that or to allow other implementations
-- which would justify the complexity.

type alias GraphRep n e =
  IntDict (NodeContext n e)

{-| The central graph type. It is parameterized both over the node label type `n`
and the edge label type `e`.

One can build such a graph with the primitives under *Build*. Most of the time
`fromNodesAndEdges` works fairly well.

For simplicity, this library just uses a patricia trie based graph representation, which means
it is just an efficient version of `Dict NodeId (NodeContext n e)`. This allows efficient insertion and
removal of nodes of the graph after building.
-}
type Graph n e =
  Graph (GraphRep n e)


unGraph : Graph n e -> GraphRep n e
unGraph graph =
  case graph of Graph rep -> rep


{- BUILD -}

{-| An empty graph.

    size empty == 0
-}
empty : Graph n e
empty =
  Graph IntDict.empty


type EdgeUpdate e =
  Insert e
  | Remove e


type alias EdgeDiff e =
  { incoming : IntDict (EdgeUpdate e)
  , outgoing : IntDict (EdgeUpdate e)
  }


emptyDiff : EdgeDiff e
emptyDiff =
  { incoming = IntDict.empty
  , outgoing = IntDict.empty
  }


computeEdgeDiff : Maybe (NodeContext n e) -> Maybe (NodeContext n e) -> EdgeDiff e
computeEdgeDiff old new =
  let
    collectUpdates edgeUpdate updatedId label =
      let
        replaceUpdate old =
          case (old, edgeUpdate label) of
            (Just (Remove oldLbl), (Insert newLbl)) ->
              if oldLbl == newLbl
              then Nothing
              else Just (Insert newLbl)
            (Just (Remove _), (Remove _)) ->
              Debug.crash "Graph.computeEdgeDiff: Collected two removals for the same edge. This is an error in the implementation of Graph and you should file a bug report!"
            (Just (Insert _), _) ->
              Debug.crash "Graph.computeEdgeDiff: Collected inserts before removals. This is an error in the implementation of Graph and you should file a bug report!"
            (Nothing, eu) ->
              Just eu
      in
        IntDict.update updatedId replaceUpdate

    collect edgeUpdate adj updates =
      IntDict.foldl (collectUpdates edgeUpdate) updates adj
  in
    case (old, new) of
      (Nothing, Nothing) ->
        emptyDiff
      (Just rem, Nothing) ->
        { outgoing = IntDict.empty |> collect Remove rem.incoming
        , incoming = IntDict.empty |> collect Remove rem.outgoing
        }
      (Nothing, Just ins) ->
        { outgoing = IntDict.empty |> collect Insert ins.incoming
        , incoming = IntDict.empty |> collect Insert ins.outgoing
        }
      (Just rem, Just ins) ->
        if rem == ins
        then emptyDiff
        else
          { outgoing = IntDict.empty |> collect Remove rem.incoming |> collect Insert ins.incoming
          , incoming = IntDict.empty |> collect Remove rem.outgoing |> collect Insert ins.outgoing
          }


applyEdgeDiff : NodeId -> EdgeDiff e -> GraphRep n e -> GraphRep n e
applyEdgeDiff nodeId diff graphRep =
  let
    foldl' f dict acc =
      IntDict.foldl f acc dict

    edgeUpdateToMaybe edgeUpdate =
      case edgeUpdate of
        Insert lbl -> Just lbl
        Remove _ -> Nothing

    updateAdjacency edgeFocus updatedId edgeUpdate =
      let
        updateLbl =
          Focus.set edgeFocus (edgeUpdateToMaybe edgeUpdate)
      in
        IntDict.update updatedId (Maybe.map updateLbl) -- ignores edges to nodes not in the graph

  in
    graphRep
      |> foldl' (updateAdjacency (incoming => lookup nodeId)) diff.incoming
      |> foldl' (updateAdjacency (outgoing => lookup nodeId)) diff.outgoing


{-| Analogous to `Dict.update`, `update nodeId updater graph` will find
the node context of the node with id `nodeId` in `graph`. It will then call `updater`
with `Just` that node context if that node was found and `Nothing`
otherwise. `updater` can then return `Just` an updated node context
(modifying edges is also permitted!) or delete the node by returning
`Nothing`. The updated `graph` is returned.

This is the most powerful building function since all possible per-node
operations are possible (node removal, insertion and updating of context
properties).

The other operations can be implemented in terms of `update` like this:

    remove nodeId graph =
      update nodeId (always Nothing) graph
    insert nodeContext graph =
      update nodeContext.node.id (always (Just nodeContext)) graph
-}
update : NodeId -> (Maybe (NodeContext n e) -> Maybe (NodeContext n e)) -> Graph n e -> Graph n e
update nodeId updater =
  -- This basically wraps updater so that the edges are consistent.
  -- This is, it cannot use the lookup focus, because it needs to update other contexts, too.
  let
    updater' rep =
      let
        old =
          IntDict.get nodeId rep

        filterInvalidEdges ctx =
          IntDict.filter (\id _ -> id == ctx.node.id || IntDict.member id rep)

        cleanUpEdges ctx =
          ctx
            |> Focus.update incoming (filterInvalidEdges ctx)
            |> Focus.update outgoing (filterInvalidEdges ctx)

        new =
          old
            |> updater
            |> Maybe.map cleanUpEdges

        diff =
          computeEdgeDiff old new
      in
        rep
          |> applyEdgeDiff nodeId diff
          |> IntDict.update nodeId (always new)
  in
    Focus.update graphRep updater'


{-| Analogous to `Dict.insert`, `insert nodeContext graph` inserts a fresh node
with its context (label, id and edges) into `graph`. If there was already a node
with the same id, it will be replaced by the new node context.

    graph1 = fromNodesAndEdges [Node 1 "1"] []
    newNode =
      { node = Node 2 "2"
      , incoming = IntDict.singleton 1 () -- so there will be an edge from 1 to 2
      , outgoing = IntDict.empty
      }
    graph2 = insert newNode graph1
    size graph2 == 2

It's possible to build up whole graphs this way, but a lot less tedious way would
be simply to use `fromNodesAndEdges`.
-}
insert : NodeContext n e -> Graph n e -> Graph n e
insert nodeContext graph =
  update nodeContext.node.id (always (Just nodeContext)) graph


{-| Analogous to `Dict.remove`, `remove nodeId graph` returns a version of `graph`
without a node with id `nodeId`. If there was no node with that id, then remove
is a no-op:

    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 ()]
    graph == remove 42 graph
    graph |> remove 2 |> size == 1
-}
remove : NodeId -> Graph n e -> Graph n e
remove nodeId graph =
  update nodeId (always Nothing) graph


{-| The [induced subgraph](http://mathworld.wolfram.com/Edge-InducedSubgraph.html)
of a number of node ids.
-}
inducedSubgraph : List NodeId -> Graph n e -> Graph n e
inducedSubgraph nodeIds graph =
  let
    insertContextById nodeId acc =
      case get nodeId graph of
        Just ctx ->
          insert ctx acc
        Nothing ->
          acc
  in
    List.foldl insertContextById empty nodeIds


{- QUERY -}


{-| `isEmpty graph` is true if and only if there are no nodes in the graph.
Some properties to reason about in code, which hold for any `graph`:

    isEmpty graph =
      graph == empty
    isEmpty graph =
      size graph == 0
-}
isEmpty : Graph n e -> Bool
isEmpty graph =
  graph == empty


{-| `size graph` returns the number of nodes in `graph`.

    size empty == 0
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    size graph == 2
-}
size : Graph n e -> Int
size =
  Focus.get graphRep >> IntDict.size


{-| Analogous to `Dict.member`, `member nodeId graph` is true, if and only if
there is a node with id `nodeId` in `graph`.

    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    member 42 graph == False
    member 1 graph == True
-}
member : NodeId -> Graph n e -> Bool
member nodeId =
  Focus.get graphRep >> IntDict.member nodeId


{-| Analogous to `Dict.get`, `get nodeId graph` returns the `Just` the node
context with id `nodeId` in `graph` if there is one and `Nothing` otherwise.

    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    get 42 graph == Nothing
    get 1 graph == Just <node context of node 1>
-}
get : NodeId -> Graph n e -> Maybe (NodeContext n e)
get nodeId =
  Focus.get (graphRep => lookup nodeId)


{-| `nodeIdRange graph` returns `Just (minNodeId, maxNodeId)` if `graph` is not empty and `Nothing`
otherwise.

This is useful for finding unoccupied node ids without trial and error.

    nodeIdRange empty == Nothing
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    nodeIdRange graph == Just (1, 2)
-}
nodeIdRange : Graph n e -> Maybe (NodeId, NodeId)
nodeIdRange graph =
  let
    rep =
      Focus.get graphRep graph
  in
    IntDict.findMin rep `Maybe.andThen` \(min, _) ->
    IntDict.findMax rep `Maybe.andThen` \(max, _) ->
    Just (min, max)


{- LIST REPRESENTATIONS -}


{-| `nodes graph` returns a list of all `Node`s (e.g. `id` and `label`) in
`graph`.

    nodes empty == []
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    nodes graph == [Node 1 "1", Node 2 "2"]
-}
nodes : Graph n e -> List (Node n)
nodes =
  Focus.get graphRep >> IntDict.values >> List.map .node


{-| `nodeIds graph` returns a list of all nodes' ids in `graph`.

    nodeIds empty == []
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] []
    nodeIds graph == [1, 2]
-}
nodeIds : Graph n e -> List (NodeId)
nodeIds =
  Focus.get graphRep >> IntDict.keys


{-| `edges graph` returns a list of all `Edge`s (e.g. a record of `from` and `to` ids
and a `label`) in `graph`.

    edges empty == []
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
    edges graph == [Edge 1 2 "->"]
-}
edges : Graph n e -> List (Edge e)
edges graph =
  let
    foldl' f dict list =
      IntDict.foldl f list dict -- dict and list flipped, so that we can use pointfree notation

    prependEdges node1 ctx =
      foldl' (\node2 e -> (::) { to = node2, from = node1, label = e }) ctx.outgoing
  in
    foldl' prependEdges (unGraph graph) []


{-| `fromNodesAndEdges nodes edges` constructs a graph from the supplied `nodes`
and `edges`. This is the most comfortable way to construct a graph as a whole.
Oftentimes it is even more convenient to use `fromNodeLabelsAndEdgePairs` when
edges are unlabeled anyway and auto incremented node ids are OK.

The following constructs a graph with 2 nodes with a string label, connected
by an edge labeled "->".

    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
-}
fromNodesAndEdges : List (Node n) -> List (Edge e) -> Graph n e
fromNodesAndEdges nodes edges =
  let
    nodeRep =
      List.foldl
        (\n ->
          IntDict.insert n.id (NodeContext n IntDict.empty IntDict.empty))
        IntDict.empty
        nodes

    addEdge edge rep =
      let
        updateOutgoing ctx =
          { ctx | outgoing = IntDict.insert edge.to edge.label ctx.outgoing }

        updateIncoming ctx =
          { ctx | incoming = IntDict.insert edge.from edge.label ctx.incoming }
      in
        rep
          |> IntDict.update edge.from (Maybe.map updateOutgoing)
          |> IntDict.update edge.to (Maybe.map updateIncoming)
    in
      Graph (List.foldl addEdge nodeRep edges)


{-| A more convenient version of `fromNodesAndEdges`, when edges are unlabeled
and there are no special requirements on node ids.

`fromNodeLabelsAndEdgePairs labels edges` implicitly assigns node ids according
to the label's index in `labels` and the list of edge pairs is converted to
unlabeled `Edge`s.

    graph = fromNodeLabelsAndEdgePairs ['a', 'b'] [(0, 1)]
-}
fromNodeLabelsAndEdgePairs : List n -> List (NodeId, NodeId) -> Graph n ()
fromNodeLabelsAndEdgePairs labels edges =
  let
    nodes =
      labels
        |> List.foldl
            (\lbl (id, nodes) -> (id + 1, Node id lbl :: nodes))
            (0, [])
        |> snd

    edges' =
      List.map (\(from, to) -> Edge from to ()) edges
  in
    fromNodesAndEdges nodes edges'



{- FOCI -}


{-| Focus for the `id` field of `Node`.
-}
id : Focus { record | id : field } field
id =
  Focus.create .id (\update record -> { record | id = update record.id })


{-| Focus for the `label` field of `Node` and `Edge`.
-}
label : Focus { record | label : field } field
label =
  Focus.create .label (\update record -> { record | label = update record.label })


{-| Focus for the `from` field of `Edge`.
-}
from : Focus { record | from : field } field
from =
  Focus.create .from (\update record -> { record | from = update record.from })


{-| Focus for the `to` field of `Edge`.
-}
to : Focus { record | to : field } field
to =
  Focus.create .to (\update record -> { record | to = update record.to })


{-| Focus for the `node` field of `NodeContext`.
-}
node : Focus { record | node : field } field
node =
  Focus.create .node (\update record -> { record | node = update record.node })


{-| Focus for the `incoming` field of `NodeContext`.
-}
incoming : Focus { record | incoming : field } field
incoming =
  Focus.create .incoming (\update record -> { record | incoming = update record.incoming })


{-| Focus for the `outgoing` field of `NodeContext`.
-}
outgoing : Focus { record | outgoing : field } field
outgoing =
  Focus.create .outgoing (\update record -> { record | outgoing = update record.outgoing })


graphRep : Focus (Graph n e) (GraphRep n e)
graphRep =
  Focus.create unGraph (\update -> unGraph >> update >> Graph)


lookup : NodeId -> Focus (IntDict v) (Maybe v)
lookup nodeId =
  Focus.create (IntDict.get nodeId) (IntDict.update nodeId)


{-|  `nodeById nodeId` focuses on the node with id `nodeId` with a `Graph`.
Since the node might or might not exist, the small part on which we focus wraps
the `NodeContext` in a `Maybe`.

This is a combination of the `get` and `update` functions which is handy for
composition of foci deep into a graph. Unfortunately, we need a combinator which
would get rid of the `Maybe` wrapping (that would be the task of a prism I think),
but suppose we have something like `Focus.withDefault : a -> Focus (Maybe a) a`,
then we could define

    ctx = NodeContext (Node 2 "2") IntDict.empty IntDict.empty
    focus = nodeById 2 => Focus.withDefault ctx => node => label
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
    graph1 = Focus.set focus graph "="
    Focus.get focus graph1 == "="

Well, I hope I could bring over the point.
-}
nodeById : NodeId -> Focus (Graph n e) (Maybe (NodeContext n e))
nodeById nodeId =
  Focus.create (get nodeId) (update nodeId)


{-| Focuses on an arbitrary `NodeContext` of a `Graph`.
This exists for the same purposes as `nodeById`, but this focuses on an
arbitrary node rather than on a node with a specific id.
-}
anyNode : Focus (Graph n e) (Maybe (NodeContext n e))
anyNode =
  let
    getMinId =
      Focus.get graphRep >> IntDict.findMin >> Maybe.map fst

    get graph =
      getMinId graph `Maybe.andThen` \id -> Focus.get (nodeById id) graph

    update upd graph =
      let
        nodeId =
          Maybe.withDefault 0 (getMinId graph)
      in
        Focus.update (nodeById nodeId) upd graph
  in
    Focus.create get update


{- TRANSFORMS -}


{-| A fold over all node contexts. The accumulated value is computed lazily,
so that the fold can exit early when the suspended accumulator is not forced.

    hasLoop ctx = IntDict.member ctx.node.id ctx.incoming
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
    -- The graph should not have any loop.
    fold (\ctx acc -> acc || hasLoop ctx) False graph == False
-}
fold : (NodeContext n e -> acc -> acc) -> acc -> Graph n e -> acc
fold f acc graph =
  let
    go acc graph1 =
      let
        maybeContext =
          graph1
            |> nodeIdRange
            |> Maybe.map fst
            |> flip Maybe.andThen (\id -> get id graph) -- get should never return Nothing
      in
        case maybeContext of
          Just ctx ->
            go (f ctx acc) (remove ctx.node.id graph1)
          Nothing ->
            acc
  in
    go acc graph


{-| Maps each node context to another one. This may change edge and node labels
(including their types), possibly the node ids and also add or remove edges
entirely through modifying the adjacency lists.

The following is a specification for reverseEdges:

    flipEdges ctx = { ctx | incoming = ctx.outgoing, outgoing = ctx.incoming }
    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
    reverseEdges graph == mapContexts flipEdges graph
-}
mapContexts : (NodeContext n1 e1 -> NodeContext n2 e2) -> Graph n1 e1 -> Graph n2 e2
mapContexts f =
  fold (\ctx -> insert (f ctx)) empty


{-| Maps over node labels, possibly changing their types. Leaves the graph
topology intact.
-}
mapNodes : (n1 -> n2) -> Graph n1 e -> Graph n2 e
mapNodes f =
  fold
    (\ctx ->
      insert
        { ctx
        | node = { id = ctx.node.id, label = f ctx.node.label }
        })
    empty


{-| Maps over edge labels, possibly chaing their types. Leaves the graph
topology intact.
-}
mapEdges : (e1 -> e2) -> Graph n e1 -> Graph n e2
mapEdges f =
  fold
    (\ctx ->
      insert
        { ctx
        | outgoing = IntDict.map (\n e -> f e) ctx.outgoing
        , incoming = IntDict.map (\n e -> f e) ctx.incoming
        })
    empty


{- CHARACTERIZATION -}



{- GRAPH OPS -}


{-| `symmetricClosure edgeMerger graph` is the
[symmetric closure](https://en.wikipedia.org/wiki/Symmetric_closure) of `graph`,
e.g. the undirected equivalent, where for every edge in `graph` there is also
a corresponding reverse edge. This implies that `ctx.incoming` == `ctx.outgoing`
for each node context `ctx`.

`edgeMerger` resolves conflicts for when there are already edges in both
directions, e.g. the graph isn't truly directed. It is guaranteed that
`edgeMerger` will only be called with the smaller node id passed in first
to enforce consitency of merging decisions.

    graph = fromNodesAndEdges [Node 1 "1", Node 2 "2"] [Edge 1 2 "->"]
    onlyUndirectedEdges ctx =
      ctx.incoming == ctx.outgoing
    merger from to outgoingLabel incomingLabel =
      outgoingLabel -- quite arbitrary, will not be called for the above graph
    fold
      (\ctx acc -> acc && onlyUndirectedEdges ctx)
      True
      (symmetricClosure merger graph)
      == True
-}
symmetricClosure : (NodeId -> NodeId -> e -> e -> e) -> Graph n e -> Graph n e
symmetricClosure edgeMerger =
  -- We could use mapContexts, but this will be more efficient.
  let
    orderedEdgeMerger from to outgoing incoming =
      if from <= to
      then edgeMerger from to outgoing incoming
      else edgeMerger to from incoming outgoing
    updateContext nodeId ctx =
      let
        edges = IntDict.uniteWith (orderedEdgeMerger nodeId) ctx.outgoing ctx.incoming
      in
        { ctx | outgoing = edges, incoming = edges }
    in
      Focus.update graphRep (IntDict.map updateContext)


{-| Reverses the direction of every edge in the graph.
-}
reverseEdges : Graph n e -> Graph n e
reverseEdges =
  let
    updateContext nodeId ctx =
      { ctx
      | outgoing = ctx.incoming
      , incoming = ctx.outgoing
      }
  in
    Focus.update graphRep (IntDict.map updateContext)


{- TRAVERSALS -}


{-| Selects the next neighbors for the currently visited node in the traversal.
-}
type alias NeighborSelector n e =
  NodeContext n e
  -> List NodeId


{-| A good default for selecting neighbors is to just go along outgoing edges:

    alongOutgoingEdges ctx =
      IntDict.keys (ctx.outgoing)

`dfs`/`bfs` use this as their selecting strategy.
-}
alongOutgoingEdges : NeighborSelector n e
alongOutgoingEdges ctx =
  IntDict.keys (ctx.outgoing)


{-| A less common way for selecting neighbors is to follow incoming edges:

    alongIncomingEdges ctx =
      IntDict.keys (ctx.incoming)
-}
alongIncomingEdges : NeighborSelector n e
alongIncomingEdges ctx =
  IntDict.keys (ctx.incoming)


{-| A generic node visitor just like that in the ordinary `fold` function.
There are combinators that make these usable for both depth-first traversal
(`onDiscovery`, `onFinish`) and breadth-first traversal (`ignorePath`).
-}
type alias SimpleNodeVisitor n e acc =
  NodeContext n e
  -> acc
  -> acc


{- DFS -}


{-| A node visitor specialized for depth-first traversal. Along with the node
context of the currently visited node, the current accumulated value is passed.
The visitor then has the chance to both modify the value at discovery of the
node through the first return value and also provide a finishing
transformation which is called with the value after all children were processed
and the node is about to be finished.

In the cases where you don't need access to the value both at dicovery and at
finish, look into `onDiscovery` and `onFinish`.
-}
type alias DfsNodeVisitor n e acc =
  NodeContext n e
  -> acc
  -> (acc, acc -> acc)


{-| Transform a `SimpleNodeVisitor` into an equivalent `DfsNodeVisitor`, which
will be called upon node discovery. This eases providing `DfsNodeVisitor`s in
the default case:

    dfsPostOrder : Graph n e  -> List (NodeContext n e)
    dfsPostOrder graph =
      dfs (onDiscovery (::)) [] graph
-}
onDiscovery : SimpleNodeVisitor n e acc -> DfsNodeVisitor n e acc
onDiscovery visitor ctx acc =
  (visitor ctx acc, identity)


{-| Transform a `SimpleNodeVisitor` into an equivalent `DfsNodeVisitor`, which
will be called upon node finish. This eases providing `DfsNodeVisitor`s in
the default case:

    dfsPreOrder : Graph n e  -> List (NodeContext n e)
    dfsPreOrder graph =
      dfs (onFinish (::)) [] graph
-}
onFinish : SimpleNodeVisitor n e acc -> DfsNodeVisitor n e acc
onFinish visitor ctx acc =
  (acc, visitor ctx)


{-| The `dfs*` functions are not powerful enough? Go for this beast.

`guidedDfs selectNeighbors visitNode seeds acc graph` will perform a depth-first
traversal on `graph` starting with a stack of `seeds`. The children of each node
will be selected with `selectNeighbors` (see `NeighborSelector`), the visiting
of nodes is handled by `visitNode` (c.f. `DfsNodeVisitor`), folding `acc` over
the graph.

When there are not any more nodes to be visited, the function will return the
accumulated value together with the unvisited rest of `graph`.

    dfsPreOrder graph =
      -- NodeId 1 is just a wild guess here
      guidedDfs alongOutgoingEdges (onDiscovery (::)) [1] [] graph
-}
guidedDfs
  :  NeighborSelector n e
  -> DfsNodeVisitor n e acc
  -> List NodeId
  -> acc
  -> Graph n e
  -> (acc, Graph n e)
guidedDfs selectNeighbors visitNode seeds acc graph =
  let
    go seeds acc graph =
      case seeds of
        [] -> -- We are done with this connected component, so we return acc and the rest of the graph
          (acc, graph)
        next :: seeds' ->
          case get next graph of
            -- This can actually happen since we don't filter for already visited nodes.
            -- That would be an opportunity for time-memory-tradeoff.
            -- E.g. Passing along a set of visited nodeIds.
            Nothing ->
              go seeds' acc graph
            Just ctx ->
              let
                (accAfterDiscovery, finishNode) =
                  visitNode ctx acc

                (accBeforeFinish, graph1) =
                  go (selectNeighbors ctx) accAfterDiscovery (remove next graph)

                accAfterFinish =
                  finishNode accBeforeFinish
              in
                go seeds' accAfterFinish graph1
  in
    go seeds acc graph


{-| An off-the-shelf depth-first traversal. It will visit all components of the
graph in no guaranteed order, discovering nodes `alongOutgoingEdges`.
See the docs of `DfsNodeVisitor` on how to supply such a beast. There are also
examples on how to use `dfs`.
-}
dfs : DfsNodeVisitor n e acc -> acc -> Graph n e -> acc
dfs visitNode acc graph =
  guidedDfs alongOutgoingEdges visitNode (nodeIds graph) acc graph |> fst


{-| `dfsTree seed graph` computes a depth-first [spanning tree](https://en.wikipedia.org/wiki/Spanning_tree) of the component
in `graph` starting from `seed` `alongOutgoingEdges`. This function is exemplary for needing to
utilize the whole power of `DfsNodeVisitor`.
-}
dfsTree : NodeId -> Graph n e -> Tree (NodeContext n e)
dfsTree seed graph =
  case dfsForest [seed] graph of
    [] ->
      Tree.empty
    [tree] ->
      tree
    _ ->
      Debug.crash "dfsTree: There can't be more than one DFS tree. This invariant is violated, please report this bug."


{-| `dfsForest seeds graph` computes a depth-first spanning `Forest` of the
components in `graph` spanned by `seeds` `alongOutgoingEdges`.

A traversal over this forest would be equivalent to a depth-first traversal
over the original graph.
-}
dfsForest : List NodeId -> Graph n e -> Forest (NodeContext n e)
dfsForest seeds graph =
  let
    visitNode ctx trees =
      ([], \children -> Tree.inner ctx children :: trees)
  in
    guidedDfs alongOutgoingEdges visitNode seeds [] graph
      |> fst
      |> List.reverse


{- BFS -}


{-| A specialized node visitor for breadth-first traversal. Compared to a
`SimpleNodeVisitor`, the path of contexts from the root to the current
node is passed instead of just the current node's context. Additionally, the
distance from the root is passed as an `Int` (the root has distance 0 and it
holds always that `length path == distance - 1`).

If you don't need the additional information, you can turn a `SimpleNodeVisitor`
into a `BfsNodeVisitor` by calling `ignorePath`.
-}
type alias BfsNodeVisitor n e acc =
  List (NodeContext n e)
  -> Int
  -> acc
  -> acc


{-| Turns a `SimpleNodeVisitor` into a `BfsNodeVisitor` by ignoring the path
and distance parameters.
This is useful for when the visitor should be agnostic of the
traversal (breadth-first or depth-first or even just `fold`).

    bfsLevelOrder : List (NodeContext n e)
    bfsLevelOrder graph =
      graph
        |> bfs (ignorePath (::)) []
        |> List.reverse
-}
ignorePath : SimpleNodeVisitor n e acc -> BfsNodeVisitor n e acc
ignorePath visit path _ acc =
  case path of
    [] ->
      Debug.crash "Graph.ignorePath: No algorithm should ever pass an empty path into this BfsNodeVisitor."
    ctx :: path' ->
      visit ctx acc


{-| The `bfs` function is not powerful enough? Go for this beast.

`guidedBfs selectNeighbors visitNode seeds acc graph` will perform a breadth-first
traversal on `graph` starting with a queue of `seeds`. The children of each node
will be selected with `selectNeighbors` (see `NeighborSelector`), the visiting
of nodes is handled by `visitNode` (c.f. `BfsNodeVisitor`), folding `acc` over
the graph.

When there are not any more nodes to be visited, the function will return the
accumulated value together with the unvisited rest of `graph`.

    bfsLevelOrder graph =
      -- NodeId 1 is just a wild guess here
      guidedBfs alongOutgoingEdges (ignorePath (::)) [1] [] graph
-}
guidedBfs
    :  NeighborSelector n e
    -> BfsNodeVisitor n e acc
    -> List NodeId
    -> acc
    -> Graph n e
    -> (acc, Graph n e)
guidedBfs selectNeighbors visitNode seeds acc graph =
  let
    enqueueMany distance parentPath nodeIds queue =
      nodeIds
        |> List.map (\id -> (id, parentPath, distance))
        |> List.foldl Queue.push queue
    go seeds acc graph =
      case Queue.pop seeds of
        Nothing -> -- We are done with this connected component, so we return acc and the rest of the graph
          (acc, graph)
        Just ((next, parentPath, distance), seeds') ->
          case get next graph of
            -- This can actually happen since we don't filter for already visited nodes.
            -- That would be an opportunity for time-memory-tradeoff.
            -- E.g. Passing along a set of visited nodeIds.
            Nothing ->
              go seeds' acc graph
            Just ctx ->
              let
                path =
                  ctx :: parentPath

                acc' =
                  visitNode path distance acc

                seeds'' =
                  enqueueMany (distance + 1) path (selectNeighbors ctx) seeds'
              in
                go seeds'' acc' (remove next graph)
  in
    go (enqueueMany 0 [] seeds Queue.empty) acc graph


{-| An off-the-shelf breadth-first traversal. It will visit all components of the
graph in no guaranteed order, discovering nodes `alongOutgoingEdges`.
See the docs of `BfsNodeVisitor` on how to supply such a beast. There are also
examples on how to use `bfs`.
-}
bfs : BfsNodeVisitor n e acc -> acc -> Graph n e -> acc
bfs visitNode acc graph =
  let
    (acc', restgraph1) =
      guidedBfs alongOutgoingEdges visitNode (nodeIds graph) acc graph
  in
    case nodeIdRange graph of
      Nothing ->
        acc
      Just (id, _) ->
        let
          (acc', restgraph1) =
            guidedBfs alongOutgoingEdges visitNode [id] acc graph
        in
          bfs visitNode acc' restgraph1


{-| Computes the height function of a given graph. This is a more general
[topological sort](https://en.wikipedia.org/wiki/Topological_sorting),
where independent nodes are in the same height level (e.g. the same list
index). A valid topological sort is trivially obtained by flattening the
result of this function.

The height function is useful for solving the maximal clique problem for
certain [perfect graphs](https://en.wikipedia.org/wiki/Perfect_graph)
([comparability graphs](https://en.wikipedia.org/wiki/Comparability_graph)).
There is the excellent reference
[Algorithmic Graph Theory and Perfect Graphs](http://dl.acm.org/citation.cfm?id=984029).
-}
heightLevels : Graph n e -> List (List (NodeContext n e))
heightLevels graph =
  let
    sources =
      fold
        (\ctx acc ->
          if IntDict.isEmpty ctx.incoming
          then ctx :: acc
          else acc)
        []
        graph

    countIndegrees =
      fold
        (\ctx ->
          IntDict.insert
          ctx.node.id
          (IntDict.size ctx.incoming))
        IntDict.empty

    subtract a b =
          b - a

    decrementAndNoteSources id _ (nextLevel, indegrees) =
      let
        indegrees' = IntDict.update id (Maybe.map (subtract 1)) indegrees
      in
        case IntDict.get id indegrees' of
          Just 0 ->
            case get id graph of
              Just ctx -> (ctx :: nextLevel, indegrees')
              Nothing -> Debug.crash "Graph.heightLevels: Could not get a node of a graph which should be there by invariants. Please file a bug report!"
          _ ->
            (nextLevel, indegrees')

    decrementIndegrees source nextLevel indegrees =
      IntDict.foldl decrementAndNoteSources (nextLevel, indegrees) source.outgoing

    go currentLevel nextLevel indegrees graph =
      case (currentLevel, nextLevel) of
        ([], []) ->
          [[]]
        ([], _) ->
          [] :: go nextLevel [] indegrees graph
        (source :: currentLevel', _) ->
          let
            (nextLevel', indegrees') = decrementIndegrees source nextLevel indegrees
          in
            case go currentLevel' nextLevel' indegrees' (remove source.node.id graph) of
              [] ->
                Debug.crash "Graph.heightLevels: Reached a branch which is impossible by invariants. Please file a bug report!"
              level :: levels ->
                (source :: level) :: levels
  in
    go sources [] (countIndegrees graph) graph


{-| Computes a
[topological ordering](https://en.wikipedia.org/wiki/Topological_sorting) of the
given graph.
-}
topologicalSort : Graph n e -> List (NodeContext n e)
topologicalSort graph =
  graph
    |> dfsForest (nodeIds graph)
    |> List.reverse
    |> List.concatMap Tree.preOrderList


{-| Decomposes a graph into its strongly connected components. The resulting
list is a topological ordering of the component graph.
-}
stronglyConnectedComponents : Graph n e -> List (Graph n e)
stronglyConnectedComponents graph =
  -- Based on Cormen, using 2 DFS
  let
    timestamps =
      dfs (onFinish (.node >> .id >> (::))) [] graph

    forest =
      dfsForest timestamps (reverseEdges graph) -- We could optimize out reverseEdges

    components =
      List.map (Tree.preOrderList >> List.foldr insert empty >> reverseEdges) forest
  in
    components




{- toString -}

{-| Returns a string representation of the graph in the format of
`Graph.fromNodesAndEdges [<nodes>] [<edges>]`.
-}
toString' : Graph n e -> String
toString' graph =
  let
    nodeList = nodes graph
    edgeList = edges graph
  in
    "Graph.fromNodesAndEdges " ++ toString nodeList ++ " " ++ toString edgeList