diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,39 @@
+# Changelog for algraph
+
+- 0.7.0.0
+ - Fix source BFS adjacency key mismatch in `residualDistances` — incorrect
+ heights on cyclic graphs caused premature termination
+ - Replace `Map Edge Int` with `IntMap`-based `resEdgeIndex` for O(log V)
+ edge lookup in the hot path (was O(log E))
+ - Add skip-globalRelabel optimization: skip BFS when residual topology is
+ unchanged (1.25--1.6x speedup)
+ - Add QuickCheck test: Tide vs FGL max-flow on 10,000 random graphs
+ - Add comprehensive Haddock documentation to all Tide algorithm modules
+ - Rewrite README for Hackage submission
+
+- 0.6.0.2
+ Updated ghc
+
+- 0.6.0.1
+ Updated ghc - removed Data.Natural
+
+- 0.3.2.1
+ Documentation on the Push-Relabel Tide algorithm
+
+- 0.3.2.0
+ Binary instance of [Edge] so can deserialize Graphs
+
+- 0.3.1.0
+ fixed minimum/maximum bug in empty list (Metrics.hs)
+
+- 0.3.0.0
+ moved graphviz interface to new package
+
+- 0.2.3.0
+ Distance metrics and plot function using graphviz
+
+- 0.2.2.0
+ ``DFS`` Added depth first search algorithm
+
+- 0.2.1.1
+ ``bfs`` returns empty BFS when source not in graph
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,165 @@
+# algraph
+
+A pure Haskell graph library using adjacency list representation, featuring
+the **Tide algorithm** — a level-synchronous push-pull-relabel solver for the
+maximum flow problem.
+
+## Quick start
+
+```haskell
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Network
+import Data.Graph.AdjacencyList.PushRelabel.Pure
+import Data.Graph.AdjacencyList.PushRelabel.Internal (netFlow, stCut)
+import qualified Data.Map.Strict as M
+
+main :: IO ()
+main = do
+ -- Build a directed graph: 1 -> 2 -> 4
+ -- 1 -> 3 -> 4
+ let g = graphFromEdges [Edge 1 2, Edge 1 3, Edge 2 4, Edge 3 4]
+ caps = M.fromList [ (Edge 1 2, 10), (Edge 1 3, 5)
+ , (Edge 2 4, 8), (Edge 3 4, 7) ]
+ net = Network { graph = g, source = 1, sink = 4
+ , capacities = caps, flow = M.empty }
+ case pushRelabel net of
+ Left err -> putStrLn $ "Error: " ++ err
+ Right rg -> do
+ putStrLn $ "Max flow: " ++ show (netFlow rg) -- 13
+ putStrLn $ "Min cut: " ++ show (stCut rg) -- s-t cut edges
+```
+
+## Features
+
+- **Maximum flow** via the Tide algorithm — the only push-relabel
+ implementation in the Haskell ecosystem, and the only sub-O(VE^2) pure
+ functional max-flow solver available
+- **Exact arithmetic** — capacities and flows use `Rational`, guaranteeing
+ correct results for arbitrary inputs (no floating-point rounding)
+- **s-t minimum cut** extracted directly from the max-flow residual graph
+- **BFS and DFS** with level maps, parent maps, spanning trees, topological
+ sort, longest path, and connectivity queries
+- **Floyd-Warshall** all-pairs shortest paths (weighted and unweighted)
+- **Graph metrics** — eccentricity, radius, diameter, density
+- **d-dimensional lattice generator** — cubic lattices with periodic boundary
+ conditions (toroidal topology) in arbitrary dimension
+- **QuickCheck-verified** — Tide tested against FGL on 10,000 random graphs
+
+## Modules
+
+| Module | Description |
+|--------|-------------|
+| `Data.Graph.AdjacencyList` | Core types (`Vertex`, `Edge`, `Graph`, `Neighbors`, `EdgeMap`) and graph constructors |
+| `Data.Graph.AdjacencyList.Network` | Flow network type (`Network`, `Capacities`, `Capacity = Rational`) |
+| `Data.Graph.AdjacencyList.PushRelabel.Pure` | **Tide algorithm** — `pushRelabel :: Network -> Either String ResidualGraph` |
+| `Data.Graph.AdjacencyList.PushRelabel.Internal` | Residual graph types, `netFlow`, `stCut`, push/pull primitives |
+| `Data.Graph.AdjacencyList.BFS` | Breadth-first search |
+| `Data.Graph.AdjacencyList.DFS` | Depth-first search, topological sort, longest path |
+| `Data.Graph.AdjacencyList.WFI` | Floyd-Warshall all-pairs shortest paths |
+| `Data.Graph.AdjacencyList.Metrics` | Eccentricity, radius, diameter, density |
+| `Data.Graph.AdjacencyList.Grid` | d-dimensional cubic lattices with periodic boundary conditions |
+
+## The Tide algorithm
+
+Each iteration ("tide") performs three global sweeps on the residual graph:
+
+1. **globalRelabel** — BFS from sink (and source) to recompute vertex heights
+2. **globalPull** — right fold over active vertices: pull flow on reverse edges
+3. **globalPush** — left fold over active vertices: push flow on forward edges
+
+The algorithm terminates when both the net flow and the set of overflowing
+vertices stabilize. A **skip-globalRelabel** optimization tracks whether any
+edge crosses a saturation boundary during push/pull; when none do, the BFS
+is skipped (1.25--1.6x speedup in practice).
+
+### Complexity
+
+| | Worst case | Practical |
+|---|---|---|
+| **Tides** | O(V^2) | O(V) |
+| **Per-tide** | O((V+E) log V) | O((V+E) log V) |
+| **Total** | O(V^2 (V+E) log V) | O(V(V+E) log V) |
+
+The log V factor comes from `IntMap` lookups in the pure Haskell
+implementation. The O(V^2) worst case requires exponentially-varying
+capacities; on graphs with polynomially-bounded capacity ratios (covering
+virtually all practical inputs), the tide count is empirically O(V).
+
+### How it compares
+
+| Algorithm | Best known complexity |
+|---|---|
+| Edmonds-Karp (FGL) | O(VE^2) |
+| Dinic | O(V^2 E) |
+| Highest-label push-relabel | O(V^2 sqrt(E)) |
+| **Tide (as implemented)** | **O(V(V+E) log V)** practical |
+
+A companion Rust implementation ([tide-maxflow](https://github.com/tpapak/tide-maxflow))
+achieves O(VE) practical complexity using O(1) array-based data structures and
+has been benchmarked against Hi-PR, Google OR-Tools, LEMON, and Boost on 63
+DIMACS graph instances.
+
+## Context in the Haskell graph ecosystem
+
+| Library | Max flow | Shortest paths | Metrics | Generators |
+|---|---|---|---|---|
+| **containers** | -- | -- | -- | -- |
+| **fgl** | Edmonds-Karp O(VE^2) | Dijkstra, BF | -- | -- |
+| **algebraic-graphs** | -- | -- | -- | -- |
+| **algraph** | **Tide O(V(V+E) log V)** | **Floyd-Warshall APSP** | eccentricity, radius, diameter, density | d-dim lattices (PBC) |
+
+Key differences from fgl:
+
+- **Faster max flow** — Tide is asymptotically better than fgl's Edmonds-Karp
+ at all graph densities (O(V(V+E) log V) vs O(VE^2))
+- **Exact arithmetic** — fgl uses `Double` for max flow; algraph uses
+ `Rational`, guaranteeing correct results for arbitrary capacity values
+- **Faster traversals** — algraph's BFS/DFS are O((V+E) log V) vs fgl's
+ O(V^2) due to fgl's O(V)-per-vertex `match` decomposition
+- **APSP** — Floyd-Warshall is built in; fgl only offers single-source
+ algorithms
+
+fgl has broader algorithm coverage (SCC, dominators, MST, Dijkstra,
+transitive closure) and supports labeled nodes/edges.
+
+### BFS performance vs fgl
+
+fgl's BFS uses `match` at each vertex, making it O(V^2) instead of the
+textbook O(V+E). algraph's BFS is O((V+E) log V) using IntMap/IntSet. The
+gap widens with graph size:
+
+| Graph | V | E | algraph | fgl | fgl/algraph |
+|---|---|---|---|---|---|
+| Grid 100x100 | 10K | 20K | 51 ms | 53 ms | 1.0x |
+| Grid 200x200 | 40K | 80K | 258 ms | 337 ms | 1.3x |
+| Grid 500x500 | 250K | 500K | 1675 ms | 2848 ms | **1.7x** |
+| Grid 1000x1000 | 1M | 2M | 6956 ms | 24316 ms | **3.5x** |
+| Layered 20x50 | 1K | 48K | 60 ms | 296 ms | **5.0x** |
+| Layered 50x100 | 5K | 490K | 695 ms | 1487 ms | **2.1x** |
+
+## Building
+
+Requires [Stack](https://docs.haskellstack.org/en/stable/):
+
+```
+git clone https://github.com/tpapak/algraph
+cd algraph
+stack build
+```
+
+## Testing
+
+```
+stack test
+```
+
+The test suite includes:
+
+- Unit tests for graph construction, BFS, DFS, grid lattices, Floyd-Warshall,
+ and graph metrics
+- Tide max-flow correctness test against FGL on a reference network
+- QuickCheck property: Tide vs FGL max-flow agreement on 10,000 random graphs
+
+## License
+
+LGPL-3 -- see [LICENSE](LICENSE).
diff --git a/algraph.cabal b/algraph.cabal
new file mode 100644
--- /dev/null
+++ b/algraph.cabal
@@ -0,0 +1,80 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.36.0.
+--
+-- see: https://github.com/sol/hpack
+
+name: algraph
+version: 0.7.0.0
+synopsis: Graph library using adjacency list representation
+description: Please see the README on GitHub at
+category: Graphs, Algorithms
+homepage: https://github.com/tpapak/algraph#readme
+bug-reports: https://github.com/tpapak/algraph/issues
+author: Thodoris Papakonstantinou
+maintainer: dev@tpapak.com
+copyright: Thodoris Papakonstantinou, 2017-2026
+license: LGPL-3
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ README.md
+ ChangeLog.md
+
+source-repository head
+ type: git
+ location: https://github.com/tpapak/algraph
+
+library
+ exposed-modules:
+ Data.Graph.AdjacencyList
+ Data.Graph.AdjacencyList.BFS
+ Data.Graph.AdjacencyList.DFS
+ Data.Graph.AdjacencyList.Grid
+ Data.Graph.AdjacencyList.Metrics
+ Data.Graph.AdjacencyList.Network
+ Data.Graph.AdjacencyList.PushRelabel.Internal
+ Data.Graph.AdjacencyList.PushRelabel.Pure
+ Data.Graph.AdjacencyList.WFI
+ other-modules:
+ Paths_algraph
+ hs-source-dirs:
+ src
+ build-depends:
+ Unique >=0.4.7.9 && <0.5
+ , base >=4.8 && <4.21
+ , binary >=0.8.6.0 && <0.9
+ , containers >=0.5.10.2 && <0.8
+ , either-unwrap ==1.1.*
+ , mtl >=2.2.1 && <2.4
+ , text >=1.2.2.2 && <2.2
+ default-language: Haskell2010
+
+test-suite algraph-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ other-modules:
+ Test.Graph.AdjacencyList
+ Test.Graph.AdjacencyList.BFS
+ Test.Graph.AdjacencyList.DFS
+ Test.Graph.AdjacencyList.Grid
+ Test.Graph.AdjacencyList.Metrics
+ Test.Graph.AdjacencyList.PushRelabel.FGLComparison
+ Test.Graph.AdjacencyList.PushRelabel.Pure
+ Test.Graph.AdjacencyList.WFI
+ Paths_algraph
+ hs-source-dirs:
+ test
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ QuickCheck >=2.14
+ , Unique
+ , algraph
+ , ansi-terminal
+ , base >=4.7
+ , binary >=0.8.6.0
+ , containers >=0.5.10.2
+ , fgl >=5.5.3.1
+ , tesths >=0.2.2.1
+ , vector
+ default-language: Haskell2010
diff --git a/src/Data/Graph/AdjacencyList.hs b/src/Data/Graph/AdjacencyList.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList.hs
@@ -0,0 +1,254 @@
+{-|
+Module : Data.Graph.AdjacencyList
+Description : Core graph types and constructors
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Core types and constructors for directed graphs using adjacency list
+representation.
+
+A 'Graph' stores its vertex set, an 'EdgeMap' for edge-attribute lookup,
+and a closure-based 'Neighbors' function for O(log V) neighbor access.
+Undirected graphs are represented by including both directions of each edge.
+ -}
+
+{-# LANGUAGE DeriveGeneric #-}
+
+module Data.Graph.AdjacencyList
+ ( Vertex (..)
+ , Edge (..)
+ , Neighbors (..)
+ , EdgeMap (..)
+ -- * Graph definition
+ , Graph (..)
+ , fromTuple
+ , toTuple
+ -- * createGraph: Graph constructor
+ , createGraph
+ -- * graph from list of Edges
+ , graphFromEdges
+ , edges
+ , reverseEdge
+ , reverseEdges
+ , reverseGraph
+ -- * filterVertices
+ , filterVertices
+ -- * filterEdges
+ , filterEdges
+ -- * makeUndirected
+ , makeUndirected
+ , adjacentEdges
+ , edgesFromNeighbors
+ , adjacencyMap
+ , edgeExists
+ , edgeIndex
+ , from
+ , to
+ , numVertices
+ , numEdges
+ , removeReverseEdges
+ , completeGraph
+ ) where
+
+import Data.List
+import Data.List.Unique
+import Data.Maybe
+import qualified Data.Map.Lazy as M
+import qualified Data.IntMap.Lazy as IM
+import qualified Data.Set as Set
+import qualified GHC.Generics as Gen
+import qualified Data.Binary as Bin
+
+-- | A vertex identifier (non-negative integer).
+type Vertex = Int
+
+-- | A directed edge from one vertex to another.
+data Edge = Edge Vertex Vertex
+ deriving (Ord, Gen.Generic)
+instance Bin.Binary Edge
+
+instance Show Edge where
+ show (Edge s t) = "[" ++ show s ++ "->" ++ show t ++ "]"
+
+instance Eq Edge where
+ a == b = from a == from b && to a == to b
+
+-- | Map from edges to their sequential index (1-based).
+-- Used for edge-attribute lookup.
+type EdgeMap = M.Map Edge Int
+
+-- | Takes vertex and outputs neighboring vertices.
+-- The Neighbors type is the function from a vertex to its neighbors
+type Neighbors = (Vertex -> [Vertex])
+
+-- | Graph definition of directed Graphs
+-- undirected graphs should include reverse edges.
+data Graph =
+ Graph { vertices :: [Vertex] -- ^ The domain of the `neighbors` function.
+ -- It is usefull for finite graphs.
+ , edgeMap :: EdgeMap -- ^ The edge map is necessary
+ -- for appointing edge attributes
+ , neighbors :: Neighbors -- ^ The `Adjacency List`
+ }
+
+-- | Check whether an edge exists in the graph.
+edgeExists :: Graph -> Edge -> Bool
+edgeExists g e = M.member e (edgeMap g)
+
+-- | Gives the position of the edge to the edges list
+edgeIndex :: Graph -> Edge -> Maybe Int
+edgeIndex g e = M.lookup e $ edgeMap g
+
+-- | All edges of the graph, in 'EdgeMap' key order.
+edges :: Graph -> [Edge]
+edges g =
+ fmap fst $ M.toList $ edgeMap g
+
+edgeMapFromEdges :: [Edge] -> EdgeMap
+edgeMapFromEdges es =
+ M.fromList $ zip es [1..]
+
+-- | Source vertex of an edge.
+from :: Edge -> Vertex
+from (Edge s t) = s
+
+-- | Target vertex of an edge.
+to :: Edge -> Vertex
+to (Edge s t) = t
+
+-- | Construct an 'Edge' from a @(source, target)@ tuple.
+fromTuple :: (Vertex, Vertex) -> Edge
+fromTuple (s,t) = Edge s t
+
+-- | Convert an 'Edge' to a @(source, target)@ tuple.
+toTuple :: Edge -> (Vertex, Vertex)
+toTuple (Edge s t) = (s,t)
+
+-- | Reverse the direction of an edge.
+reverseEdge :: Edge -> Edge
+reverseEdge (Edge s t) = Edge t s
+
+-- | All edges of the graph with reversed direction.
+reverseEdges :: Graph -> [Edge]
+reverseEdges g = fmap reverseEdge $ edges g
+
+-- | Number of vertices in the graph.
+numVertices :: Graph -> Int
+numVertices g = length $ vertices g
+
+-- | Number of edges in the graph.
+numEdges :: Graph -> Int
+numEdges g = length $ edges g
+
+
+instance Eq Graph where
+ (==) g1 g2 = (sort (vertices g1) == sort (vertices g2))
+ && (sort (edges g1) == sort (edges g2))
+
+instance Show Graph where
+ show g = "vertices: " ++ show (vertices g) ++ "\n" ++
+ "edges: " ++ show (edges g) ++ "\n"
+
+-- | Graph constructor given a neighbors function
+createGraph :: [Vertex] -> Neighbors -> Graph
+createGraph vs neis =
+ let emap = edgeMapFromEdges $ edgesFromNeighbors neis vs
+ in Graph { vertices = vs
+ , neighbors = neis
+ , edgeMap = emap
+ }
+
+-- | Graph constructor given a list of edges.
+--
+-- Builds the adjacency map in a single O(E) pass using 'IM.fromListWith',
+-- then wraps it in a closure for O(log V) neighbor lookup.
+graphFromEdges :: [Edge] -> Graph
+graphFromEdges es =
+ let vs = Set.toList $ foldl' (\ac (Edge u v) ->
+ Set.insert u (Set.insert v ac)) Set.empty es
+ esmap = edgeMapFromEdges es
+ -- Build adjacency map in one pass: O(E log V) via fromListWith
+ neimap = IM.fromListWith (++)
+ $ fmap (\(Edge u v) -> (u, [v])) es
+ neis v = case IM.lookup v neimap of
+ Nothing -> []
+ Just ns -> ns
+ in Graph { vertices = vs
+ , edgeMap = esmap
+ , neighbors = neis
+ }
+
+-- | Enumerate all edges implied by a 'Neighbors' function over a vertex set.
+edgesFromNeighbors :: Neighbors -> [Vertex] -> [Edge]
+edgesFromNeighbors neis vs =
+ let allneis = fmap (\v -> (v,neis v)) vs
+ in foldr (\(v,nv) ac ->
+ (fmap (\n -> Edge v n) nv) ++ ac
+ ) [] allneis
+
+-- | All outgoing edges from a vertex.
+adjacentEdges :: Graph -> Vertex -> [Edge]
+adjacentEdges g v = fmap (\n -> Edge v n) $ neighbors g v
+
+-- | Build an explicit adjacency map from the graph's 'Neighbors' closure.
+adjacencyMap :: Graph -> IM.IntMap [Vertex]
+adjacencyMap g = IM.fromList $ fmap (\v -> (v, (neighbors g v))) vs
+ where vs = vertices g
+
+-- | Reverse all edges in the graph.
+reverseGraph :: Graph -> Graph
+reverseGraph g =
+ graphFromEdges $ reverseEdges g
+
+-- | Get the subgraph of a graph by including vertices satisfying given predicate.
+filterVertices :: (Vertex -> Bool) -- ^ filter predicate
+ -> Graph
+ -> Graph
+filterVertices f g =
+ let oldvs = vertices g
+ vs = filter f oldvs
+ neis v =
+ let ns = neighbors g v
+ in filter f ns
+ in createGraph vs neis
+
+-- | Get the subgraph of a graph by including edges satisfying given predicate.
+filterEdges :: (Edge -> Bool) -> Graph -> Graph
+filterEdges f g =
+ let vs = vertices g
+ neis v =
+ let neis = neighbors g v
+ in filter (\n -> f (Edge v n)) neis
+ in createGraph vs neis
+
+-- | Make a graph undirected by adding all missing reverse edges.
+makeUndirected :: Graph -- ^ directed graph
+ -> Graph -- ^ undirected graph
+makeUndirected g =
+ let rg = reverseGraph g
+ vs = vertices g
+ newnei v =
+ let nei = neighbors g v
+ rnei = neighbors rg v
+ in sortUniq $ nei ++ rnei
+ in createGraph vs newnei
+
+-- | Make a graph directed by removing randomly reverse edges
+removeReverseEdges :: Graph -- ^ Graph with reverse edges
+ -> Graph -- ^ Directected graph
+removeReverseEdges g =
+ let unes = sort $ edges g
+ dires = filter (\e -> elem (reverseEdge e)
+ (filter (\e' -> e' > e) unes)
+ ) unes
+ in graphFromEdges dires
+
+
+-- | Complete undirected graph from number of vertices
+completeGraph :: Int -> Graph
+completeGraph n =
+ let es = [e | e <- Edge <$> [1..n] <*> [1..n], (\(Edge s t) -> s /= t ) e]
+ in graphFromEdges es
diff --git a/src/Data/Graph/AdjacencyList/BFS.hs b/src/Data/Graph/AdjacencyList/BFS.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/BFS.hs
@@ -0,0 +1,166 @@
+{-|
+Module : Data.Graph.AdjacencyList.BFS
+Description : Breadth-first search on adjacency-list graphs
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Breadth-first search (BFS) for directed graphs represented as adjacency lists.
+Provides two entry points:
+
+* 'bfs' — BFS on a concrete 'Graph' value
+* 'adjBFS' — BFS on an implicit graph given as an @IntMap [Vertex]@ adjacency map
+
+Both produce a 'BFS' record containing the level (distance) of every reachable
+vertex, the BFS parent map, and a topological ordering of the visited vertices.
+
+Used by the Tide algorithm ('Data.Graph.AdjacencyList.PushRelabel.Pure') in the
+@globalRelabel@ step to compute vertex heights from distances to the source and
+sink in the residual graph.
+ -}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+
+module Data.Graph.AdjacencyList.BFS
+ ( -- * BFS result
+ BFS (..)
+ -- * Running BFS
+ , bfs
+ , adjBFS
+ -- * Utilities
+ , spanningTree
+ ) where
+
+import Data.List
+import Data.Tuple
+import Data.Maybe
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as Set
+
+import Data.Graph.AdjacencyList
+
+-- | Result of a breadth-first search from a single source vertex.
+data BFS = BFS { frontier :: Set.IntSet
+ -- ^ Current frontier (vertices at the deepest explored level).
+ -- Empty when the search is complete.
+ , level :: IM.IntMap Int
+ -- ^ Map from vertex to its BFS level (shortest distance from source).
+ , parent :: IM.IntMap Vertex
+ -- ^ Map from vertex to its BFS parent.
+ -- The source vertex has no entry.
+ , maxLevel :: Int
+ -- ^ Maximum level reached during the search.
+ , topSort :: [Vertex]
+ -- ^ Vertices in BFS visit order.
+ -- For DAGs this coincides with a topological sort.
+ } deriving (Eq, Show)
+
+-- | Initial BFS state with only the source vertex in the frontier.
+initialBFS :: Vertex -> BFS
+initialBFS s = BFS { frontier = Set.singleton s
+ , level = IM.fromList [(s,0)]
+ , parent= IM.empty
+ , maxLevel = 0
+ , topSort = []
+ }
+
+-- | Run BFS on a 'Graph' from the given source vertex.
+--
+-- Explores all vertices reachable from @s@ via the graph's 'neighbors'
+-- function. Returns a 'BFS' record with levels, parents, and visit order.
+--
+-- If @s@ is not in the graph's vertex set, returns the initial (empty) BFS.
+bfs :: Graph -> Vertex -> BFS
+bfs g s =
+ let vset = Set.fromList (vertices g)
+ sbfs = initialBFS s
+ breadthFirstSearch b =
+ if Set.null (frontier b) || not (Set.member s vset)
+ then b { topSort = reverse (topSort b) }
+ else
+ let oldLevel = maxLevel b
+ newLevel = oldLevel + 1
+ oldLevels = level b
+ oldFrontiers = frontier b
+ -- Collect (neighbor, parent) pairs; use IntMap to deduplicate
+ -- and keep only newly discovered vertices in one pass
+ newParMap = Set.foldl'
+ (\acc v ->
+ foldl' (\acc' n ->
+ if IM.member n oldLevels || IM.member n acc'
+ then acc'
+ else IM.insert n v acc'
+ ) acc (neighbors g v)
+ ) IM.empty oldFrontiers
+ newFrontiers = IM.keysSet newParMap
+ newParents = IM.union (parent b) newParMap
+ newLevels = Set.foldl'
+ (\ac v -> IM.insert v newLevel ac)
+ oldLevels newFrontiers
+ -- Prepend frontier to topSort (reversed at the end)
+ newTopSort = Set.foldl' (flip (:)) (topSort b) oldFrontiers
+ bbfs = breadthFirstSearch (b { frontier = newFrontiers
+ , level = newLevels
+ , parent = newParents
+ , maxLevel = newLevel
+ , topSort = newTopSort
+ })
+ in bbfs
+ in breadthFirstSearch sbfs
+
+-- | Run BFS on an implicit graph defined by an adjacency map.
+--
+-- @adjBFS neimap s@ performs BFS from vertex @s@ where the neighbors of
+-- each vertex are given by @neimap :: IntMap [Vertex]@. Vertices not
+-- present in @neimap@ are treated as having no outgoing edges.
+--
+-- This is used by 'Data.Graph.AdjacencyList.PushRelabel.Internal.residualDistances'
+-- to run BFS on the residual graph (whose edge set changes each tide)
+-- without constructing a full 'Graph' value.
+adjBFS :: IM.IntMap [Vertex] -> Vertex -> BFS
+adjBFS neimap s = let b = breadthFirstSearch sbfs
+ in b { topSort = reverse (topSort b) }
+ where neighbors v = case IM.lookup v neimap of
+ Nothing -> []
+ Just ns -> ns
+ sbfs = initialBFS s
+ breadthFirstSearch b
+ | Set.null (frontier b) = b
+ | otherwise = bbfs
+ where oldLevel = maxLevel b
+ newLevel = oldLevel + 1
+ oldLevels = level b
+ oldFrontiers = frontier b
+ -- Collect new vertices; use IntMap to deduplicate
+ newParMap = Set.foldl'
+ (\acc v ->
+ foldl' (\acc' n ->
+ if IM.member n oldLevels || IM.member n acc'
+ then acc'
+ else IM.insert n v acc'
+ ) acc (neighbors v)
+ ) IM.empty oldFrontiers
+ newFrontiers = IM.keysSet newParMap
+ newParents = IM.union (parent b) newParMap
+ newLevels = Set.foldl'
+ (\ac v -> IM.insert v newLevel ac)
+ oldLevels newFrontiers
+ newTopSort = Set.foldl' (flip (:)) (topSort b) oldFrontiers
+ bbfs = breadthFirstSearch (b { frontier = newFrontiers
+ , level = newLevels
+ , parent = newParents
+ , maxLevel = newLevel
+ , topSort = newTopSort
+ })
+
+-- | Extract the BFS spanning tree as a list of edges.
+--
+-- Each edge @(parent, child)@ in the returned list corresponds to one
+-- entry in the 'parent' map.
+spanningTree :: BFS -> [Edge]
+spanningTree b =
+ map (fromTuple . swap) $ IM.toList $ parent b
diff --git a/src/Data/Graph/AdjacencyList/DFS.hs b/src/Data/Graph/AdjacencyList/DFS.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/DFS.hs
@@ -0,0 +1,183 @@
+{-|
+Module : Data.Graph.AdjacencyList.DFS
+Description : Depth-first search with topological sort and longest path
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Depth-first search (DFS) on directed graphs. Produces a topological ordering,
+a visited-order list, and the set of discovered vertices. Also provides
+'longestPath' on DAGs and connectivity queries.
+ -}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns #-}
+
+
+module Data.Graph.AdjacencyList.DFS
+ ( DFS (..)
+ , dfs
+ -- * Types
+ , DAG
+ , Distances
+ -- * get longest path from a vertex to another
+ , longestPath
+ , postordering
+ , areConnected
+ , distances
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as Set
+import qualified Data.Sequence as Seq
+
+import Data.Graph.AdjacencyList
+
+-- | Result of a depth-first search from a single source vertex.
+data DFS = DFS { topsort :: [Vertex]
+ -- ^ Vertices in reverse post-order (topological sort for DAGs).
+ , visited :: [Vertex]
+ -- ^ Vertices in DFS visit order.
+ , discovered :: Set.IntSet
+ -- ^ Set of all discovered vertices.
+ , called :: Int
+ -- ^ Number of DFS calls made.
+ } deriving (Eq, Show)
+
+initialDFS :: DFS
+initialDFS = DFS { topsort = []
+ , discovered = Set.empty
+ , visited = []
+ , called = 0
+ }
+
+-- | Depth first search
+dfs :: Graph -> Vertex -> DFS
+dfs g s =
+ let vset = Set.fromList (vertices g)
+ in if not $ Set.member s vset
+ then initialDFS
+ else
+ let depthFirstSearch :: Vertex -> DFS -> DFS
+ depthFirstSearch v ac
+ | Set.member v (discovered ac) = ac
+ | otherwise =
+ let -- Mark v as discovered BEFORE recursing (prevents revisits in cyclic graphs)
+ ac0 = ac { discovered = Set.insert v (discovered ac) }
+ ns = neighbors g v
+ !ac' = foldl' (\ac'' n -> if not (Set.member n (discovered ac''))
+ then depthFirstSearch n ac''
+ else ac''
+ ) ac0 ns
+ res = ac' { topsort = v : topsort ac'
+ -- Prepend to visited (reversed at end)
+ , visited = v : visited ac'
+ , called = called ac' + 1
+ }
+ in res
+ result = depthFirstSearch s initialDFS
+ in result { visited = reverse (visited result) }
+
+-- | Post-order traversal (reverse of 'topsort').
+postordering :: DFS -> [Vertex]
+postordering = reverse . topsort
+
+-- | :)
+type DAG = Graph
+
+-- | Ginen a DAG and a vertex you get the distances
+distances' :: DAG -> Vertex -> IM.IntMap Vertex
+distances' g s =
+ let topsorted = topsort $ dfs g s
+ initdists = foldl' (\ac v -> IM.insert v 0 ac) IM.empty $ vertices g
+ in foldl' (\ac v ->
+ let neis = neighbors g v
+ distv = case IM.lookup v ac of
+ Nothing -> 0
+ Just d -> d
+ in foldl' (\dists' nei ->
+ let neidist = case IM.lookup nei dists' of
+ Nothing -> 0
+ Just nd -> nd
+ newdist = max neidist (distv+1)
+ in IM.insert nei newdist dists'
+ ) ac neis
+ ) initdists topsorted
+
+-- | Map from vertex to its distance (number of edges) from the source in a 'DAG'.
+type Distances = IM.IntMap Vertex
+
+-- | Ginen a DAG and a vertex you get the distances
+distances :: DAG -> DFS -> Vertex -> Distances
+distances g dfs' s =
+ let topsorted = topsort $ dfs'
+ !initdists = foldl' (\ac v -> IM.insert v 0 ac) IM.empty $ vertices g
+ in foldl' (\ac v ->
+ let neis = neighbors g v
+ distv = case IM.lookup v ac of
+ Nothing -> 0
+ Just d -> d
+ in foldl' (\dists' nei ->
+ let neidist = case IM.lookup nei dists' of
+ Nothing -> 0
+ Just nd -> nd
+ newdist = max neidist (distv+1)
+ in IM.insert nei newdist dists'
+ ) ac neis
+ ) initdists topsorted
+
+type TopologicalSorting = [Vertex]
+-- |checks if s is predecessor of t
+dependsOn :: TopologicalSorting -> Vertex -> Vertex -> Bool
+dependsOn topsorted t s = elem t (snd (span ((==) s) topsorted))
+
+-- | Check whether vertex @v@ is reachable from vertex @u@ according to the
+-- given distance map (distance > 0 means reachable; @u@ is reachable from itself).
+areConnected :: Distances -> Vertex -> Vertex -> Bool
+areConnected dists u v = (fromJust $ IM.lookup v dists) > 0 || v == u
+
+-- |Longest path from tail to nose
+longestPath :: Graph -> Vertex -> Vertex -> [Edge]
+longestPath g s t =
+ let dfs' = dfs g s
+ topsorted = topsort dfs'
+ dists = distances g dfs' s
+ revg = reverseGraph g
+ disconnected = filter (\n -> not (areConnected dists s n)) $ vertices g
+ in if not $ dependsOn topsorted t s
+ then []
+ else
+ if not $ null disconnected
+ then
+ let cleangraph = filterVertices (\v -> not $ elem v disconnected) g
+ in longestPath cleangraph s t
+ else
+ let path' :: Vertex -> [Edge] -> [Edge]
+ path' v p
+ | v == s = p
+ | otherwise =
+ let parents = neighbors revg v
+ in if null parents
+ then []
+ else
+ if parents == [s]
+ then (Edge s v):p
+ else
+ let pred :: Vertex
+ pred = fst $ foldl'
+ (\(prevmax,maxdist) parent ->
+ let currentDist =
+ case IM.lookup parent dists of
+ Nothing -> (0,0)
+ Just d -> (parent,d)
+ in if maxdist < snd currentDist
+ then currentDist
+ else (prevmax,maxdist)
+ ) (0,0) parents
+ in path' pred $ (Edge pred v): p
+ in path' t []
diff --git a/src/Data/Graph/AdjacencyList/Grid.hs b/src/Data/Graph/AdjacencyList/Grid.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/Grid.hs
@@ -0,0 +1,221 @@
+{-|
+Module : Data.Graph.AdjacencyList.Grid
+Description : d-dimensional cubic lattices with periodic boundary conditions
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Generators for d-dimensional cubic lattices with periodic boundary conditions
+(toroidal topology). A 'PBCSquareLattice' @L D@ is the Cartesian product of
+@D@ cycle graphs of length @L@: \( C_L \square^D \).
+
+Provides both directed ('graphCubicPBC', forward edges only) and undirected
+('undirectedGraphCubicPBC', forward + backward edges) variants, plus coordinate
+conversion between flat vertex IDs and Cartesian coordinates.
+ -}
+
+module Data.Graph.AdjacencyList.Grid
+ ( L
+ , D
+ , CVertex
+ , fromTuple
+ , toTuple
+ , adjacentEdges
+ , vertexToCVertex
+ , cVertexToVertex
+ , PBCSquareLattice (..)
+ , pbcEdgeIx
+ , gridSize
+ , gridNumEdges
+ , pbcForwardEdges
+ , pbcBackwardEdges
+-- * Undirected cubic graph with PBC
+ , undirectedGraphCubicPBC
+-- * Directed cubic graph with PBC
+ , graphCubicPBC
+ ) where
+
+import Data.List
+import qualified Data.Map.Lazy as M
+import Numeric.Natural
+
+import Data.Graph.AdjacencyList
+
+-- | Linear size of the lattice (number of vertices per dimension).
+type L = Natural
+
+-- | Dimensionality of the lattice (2 = square, 3 = cubic, etc.).
+type D = Natural
+
+-- | Cartesian coordinates of a lattice vertex: a list of per-dimension indices.
+type CVertex = [Vertex]
+data CEdge = CEdge CVertex CVertex -- ^ Cartesian representation of a Lattice Vertex
+
+data Direction = Forward | Backward deriving (Eq, Ord, Show, Read, Bounded, Enum)
+
+-- | A PBCSquareLattice is the Cartesian product of a cycle graph of length L
+-- (C_L) => (C_L)▢^d
+data PBCSquareLattice = PBCSquareLattice L D
+instance Eq PBCSquareLattice where
+ (==) (PBCSquareLattice la da) (PBCSquareLattice lb db) =
+ la == la && da == db
+instance Show PBCSquareLattice where
+ show (PBCSquareLattice l d) = "Lattice: { \n" ++
+ " L : " ++ show l ++ "\n" ++
+ " D : " ++ show d ++ "\n" ++
+ " numVertices : " ++ show (gridN l d) ++ "\n" ++
+ " numEdges : " ++ show (gridNumEdges (PBCSquareLattice l d))
+
+-- | Undirected graph on a PBC cubic lattice (both forward and backward edges).
+-- Contains @2 * D * L^D@ directed edges (two per neighbor pair).
+undirectedGraphCubicPBC :: PBCSquareLattice -> Graph
+undirectedGraphCubicPBC (PBCSquareLattice l d) =
+ let vs = gridVertices l d
+ neis = pbcUndirectedNeighbors l d
+ in createGraph vs neis
+
+-- | Directed graph embeded in cubic lattice
+graphCubicPBC :: PBCSquareLattice -> Graph
+graphCubicPBC (PBCSquareLattice l d) =
+ let vs = gridVertices l d
+ neis = pbcDirectedNeighbors l d
+ in createGraph vs neis
+
+-- | Number of directed (forward) edges in the lattice: @D * L^D@.
+gridNumEdges :: PBCSquareLattice -> Natural
+gridNumEdges (PBCSquareLattice l d) = d * (gridN l d)
+
+gridN :: L -> D -> Natural
+gridN l d = l ^ d
+
+-- | Total number of vertices in the lattice: @L^D@.
+gridSize :: PBCSquareLattice -> Natural
+gridSize (PBCSquareLattice l d) = gridN l d
+
+gridVertices :: L -> D -> [Vertex]
+gridVertices l d = [1 .. (fromEnum l ^ fromEnum d)]
+
+-- | Returns the next vertex of v in the d dimension for a grid of side l
+pbcNeighbor :: Vertex -> L -> D -> Direction -> Vertex
+pbcNeighbor v l d r
+ | r == Forward =
+ if not $! isBoundary v l d
+ then v + innerOffset l d
+ else v + pbcOffset l d
+ | r == Backward =
+ if not $ isBoundary (v - innerOffset l d) l d
+ then v - innerOffset l d
+ else v - pbcOffset l d
+ where
+ l' = fromEnum l
+ d' = fromEnum d
+ innerOffset :: L -> D -> Vertex
+ innerOffset l d = l'^(d' - 1)
+ pbcOffset :: L -> D -> Vertex
+ pbcOffset l d = - l'^d + l'^(d' - 1)
+ isBoundary :: Vertex -> L -> D -> Bool
+ isBoundary v l d = (l'^d') - (l'^(d' - 1)) - mod (v - 1) (l'^d') <= 0
+
+-- | Given vertex returns list of nearest neighboring vertices on a Toroidal Boundary Conditions (pbc) grid
+pbcDirectedNeighbors :: L -> D -> Neighbors
+pbcDirectedNeighbors l d v = fmap (\d'-> pbcNeighbor v l d' Forward) [1 .. d]
+
+-- | Given vertex returns list of nearest neighboring vertices on a Toroidal Boundary Conditions (pbc) grid
+pbcUndirectedNeighbors :: L -> D -> Vertex -> [Vertex]
+pbcUndirectedNeighbors l d v = (\r d'-> pbcNeighbor v l d' r)
+ <$> [Forward,Backward] <*> [1 .. d]
+
+-- | Given a Vertex returns a tuple of the Cartesian product of a L sized Cycle graph
+vertexToCVertex :: L -> D -> Vertex -> CVertex
+vertexToCVertex l' d' v = do
+ let cix l n i = (mod (div (n-1) (l^(i-1))) l) + 1
+ out = map (cix l v) [1 .. d]
+ out
+ where l = fromEnum l'
+ d = fromEnum d'
+
+-- | The reverse function of vertexToCVertex
+cVertexToVertex :: L -> D -> CVertex -> Vertex
+cVertexToVertex l' d' cv = do
+ (foldr (\t@(i,x)-> (+) ((x-1) * (l^(i-1)))) 0 $ zip [1 .. d] cv) + 1
+ where l = fromEnum l'
+ d = fromEnum d'
+
+-- | Gives Forward vertex in a cycle graph of length L
+forwardVertexInCycle :: L -> Vertex -> Vertex
+forwardVertexInCycle l' v
+ | v == l = 1
+ | otherwise = v + 1
+ where l = fromEnum l'
+
+-- | Gives Forward vertex in a cycle graph of length L
+backwardVertexInCycle :: L -> Vertex -> Vertex
+backwardVertexInCycle l' v
+ | v == 1 = l
+ | otherwise = v - 1
+ where l = fromEnum l'
+
+-- | Given two edges returns if they belong to the lattice
+isEdgeInCycle :: L -> Edge -> Bool
+isEdgeInCycle l' (Edge a b)
+ | a == b - 1 = True
+ | a == b + 1 = True
+ | a == l && b == 1 = True
+ | b == l && a == 1 = True
+ | otherwise = False
+ where l = fromEnum l'
+
+-- | Returns tuple (edge) giving forward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
+pbcForwardEdges :: L -> D -> Vertex -> [Edge]
+pbcForwardEdges l d v = fmap (\d -> Edge v (pbcNeighbor v l d Forward)) [1 .. d]
+
+-- | Returns tuple (edge) giving backward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
+pbcBackwardEdges :: L -> D -> Vertex -> [Edge]
+pbcBackwardEdges l d v = fmap (\d -> Edge v (pbcNeighbor v l d Backward)) [1 .. d]
+
+pbcUndirectedEdges :: L -> D -> [Edge]
+pbcUndirectedEdges l d =
+ let nei v =
+ foldl'
+ (\ac d -> ac ++
+ [ Edge v (pbcNeighbor v l d Forward)
+ , Edge v (pbcNeighbor v l d Backward)
+ ]
+ )[] [1 .. d]
+ in foldr (\v ac -> (nei v) ++ ac) [] $ gridVertices l d
+
+-- | Returns tuple (edge) giving forward and backward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
+pbcAdjacentEdges :: L -> D -> Vertex -> [Edge]
+pbcAdjacentEdges l d v = (\r d ->
+ case r of Forward -> Edge v (pbcNeighbor v l d r)
+ Backward -> Edge (pbcNeighbor v l d r) v
+ )
+ <$> [Forward,Backward] <*> [1 .. d]
+
+-- | List of edges of grid with periodic boundary conditions
+pbcDirectedEdges :: L -> D -> [Edge]
+pbcDirectedEdges l d = (\v j-> Edge v (pbcNeighbor v l j Forward)) <$> gridVertices l d <*> [1 .. d]
+
+-- | Index of edge of a grid with periodic boundary conditions
+-- Very inefficient, better use Data.Map for lookups.
+pbcEdgeIx :: L -> D -> Edge -> Maybe Int
+pbcEdgeIx l d e = do
+ let Edge s t = e
+ a = vertexToCVertex l d s
+ b = vertexToCVertex l d t
+ (((a',b'),di),dist) = diff (CEdge a b)
+ case dist == 1 of
+ True -> case forwardVertexInCycle l a' == b' of
+ True -> Just $ ((s-1)*d') + di
+ False -> Just $ ((t-1)*d') + di
+ False -> Nothing
+ where
+ d' = fromEnum d
+ step (((a',b'),di'), ds) ((s,t),di)
+ | s == t = (((a',b'),di'), ds)
+ | s /= t = (((s,t),di), ds+1)
+ diff :: CEdge -> (((Vertex,Vertex),Int),Int)
+ diff (CEdge a b) = foldl step (((0,0),0),0) $ zip (zip a b) [1..d']
+
diff --git a/src/Data/Graph/AdjacencyList/Metrics.hs b/src/Data/Graph/AdjacencyList/Metrics.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/Metrics.hs
@@ -0,0 +1,70 @@
+{-|
+Module : Data.Graph.AdjacencyList.Metrics
+Description : Graph distance and density metrics
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Graph metrics computed from a 'Distances' matrix (see "Data.Graph.AdjacencyList.WFI"):
+,
+radius, diameter, and density.
+ -}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+
+module Data.Graph.AdjacencyList.Metrics
+ ( graphEccentricity
+ , graphRadius
+ , graphDiameter
+ , graphDensity
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.IntMap as IM
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.WFI
+
+-- | Eccentricity of a vertex: the maximum shortest-path distance from @v@
+-- to any other reachable vertex. Returns 'Nothing' if @v@ is not in the
+-- distance matrix.
+graphEccentricity :: Vertex -> Distances -> Maybe Weight
+graphEccentricity v (Distances dis) =
+ let vdis = IM.lookup v dis
+ in maximum <$> vdis
+
+-- | Radius of the graph: the minimum eccentricity over all vertices
+-- (excluding zero and absent eccentricities).
+graphRadius :: Distances -> Maybe Weight
+graphRadius dis =
+ let (Distances dism) = dis
+ vs = IM.keys dism
+ filtdis = filter (\d -> d /= Just 0 && d /= Nothing)
+ $ map (\v -> graphEccentricity v dis) vs
+ in if null filtdis
+ then Nothing
+ else minimum filtdis
+
+-- | Diameter of the graph: the maximum eccentricity over all vertices.
+graphDiameter :: Distances -> Maybe Weight
+graphDiameter dis =
+ let (Distances dism) = dis
+ vs = IM.keys dism
+ filtdis = filter (\d -> d /= Just 0 && d /= Nothing)
+ $ map (\v -> graphEccentricity v dis) vs
+ in if null filtdis
+ then Nothing
+ else maximum filtdis
+
+-- | Since the representation of undirected graphs dublicated edges no need for
+-- undirected version of density
+graphDensity :: Graph -> Rational
+graphDensity g =
+ let ne = fromIntegral $ length $ edges g
+ nv = fromIntegral $ length $ vertices g
+ in ne / (nv * (nv - 1))
diff --git a/src/Data/Graph/AdjacencyList/Network.hs b/src/Data/Graph/AdjacencyList/Network.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/Network.hs
@@ -0,0 +1,88 @@
+{-|
+Module : Data.Graph.AdjacencyList.Network
+Description : Flow network data type for max-flow problems
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Defines the 'Network' type used as input to the Tide max-flow algorithm.
+
+A 'Network' consists of:
+
+* A directed 'Graph'
+* A distinguished 'source' and 'sink' vertex
+* Edge 'Capacities' (mapping each edge to a non-negative 'Rational')
+* Edge flows (initially zero, filled in by the solver)
+
+Capacities use 'Rational' for exact arithmetic — the Tide algorithm
+terminates correctly for arbitrary rational capacities. For integer-only
+workloads, see the Rust implementation @tide-maxflow@ which uses @i64@.
+ -}
+
+module Data.Graph.AdjacencyList.Network
+ ( -- * Network type
+ Network (..)
+ -- * Type aliases
+ , Capacity
+ , Capacities
+ , Flow
+ -- * Utilities
+ , uniformCapacities
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map.Lazy as M
+import qualified Data.IntSet as Set
+
+import Data.Graph.AdjacencyList
+
+-- | Edge capacity. Uses 'Rational' for exact arithmetic, ensuring the
+-- Tide algorithm terminates correctly for arbitrary capacity values.
+type Capacity = Rational
+
+-- | Map from edges to their capacities.
+type Capacities = M.Map Edge Capacity
+
+-- | Edge flow. Same type as 'Capacity' since flow values are rational.
+type Flow = Capacity
+
+showCapacities :: Capacities -> String
+showCapacities cps =
+ show $ fmap (\c -> fromRational c :: Double) cps
+
+-- | A flow network: a directed graph with a source, sink, edge capacities,
+-- and edge flows.
+--
+-- Construct a 'Network' with zero initial flows and pass it to
+-- 'Data.Graph.AdjacencyList.PushRelabel.Pure.pushRelabel' to compute the
+-- maximum flow.
+data Network = Network { graph :: !Graph
+ -- ^ The underlying directed graph.
+ , source :: Vertex
+ -- ^ Source vertex (flow originates here).
+ , sink :: Vertex
+ -- ^ Sink vertex (flow terminates here).
+ , capacities :: Capacities
+ -- ^ Edge capacities. Every edge in 'graph' must
+ -- have a corresponding entry.
+ , flow :: Capacities
+ -- ^ Edge flows. Set to zero initially; filled in
+ -- by the solver.
+ }
+ deriving (Eq)
+
+instance Show Network where
+ show net =
+ "Network" <> show (graph net) <> "\n"
+ <> " source: " <> show (source net) <> "\n"
+ <> " sink : " <> show (sink net) <> "\n"
+ <> " capacities: " <> showCapacities (capacities net) <> "\n"
+ <> " flows: " <> showCapacities (flow net) <> "\n"
+
+-- | Set all edge capacities to 1 (unit capacity network).
+uniformCapacities :: Graph -> Capacities
+uniformCapacities g =
+ M.fromList $ map (\e -> (e,1)) $ edges g
diff --git a/src/Data/Graph/AdjacencyList/PushRelabel/Internal.hs b/src/Data/Graph/AdjacencyList/PushRelabel/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/PushRelabel/Internal.hs
@@ -0,0 +1,598 @@
+{-|
+Module : Data.Graph.AdjacencyList.PushRelabel.Internal
+Description : Residual graph types and primitive operations for the Tide algorithm
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Internal definitions for the Tide push-pull-relabel max-flow algorithm.
+
+This module defines:
+
+* 'ResidualGraph' — the mutable state threaded through each tide iteration,
+ containing vertex heights, excesses, edge flows, and the set of overflowing
+ vertices grouped by level.
+* 'ResidualVertex' and 'ResidualEdge' — per-vertex and per-edge state.
+* 'NeighborsMap' — an @IntMap@-based adjacency structure that maps each vertex
+ to its forward and reverse neighbors with O(log V) edge-index lookup
+ (replacing the original O(log E) @Map Edge Int@ lookup).
+* Primitive operations: 'push', 'pull', 'updateHeight', 'updateExcess',
+ 'updateEdge', 'residualDistances'.
+
+The 'topologyChanged' flag tracks whether any edge crossed a saturation
+boundary (became saturated or unsaturated) during push\/pull. When the
+flag is 'False', the next tide can skip @globalRelabel@ — an optimization
+that yields 1.25--1.61x speedup in practice.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module Data.Graph.AdjacencyList.PushRelabel.Internal
+ ( -- * Re-exports from Network
+ Network (..)
+ , Capacity (..)
+ , Capacities (..)
+ , Flow
+ -- * Residual graph types
+ , ResidualGraph (..)
+ , ResidualVertex (..)
+ , ResidualVertices
+ , ResidualEdge (..)
+ , ResidualEdges
+ , NeighborsMap
+ , Overflowing (..)
+ -- * Vertex property types
+ , Height
+ , Excess
+ , Level
+ -- * Initialization
+ , initializeResidualGraph
+ -- * Vertex property accessors
+ , level
+ , excess
+ , height
+ -- * Edge property accessors
+ , edgeCapacity
+ , edgeFlow
+ , resEdgeIndex
+ -- * Flow queries
+ , netFlow
+ , inflow
+ , outflow
+ , sourceEdgesCapacity
+ -- * Push and pull operations
+ , push
+ , pull
+ -- * State updates
+ , updateHeight
+ , updateExcess
+ , updateEdge
+ -- * Overflowing vertex tracking
+ , getOverflowing
+ -- * Network reconstruction
+ , networkFromResidual
+ -- * Residual BFS (for @globalRelabel@)
+ , residualDistances
+ -- * Min-cut
+ , stCut
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map.Lazy as M
+import qualified Data.IntMap.Lazy as IM
+import qualified Data.IntSet as Set
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Network
+import qualified Data.Graph.AdjacencyList.BFS as BFS
+
+-- | Vertex height in the push-relabel framework.
+-- For source-side vertices: @height = |V| + distance_from_source@.
+-- For sink-side vertices: @height = distance_from_sink@.
+type Height = Int
+
+-- | Vertex excess: @inflow - outflow@. Positive excess means the vertex
+-- is overflowing and needs to push or pull flow.
+type Excess = Capacity
+
+-- | Level: the shortest-path distance from the source in the /original/
+-- (not residual) graph. Constant throughout the algorithm.
+-- Determines the ordering of vertices in globalPush (left fold, ascending)
+-- and globalPull (right fold, descending).
+type Level = Int
+
+-- | Per-vertex state in the residual graph.
+--
+-- @ResidualVertex v l h x@ stores:
+--
+-- * @v@ — vertex identifier
+-- * @l@ — level (BFS distance from source in original graph, constant)
+-- * @h@ — height (updated by @globalRelabel@ each tide)
+-- * @x@ — excess flow (updated by push\/pull operations)
+data ResidualVertex = ResidualVertex !Vertex !Level !Height !Excess
+ deriving (Eq)
+instance Show ResidualVertex where
+ show (ResidualVertex v l h x) =
+ "RVertex " ++ show v ++ " level: " ++
+ show l ++ " height: " ++
+ show h ++ " excess: " ++
+ show (fromRational x :: Double)
+
+-- | Map from vertex id to its 'ResidualVertex' state.
+type ResidualVertices = IM.IntMap ResidualVertex
+
+-- | Per-edge state: original edge, capacity, and current flow (preflow).
+--
+-- @ResidualEdge e c f@: edge @e@ with capacity @c@ and flow @f@.
+-- A forward residual edge exists when @f < c@; a backward residual edge
+-- exists when @f > 0@.
+data ResidualEdge = ResidualEdge Edge Capacity Flow
+ deriving (Eq)
+instance Show ResidualEdge where
+ show (ResidualEdge e c f) =
+ "REdge " ++ show e
+ ++ " " ++
+ show (fromRational c :: Double)
+ ++ " " ++
+ show (fromRational f :: Double)
+-- | Map from edge index to its 'ResidualEdge' state.
+type ResidualEdges = IM.IntMap ResidualEdge
+
+-- | For each vertex, maps forward neighbors and reverse neighbors
+-- to their edge indices in the graph's 'EdgeMap'.
+--
+-- @NeighborsMap ! v = (fwdMap, revMap)@ where:
+--
+-- * @fwdMap ! w@ = index of edge @(v, w)@ (forward neighbor)
+-- * @revMap ! u@ = index of edge @(u, v)@ (reverse neighbor)
+--
+-- This provides O(log degree) edge-index lookup, replacing the original
+-- O(log E) lookup via @Map Edge Int@.
+type NeighborsMap = IM.IntMap (IM.IntMap Int, IM.IntMap Int)
+
+-- | Overflowing vertices grouped by level.
+-- Keys are levels (BFS distance from source); values are sets of
+-- vertices at that level with positive excess.
+--
+-- This structure determines the iteration order for globalPush
+-- (ascending level = left fold) and globalPull (descending level = right fold).
+type Overflowing = IM.IntMap Set.IntSet
+
+-- | The residual graph: the complete mutable state of the Tide algorithm.
+--
+-- Threaded through each tide iteration. Contains the underlying network,
+-- per-vertex and per-edge state, the neighbor map for O(log V) edge lookup,
+-- overflowing vertex sets, step counter, and the topology-change flag.
+data ResidualGraph =
+ ResidualGraph { network :: !Network
+ -- ^ The original flow network.
+ , netVertices :: !ResidualVertices
+ -- ^ Per-vertex state (level, height, excess).
+ , netEdges :: !ResidualEdges
+ -- ^ Per-edge state (capacity, flow).
+ , netNeighborsMap :: !NeighborsMap
+ -- ^ Adjacency map for O(log V) edge-index lookup.
+ , overflowing :: !Overflowing
+ -- ^ Overflowing vertices grouped by level.
+ , steps :: !Int
+ -- ^ Number of completed tide iterations.
+ , topologyChanged :: !Bool
+ -- ^ Whether any edge crossed a saturation boundary
+ -- (became saturated or unsaturated) during the
+ -- most recent push\/pull phase. When 'False',
+ -- the next tide can skip @globalRelabel@.
+ }
+ deriving (Show,Eq)
+
+-- | Build the initial 'ResidualGraph' from a 'Network'.
+--
+-- Saturates all edges leaving the source (setting their flow equal to
+-- capacity), sets the source height to @|V|@, and initializes the
+-- overflowing set with all vertices that received flow from the source.
+--
+-- The 'topologyChanged' flag is set to 'True' so the first tide always
+-- runs @globalRelabel@.
+initializeResidualGraph :: Network -> ResidualGraph
+initializeResidualGraph net =
+ let vs = initializeVertices net
+ es = initializeEdges net
+ neimap = getNetNeighborsMap $ graph net
+ in ResidualGraph { network = net
+ , netVertices = vs
+ , netEdges = es
+ , netNeighborsMap = neimap
+ , overflowing =
+ let ovfs = getOverflowing vs
+ bfs = BFS.bfs (graph net) (source net)
+ maxLevel = BFS.maxLevel bfs
+ fl v =
+ let (ResidualVertex _ l _ _) =
+ fromJust $ IM.lookup v vs
+ in l
+ in Set.foldl'
+ (\ac v ->
+ IM.adjust (\ps -> Set.insert v ps) (fl v) ac
+ ) (IM.fromList (zip [1..maxLevel] (repeat Set.empty))) ovfs
+ , steps = 0
+ , topologyChanged = True
+ }
+
+-- | Build the 'NeighborsMap' from a 'Graph'.
+--
+-- For each vertex @v@, computes:
+--
+-- * Forward map: @neighbor -> edgeIndex@ for edges @(v, neighbor)@
+-- * Reverse map: @neighbor -> edgeIndex@ for edges @(neighbor, v)@
+getNetNeighborsMap :: Graph -> NeighborsMap
+getNetNeighborsMap g =
+ let revgraph = reverseGraph g
+ neis v =
+ let fwd = IM.fromList
+ [ (n, fromJust $ edgeIndex g (Edge v n))
+ | n <- neighbors g v ]
+ rev = IM.fromList
+ [ (n, fromJust $ edgeIndex g (Edge n v))
+ | n <- neighbors revgraph v ]
+ in (fwd, rev)
+ in foldl'
+ (\ac v -> IM.insert v (neis v) ac)
+ IM.empty (vertices g)
+
+-- | Look up forward and reverse neighbor maps for a vertex.
+netNeighbors :: NeighborsMap
+ -> Vertex
+ -> (IM.IntMap Int, IM.IntMap Int)
+netNeighbors nm v =
+ fromJust $ IM.lookup v nm
+
+-- | O(log degree) edge index lookup via 'NeighborsMap'.
+--
+-- Looks up the edge index of @(u, v)@ by finding @v@ in the forward
+-- neighbor map of @u@. Returns 'Nothing' if the edge does not exist.
+resEdgeIndex :: NeighborsMap -> Edge -> Maybe Int
+resEdgeIndex nm (Edge u v) = do
+ (fwd, _) <- IM.lookup u nm
+ IM.lookup v fwd
+
+sourceEdges :: Network -> [(Edge,Capacity)]
+sourceEdges net =
+ let g = graph net
+ cs = capacities net
+ s = source net
+ cap v = fromJust $ M.lookup (Edge s v) cs
+ in map (\v -> ((Edge s v), cap v )) (neighbors g s)
+
+-- | Total capacity of all edges leaving the source.
+-- This is an upper bound on the maximum flow.
+sourceEdgesCapacity :: Network -> Capacity
+sourceEdgesCapacity net =
+ let ses = sourceEdges net
+ in sum $ map snd ses
+
+-- | Initialize vertex state: set source height to @|V|@, saturate source
+-- edges (giving excess to source neighbors), set all other heights to 0.
+initializeVertices :: Network -> ResidualVertices
+initializeVertices net =
+ let g = graph net
+ cs = capacities net
+ s = source net
+ t = sink net
+ sh = fromIntegral $ numVertices g
+ ses = sourceEdges net
+ vs = vertices $ graph net
+ flevels = BFS.level $ BFS.bfs (graph net) (source net)
+ fl v = fromJust $ IM.lookup v flevels
+ zvs = IM.fromList $
+ zip (vertices g) (map (\v ->
+ ResidualVertex v (fl v) 0 0) $ vertices g)
+ (sx, nvs) = foldl' (\(cx,ac) (e,c) ->
+ let v = to e
+ in (cx-c, IM.adjust (const (ResidualVertex v (fl v) 0 c)) v ac)) (0, zvs) ses
+ in IM.insert s (ResidualVertex s 0 sh sx) nvs
+
+-- | Initialize edge state: saturate source edges, set all others to zero flow.
+initializeEdges :: Network -> ResidualEdges
+initializeEdges net =
+ let g = graph net
+ cs = capacities net
+ s = source net
+ t = sink net
+ inites = IM.fromList $ map (\(e,c) -> (fromJust $ edgeIndex g e, ResidualEdge e c 0)) (M.toList cs)
+ ses = sourceEdges net
+ in foldl' (\ac (e,c) -> IM.insert (fromJust $ edgeIndex g e) (ResidualEdge e c c) ac) inites ses
+
+-- | Collect all vertices with positive excess.
+getOverflowing :: IM.IntMap ResidualVertex -> Set.IntSet
+getOverflowing nvs =
+ let xv (ResidualVertex v _ _ x) = x
+ vv (ResidualVertex v _ _ x) = v
+ in Set.fromList $ map snd $ IM.toList (IM.map (\nv -> vv nv) (IM.filter (\nv -> xv nv > 0) nvs))
+
+-- | Push flow along a /forward/ edge @(u, v)@.
+--
+-- Preconditions (checked, returns 'Nothing' if not met):
+--
+-- * @height(u) = height(v) + 1@ (flow goes downhill)
+-- * Residual capacity @c - f > 0@ (edge is not saturated)
+-- * @excess(u) > 0@ (source vertex has excess to push)
+--
+-- Pushes @min(excess(u), c - f)@ units of flow.
+-- Updates the 'topologyChanged' flag if the edge becomes saturated.
+push :: ResidualGraph -> Edge -> Maybe ResidualGraph
+push g e =
+ let u = from e
+ v = to e
+ hu = height g u
+ hv = height g v
+ xu = excess g u
+ xv = excess g v
+ c = edgeCapacity g e
+ f = edgeFlow g e
+ nvs = netVertices g
+ xf = min xu (c - f)
+ in if (hu == hv + 1) && xf > 0
+ then
+ let g' = foldr (\f ac -> f ac) g
+ [ (\nt -> updateEdge nt e (f + xf))
+ , (\nt -> updateExcess nt u (xu - xf))
+ , (\nt -> updateExcess nt v (xv + xf))
+ ]
+ in Just g'
+ else Nothing
+
+-- | Pull flow along a /reverse/ edge @(u, v)@.
+--
+-- This is the dual of 'push': it decreases flow on edge @(u, v)@ by moving
+-- excess from @v@ back to @u@.
+--
+-- Preconditions (checked, returns 'Nothing' if not met):
+--
+-- * @height(v) = height(u) + 1@ (pull goes uphill in the forward direction)
+-- * @flow(u, v) > 0@ (there is flow to pull back)
+-- * @excess(v) > 0@ (pulling vertex has excess)
+--
+-- Pulls @min(excess(v), flow)@ units.
+-- Updates the 'topologyChanged' flag if the edge becomes zero-flow.
+pull :: ResidualGraph -> Edge -> Maybe ResidualGraph
+pull g e =
+ let u = from e
+ v = to e
+ hu = height g u
+ hv = height g v
+ xu = excess g u
+ xv = excess g v
+ c = edgeCapacity g e
+ f = edgeFlow g e
+ nvs = netVertices g
+ xf = min xv f
+ in if (hv == hu + 1) && xf > 0
+ then
+ let g' = foldr (\f ac -> f ac) g
+ [ (\nt -> updateEdge nt e (f - xf))
+ , (\nt -> updateExcess nt u (xu + xf))
+ , (\nt -> updateExcess nt v (xv - xf))
+ ]
+ in Just g'
+ else Nothing
+
+-- | Update the height of a vertex. Source and sink heights are never modified.
+updateHeight :: ResidualGraph -> Vertex -> Height -> ResidualGraph
+updateHeight g v nh =
+ let netvs = netVertices g
+ !nv = fromJust $ IM.lookup v netvs
+ !x = excess g v
+ !l = level g v
+ !s = source $ network g
+ !t = sink $ network g
+ !nnetv = IM.update (\_ -> Just (ResidualVertex v l nh x)) v netvs
+ in if v == t || v == s
+ then g
+ else g { netVertices = nnetv }
+
+-- | Update the excess of a vertex and maintain the 'overflowing' index.
+--
+-- When excess transitions between zero and non-zero, the vertex is
+-- added to or removed from the 'Overflowing' map at its level.
+-- Source and sink are excluded from the overflowing set.
+updateExcess :: ResidualGraph -> Vertex -> Excess -> ResidualGraph
+updateExcess g v nx =
+ let netvs = netVertices g
+ nv = fromJust $ IM.lookup v netvs
+ h = height g v
+ l = level g v
+ ovfs = overflowing g
+ s = source $ network g
+ t = sink $ network g
+ newovfs =
+ if v == s || v == t
+ then ovfs
+ else
+ let ovfs' = IM.update (\lvs ->
+ let lset = Set.delete v lvs
+ in if Set.null lset
+ then Nothing
+ else Just lset) l ovfs
+ in if nx == 0
+ then
+ ovfs'
+ else
+ let mlset = IM.lookup l ovfs'
+ in case mlset of
+ Nothing -> IM.insert l (Set.singleton v) ovfs'
+ Just lset -> IM.adjust (Set.insert v) l ovfs'
+ in if v == t then g
+ else g { netVertices = IM.insert v (ResidualVertex v l h nx) netvs
+ , overflowing = newovfs
+ }
+
+-- | Update the flow on an edge and track topology changes.
+--
+-- A topology change occurs when a forward residual edge appears or
+-- disappears (flow crosses the capacity boundary) or a backward residual
+-- edge appears or disappears (flow crosses zero).
+-- The 'topologyChanged' flag is set to 'True' (OR-ed) if such a change occurs.
+updateEdge :: ResidualGraph -> Edge -> Flow -> ResidualGraph
+updateEdge g e f =
+ let es = netEdges g
+ eid = fromJust $ resEdgeIndex (netNeighborsMap g) e
+ (ResidualEdge e' c f') = fromJust $ IM.lookup eid es
+ -- Detect if edge crossed a saturation boundary:
+ -- forward edge exists iff flow < capacity
+ -- backward edge exists iff flow > 0
+ !fwdBefore = f' < c
+ !fwdAfter = f < c
+ !bwdBefore = f' > 0
+ !bwdAfter = f > 0
+ !changed = (fwdBefore /= fwdAfter) || (bwdBefore /= bwdAfter)
+ in g { netEdges = IM.adjust (const (ResidualEdge e c f)) eid es
+ , topologyChanged = topologyChanged g || changed
+ }
+
+-- | Net flow into the sink. This is the current flow value of the network.
+-- At termination, this equals the maximum flow.
+netFlow :: ResidualGraph -> Flow
+netFlow g = inflow g (sink (network g))
+
+-- | Height of a vertex.
+height :: ResidualGraph -> Vertex -> Height
+height rg v =
+ let g = graph $ network rg
+ s = source $ network rg
+ t = sink $ network rg
+ nvs = fromIntegral $ numVertices g
+ (ResidualVertex nv l h x) = fromJust $ IM.lookup v (netVertices rg)
+ in h
+
+-- | Excess of a vertex.
+excess :: ResidualGraph -> Vertex -> Excess
+excess rg v =
+ let g = graph $ network rg
+ s = source $ network rg
+ t = sink $ network rg
+ nvs = fromIntegral $ numVertices g
+ (ResidualVertex nv l h x) = fromJust $ IM.lookup v (netVertices rg)
+ in x
+
+-- | Level of a vertex (shortest distance from source in original graph).
+level :: ResidualGraph -> Vertex -> Level
+level rg v =
+ let g = graph $ network rg
+ s = source $ network rg
+ t = sink $ network rg
+ nvs = fromIntegral $ numVertices g
+ (ResidualVertex nv l h x) = fromJust $ IM.lookup v (netVertices rg)
+ in l
+
+-- | Capacity of an edge.
+edgeCapacity :: ResidualGraph -> Edge -> Capacity
+edgeCapacity g e = let (ResidualEdge ne c f) = fromJust $ IM.lookup (fromJust $ resEdgeIndex (netNeighborsMap g) e) (netEdges g)
+ in c
+
+-- | Current flow on an edge.
+edgeFlow :: ResidualGraph -> Edge -> Flow
+edgeFlow g e = let (ResidualEdge ne c f) = fromJust $ IM.lookup (fromJust $ resEdgeIndex (netNeighborsMap g) e) (netEdges g)
+ in f
+
+-- | Total flow into a vertex (sum of flows on incoming edges).
+inflow :: ResidualGraph -> Vertex -> Flow
+inflow g v =
+ let (_, revMap) = netNeighbors (netNeighborsMap g) v
+ reds = map (\n -> fromTuple (n,v)) $ IM.keys revMap
+ in foldl' (\ac e -> (ac + edgeFlow g e)) 0 reds
+
+-- | Total flow out of a vertex (sum of flows on outgoing edges).
+outflow :: ResidualGraph -> Vertex -> Flow
+outflow g v =
+ let (fwdMap, _) = netNeighbors (netNeighborsMap g) v
+ reds = map (\n -> fromTuple (v,n)) $ IM.keys fwdMap
+ in foldl' (\ac e -> (ac + edgeFlow g e)) 0 reds
+
+-- | Reconstruct the 'Network' with final edge flows from the residual graph.
+-- Called when the algorithm terminates.
+networkFromResidual :: ResidualGraph -> Network
+networkFromResidual resg =
+ let net = network resg
+ es = edges $ graph $ net
+ flow' = M.fromList $ map (\e -> (e, edgeFlow resg e) ) es
+ in net {flow = flow'}
+
+-- | Compute distances from source and sink in the residual graph via BFS.
+--
+-- Returns @(sourceDists, sinkDists)@ where:
+--
+-- * @sourceDists@: @IntMap@ from vertex to BFS distance from source
+-- (traversing edges with residual capacity > 0 in reverse, and edges
+-- with flow > 0 forward)
+-- * @sinkDists@: @IntMap@ from vertex to BFS distance from sink
+-- (traversing edges with residual capacity > 0 forward, and edges
+-- with flow > 0 in reverse)
+--
+-- Used by @globalRelabel@ to set vertex heights:
+-- source-side vertices get @height = |V| + dist_from_source@,
+-- sink-side vertices get @height = dist_from_sink@.
+residualDistances :: ResidualGraph -> (IM.IntMap Int, IM.IntMap Int)
+residualDistances rg =
+ let es = map snd (IM.toList $ netEdges rg)
+ -- forward residual edges (flow < capacity)
+ tres = filter (\(ResidualEdge e c f) -> f < c) es
+ -- backward residual edges (flow > 0)
+ tbes = filter (\(ResidualEdge e c f) -> f > 0) es
+ tfsatnbs = foldl' (\ac (ResidualEdge e c f) ->
+ let u = from e
+ v = to e
+ mns = IM.lookup v ac
+ in case mns of
+ Nothing -> IM.insert v [u] ac
+ Just ns -> IM.insert v (u:ns) ac
+ ) IM.empty tres
+ tsatnbs = foldl' (\ac (ResidualEdge e c f) ->
+ let u = from e
+ v = to e
+ mns = IM.lookup u ac
+ in case mns of
+ Nothing -> IM.insert u [v] ac
+ Just ns -> IM.insert u (v:ns) ac
+ ) tfsatnbs tbes
+ sfsatnbs = foldl' (\ac (ResidualEdge e c f) ->
+ let u = from e
+ v = to e
+ mns = IM.lookup u ac
+ in case mns of
+ Nothing -> IM.insert u [v] ac
+ Just ns -> IM.insert u (v:ns) ac
+ ) IM.empty tres
+ ssatnbs = foldl' (\ac (ResidualEdge e c f) ->
+ let u = from e
+ v = to e
+ mns = IM.lookup v ac
+ in case mns of
+ Nothing -> IM.insert v [u] ac
+ Just ns -> IM.insert v (u:ns) ac
+ ) sfsatnbs tbes
+ tlvs = BFS.level $ BFS.adjBFS tsatnbs t
+ slvs = BFS.level $ BFS.adjBFS ssatnbs s
+ in (slvs, tlvs)
+ where
+ g = graph $ network rg
+ s = source $ network rg
+ t = sink $ network rg
+
+-- | Compute the source-sink minimum cut from the residual graph.
+--
+-- Returns @(S, T)@ where @S@ is the set of vertices reachable from the
+-- source in the residual graph (excluding source and sink) and @T@ is
+-- the complement. By the max-flow min-cut theorem, the total capacity
+-- of edges crossing from @S@ to @T@ equals the maximum flow.
+stCut :: ResidualGraph -> ([Vertex],[Vertex])
+stCut rg =
+ let !resdis = residualDistances rg
+ ts = Set.delete s $ Set.delete t $ Set.fromList $ map fst (IM.toList (snd resdis))
+ g = graph $ network rg
+ s = source $ network rg
+ t = sink $ network rg
+ vs = Set.delete s $ Set.delete t $ Set.fromList $ vertices g
+ ss = Set.difference vs ts
+ in (Set.toList ss, Set.toList ts)
diff --git a/src/Data/Graph/AdjacencyList/PushRelabel/Pure.hs b/src/Data/Graph/AdjacencyList/PushRelabel/Pure.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/PushRelabel/Pure.hs
@@ -0,0 +1,277 @@
+{-|
+Module : Data.Graph.AdjacencyList.PushRelabel.Pure
+Description : Tide algorithm — a push-pull-relabel max-flow solver
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+= Tide — Push (Pull) Relabel
+
+The Tide algorithm is a push-relabel variant for solving the
+
+on directed graphs.
+
+== Definitions
+
+A network \( N = (G, s, t, C) \) consists of a directed graph \( G \),
+source \( s \), sink \( t \), and capacities \( C : E \to \mathbb{R}^+ \).
+
+The /residual graph/ \( R \) contains both forward edges (with residual
+capacity \( c - f \)) and backward edges (with capacity \( f \)).
+Each vertex carries:
+
+* __Height__ \( h(v) \): determines whether flow can be pushed along an edge
+ (flow moves from higher to lower height).
+* __Excess__ \( x(v) \): records the net surplus of flow at \( v \).
+ At termination all excesses are zero and the preflow is a valid max flow.
+* __Level__ \( \ell(v) \): the BFS distance from source in the /original/
+ graph \( G \). Constant throughout the algorithm. Determines the
+ sweep order.
+
+== Operations
+
+The key difference from classical push-relabel is that the push operation
+is split into two:
+
+* __Push__ (on forward edges): increases flow towards the sink.
+* __Pull__ (on reverse edges): decreases flow, effectively pulling excess
+ backwards towards the source.
+
+== Algorithm
+
+Each iteration (\"tide\") consists of three global sweeps:
+
+1. __globalRelabel__: BFS from sink (and source) on the residual graph to
+ recompute vertex heights. Source-side vertices get
+ \( h = |V| + d_s(v) \); sink-side vertices get \( h = d_t(v) \).
+
+2. __globalPull__: /right fold/ over overflowing vertices in descending
+ level order, pulling flow on reverse edges (from sink towards source).
+
+3. __globalPush__: /left fold/ over overflowing vertices in ascending
+ level order, pushing flow on forward edges (from source towards sink).
+
+The algorithm terminates when both the net flow and the set of overflowing
+vertices are unchanged between consecutive tides.
+
+=== Skip-globalRelabel optimization
+
+When no edge crosses a saturation boundary during push\/pull (the
+'topologyChanged' flag is 'False'), the residual graph topology is
+unchanged and globalRelabel is skipped. This saves 1.25--1.61x in
+practice.
+
+== Complexity
+
+* Per-tide cost: \( O((V+E) \log V) \) with IntMap data structures.
+* Number of tides: \( O(V^2) \) worst case (requires exponential capacity
+ ratios); \( O(V) \) in practice on non-pathological graphs.
+* Total: \( O(V^2 (V+E) \log V) \) worst case;
+ \( O(V (V+E) \log V) \) practical.
+
+See also the Rust implementation @tide-maxflow@ which achieves \( O(VE) \)
+practical complexity using O(1) array-based data structures.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module Data.Graph.AdjacencyList.PushRelabel.Pure
+ ( -- * Main entry point
+ pushRelabel
+ -- * Algorithm internals (exported for testing)
+ , tide
+ , globalPush
+ , globalPull
+ , globalRelabel
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map.Lazy as M
+import qualified Data.IntMap.Lazy as IM
+import qualified Data.IntSet as Set
+import Control.Monad
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Network
+import Data.Graph.AdjacencyList.PushRelabel.Internal
+import qualified Data.Graph.AdjacencyList.BFS as BFS
+
+-- | Solve the maximum flow problem on a 'Network' using the Tide algorithm.
+--
+-- Returns @Right rg@ on success, where @rg@ is the 'ResidualGraph' at
+-- termination. The maximum flow value is @netFlow rg@ and per-edge flows
+-- are available via @edgeFlow rg e@ or via @flow (network rg)@.
+--
+-- Returns @Left msg@ if an internal invariant is violated (should not happen
+-- on valid inputs).
+--
+-- ==== Example
+--
+-- @
+-- let g = graphFromEdges [Edge 0 1, Edge 0 2, Edge 1 3, Edge 2 3]
+-- caps = M.fromList [(Edge 0 1, 10), (Edge 0 2, 10), (Edge 1 3, 10), (Edge 2 3, 10)]
+-- net = Network g 0 3 caps (M.fromList [(e, 0) | e <- edges g])
+-- case pushRelabel net of
+-- Right rg -> print (netFlow rg) -- 20
+-- Left err -> putStrLn err
+-- @
+pushRelabel :: Network -> Either String ResidualGraph
+pushRelabel net =
+ let initg = initializeResidualGraph net
+ res = tide initg 0
+ nvs = vertices $ graph $ network res
+ s = source net
+ t = sink net
+ insouts = filter (\v -> v /= s && v /= t && inflow res v < outflow res v) nvs
+ xsflows = filter (\v -> v /= s && v /= t && inflow res v - outflow res v /= excess res v) nvs
+ ofvs = IM.foldr (\ovs ac -> Set.union ac ovs) Set.empty $ overflowing res
+ notofvs = filter (\ ov ->
+ let (ResidualVertex v l h x) = fromJust (IM.lookup ov (netVertices res))
+ ml = (IM.lookup l (overflowing res))
+ in case ml of
+ Nothing -> True
+ Just os -> not $ Set.member ov os
+ ) $ Set.toList $ getOverflowing $ netVertices res
+ errovfs = Set.filter (\v -> excess res v == 0) ofvs
+ in if null insouts && null xsflows && Set.null errovfs && null notofvs
+ then Right res
+ else
+ if not $ null insouts
+ then Left $ "Error Inflow < Outflow " ++ show insouts
+ else
+ if not $ null xsflows
+ then Left $ "Error vertex excess " ++ show xsflows
+ else
+ if not $ Set.null errovfs
+ then Left $ "Error not really overflowing " ++ show errovfs
+ else Left $ "Error not in overflowing " ++ show notofvs
+ ++ " overflowings are " ++ show (overflowing res)
+ ++ " nevertices are " ++ show (netVertices res)
+
+-- | Core recursive loop of the Tide algorithm.
+--
+-- Each call performs one tide: globalRelabel (unless skipped), then
+-- globalPull, then globalPush. Recurses until convergence (net flow
+-- and overflowing set unchanged).
+--
+-- The @steps@ parameter counts completed iterations.
+tide :: ResidualGraph -> Int -> ResidualGraph
+tide rg steps =
+ let g = rg `seq` (graph $ network rg)
+ s = source $ network rg
+ t = sink $ network rg
+ es = edges g
+ vs = vertices g
+ olf = netFlow rg
+ -- Only run globalRelabel if the residual topology changed
+ relabeled = if topologyChanged rg
+ then globalRelabel rg
+ else rg
+ -- Reset flag before push/pull so we detect new changes
+ rg0 = relabeled { topologyChanged = False }
+ rg' = globalPush $ globalPull rg0 -- then global push and then global pull
+ nfl = netFlow rg'
+ steps' = steps + 1
+ oovfls = overflowing rg
+ novfls = overflowing rg'
+ in if nfl == olf -- if new flow == old flow
+ then
+ if oovfls == novfls -- and the overflowing nodes didn't change
+ then rg' { network = networkFromResidual rg' -- algorithm ends
+ , steps = steps'}
+ else tide rg' steps'
+ else tide rg' steps'
+
+-- | Global push: sweep overflowing vertices from source to sink.
+--
+-- Iterates over overflowing vertices in /ascending level order/ (left fold
+-- on the 'Overflowing' IntMap), pushing flow on all eligible /forward/
+-- edges from each vertex.
+--
+-- This moves excess flow from source-side vertices towards the sink.
+globalPush :: ResidualGraph -> ResidualGraph
+globalPush rg =
+ let ovfs = overflowing rg
+ in IM.foldl' (\ac lset ->
+ Set.foldl' (\ac' v -> pushNeighbors ac' v)
+ ac lset
+ ) rg ovfs
+
+-- | Global pull: sweep overflowing vertices from sink to source.
+--
+-- Iterates over overflowing vertices in /descending level order/ (right fold
+-- on the 'Overflowing' IntMap), pulling flow on all eligible /reverse/
+-- edges to each vertex.
+--
+-- This moves excess flow from sink-side vertices back towards the source.
+globalPull :: ResidualGraph -> ResidualGraph
+globalPull rg =
+ let ovfs = overflowing rg
+ in IM.foldr' (\lset ac ->
+ Set.foldl' (\ac' v -> pullNeighbors ac' v)
+ ac lset
+ ) rg ovfs
+
+-- | Push flow through all forward residual neighbors of a vertex.
+pushNeighbors :: ResidualGraph -> Vertex -> ResidualGraph
+pushNeighbors g v =
+ let neimap = netNeighborsMap g
+ (fwdMap, _) = fromJust $ IM.lookup v neimap
+ feds = map (\n -> fromTuple (v,n)) $ IM.keys fwdMap
+ in foldl' (\ac e ->
+ let mv = push ac e
+ in case mv of
+ Nothing -> ac
+ Just g'' -> g'') g feds
+
+-- | Pull flow through all reverse residual neighbors of a vertex.
+pullNeighbors :: ResidualGraph -> Vertex -> ResidualGraph
+pullNeighbors g v =
+ let neimap = netNeighborsMap g
+ (_, revMap) = fromJust $ IM.lookup v neimap
+ reds = map (\n -> fromTuple (n,v)) $ IM.keys revMap
+ in foldl' (\ac e ->
+ let mv = pull ac e
+ in case mv of
+ Nothing -> ac
+ Just g'' -> g'') g reds
+
+-- | Global relabel: recompute vertex heights via BFS on the residual graph.
+--
+-- Runs BFS from both source and sink on the residual graph to compute
+-- distances. Sets vertex heights:
+--
+-- * Sink-side vertices: @height = distance_from_sink@
+-- * Source-side vertices: @height = |V| + distance_from_source@
+--
+-- The height gap between source-side and sink-side vertices ensures
+-- that flow can only move from source-side to sink-side (downhill).
+globalRelabel :: ResidualGraph -> ResidualGraph
+globalRelabel rg =
+ let g = graph $ network rg
+ sh = numVertices g
+ s = source $ network rg
+ t = sink $ network rg
+ (slvs, tlvs) = residualDistances rg
+ -- Vertices not reached by either BFS get height 2*|V| so their
+ -- excess drains back to the source via pull operations.
+ allVs = Set.fromList (vertices g)
+ reachedS = Set.fromList (IM.keys slvs)
+ reachedT = Set.fromList (IM.keys tlvs)
+ reached = Set.union reachedS reachedT
+ unreached = Set.difference allVs reached
+ deadHeight = 2 * sh
+ rg0 = Set.foldl' (\ac v -> updateHeight ac v deadHeight) rg unreached
+ rg' = IM.foldrWithKey
+ (\ v l ac ->
+ -- Heights for the source partition vertices is N + their distance to the source
+ let h = sh + l
+ in updateHeight ac v h
+ ) rg0 slvs
+ in IM.foldrWithKey (\ v h ac
+ -- Heights for the sink partition vertices equals the distance from sink
+ -> updateHeight ac v h)
+ rg' tlvs
diff --git a/src/Data/Graph/AdjacencyList/WFI.hs b/src/Data/Graph/AdjacencyList/WFI.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/AdjacencyList/WFI.hs
@@ -0,0 +1,93 @@
+{-|
+Module : Data.Graph.AdjacencyList.WFI
+Description : Floyd-Warshall all-pairs shortest paths
+Copyright : Thodoris Papakonstantinou, 2017-2026
+License : LGPL-3
+Maintainer : dev@tpapak.com
+Stability : experimental
+Portability : POSIX
+
+Implementation of the
+
+for computing all-pairs shortest path distances on a weighted or unweighted
+directed graph. Complexity: O(V^3).
+ -}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+
+module Data.Graph.AdjacencyList.WFI
+ ( Distances (..)
+ , Weight
+ , IMArray
+ , shortestDistances
+ , unweightedShortestDistances
+ , adjacencyArray
+ ) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M
+import qualified Data.IntMap as IM
+
+import Data.Graph.AdjacencyList
+
+-- | In an unweighted graph the weight is 1 for each edge
+type Weight = Rational
+
+-- | Two-dimensional distance matrix: vertex → vertex → 'Weight'.
+type IMArray = IM.IntMap (IM.IntMap Weight)
+-- | The array containing the distances from vertex to vertex
+newtype Distances = Distances IMArray
+ deriving (Eq, Ord, Read)
+
+instance Show Distances where
+ show (Distances d) =
+ let vs = IM.keys d
+ in show d
+
+-- | Reads distance array. Nothing corresponds to infinite distance
+shortestDistance :: IMArray -> Vertex -> Vertex -> Maybe Weight
+shortestDistance dists u v = do
+ vmap <- IM.lookup u dists
+ IM.lookup v vmap
+
+-- | Build the initial distance matrix from a graph's edges (unit weights).
+-- Self-distances are 0; direct edges have distance 1; all others are absent
+-- (infinite). Pass the result to 'shortestDistances' to run Floyd-Warshall.
+adjacencyArray :: Graph -> Distances
+adjacencyArray g =
+ let es = edges g
+ dists = foldl' (\dists (Edge u v) ->
+ let vmap = case IM.lookup u dists of
+ Nothing -> IM.empty
+ Just vmap' -> vmap'
+ in IM.insert u ((IM.insert v 1) vmap) dists
+ ) IM.empty es
+ in Distances $ IM.mapWithKey (\i m -> IM.insert i 0 m) dists
+
+-- | Get all shortest distances given initial weights on edges
+shortestDistances :: Graph -> Distances -> Distances
+shortestDistances g (Distances dists) = Distances $ foldl' update dists vs
+ where
+ vs = vertices g
+ update d k = IM.mapWithKey shortmap d
+ where
+ shortmap :: Vertex -> IM.IntMap Weight -> IM.IntMap Weight
+ shortmap i jmap = foldr shortest IM.empty vs
+ where shortest j m =
+ case (old,new) of
+ (Nothing, Nothing) -> m
+ (Nothing, Just w ) -> IM.insert j w m
+ (Just w, Nothing) -> IM.insert j w m
+ (Just w1, Just w2) -> IM.insert j (min w1 w2) m
+ where
+ old = IM.lookup j jmap
+ new = do w1 <- shortestDistance d i k
+ w2 <- shortestDistance d k j
+ return (w1+w2)
+
+-- | Get all shortest unweighted distances
+unweightedShortestDistances :: Graph -> Distances
+unweightedShortestDistances g = shortestDistances g (adjacencyArray g)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,27 @@
+import qualified TestHS as T
+import Test.Graph.AdjacencyList as A
+import Test.Graph.AdjacencyList.Grid as G
+import Test.Graph.AdjacencyList.BFS as BFS
+import Test.Graph.AdjacencyList.DFS as DFS
+import Test.Graph.AdjacencyList.WFI as WFI
+import Test.Graph.AdjacencyList.Metrics as Met
+import Test.Graph.AdjacencyList.PushRelabel.Pure as PRP
+import Test.Graph.AdjacencyList.PushRelabel.FGLComparison as FGL
+
+main :: IO ()
+main = do
+ putStrLn "\n"
+ putStrLn "Test Begins"
+ T.reportTests $
+ A.fastTests
+ ++ G.fastTests
+ ++ BFS.fastTests
+ ++ DFS.fastTests
+ ++ PRP.fastTests
+ ++ WFI.fastTests
+ ++ Met.fastTests
+ T.reportTestsIO
+ Met.ioTests
+ putStrLn "\nQuickCheck: Tide vs FGL (10000 random graphs)"
+ T.reportTestsIO
+ FGL.ioTests
diff --git a/test/Test/Graph/AdjacencyList.hs b/test/Test/Graph/AdjacencyList.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList.hs
@@ -0,0 +1,68 @@
+module Test.Graph.AdjacencyList where
+
+import Data.Bifunctor
+import Data.List
+import Data.List.Unique
+import qualified Data.Binary as Bin
+
+import TestHS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Grid
+
+fastTests :: [Test]
+fastTests = [ test1
+ , testRemoveReverseEdges
+ ]
+
+edgesTest1 = map fromTuple
+ [(1,2),(1,5),(1,6)
+ ,(2,5),(2,3)
+ ,(3,4)
+ ,(5,4),(5,7)
+ ,(6,7)
+ ,(7,4)
+ ]
+
+graphTest1 =
+ let vs = [1..7]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [5,3]
+ nei 3 = [4]
+ nei 4 = []
+ nei 5 = [4,7]
+ nei 6 = [7]
+ nei 7 = [4]
+ in nei v
+ )
+ in createGraph vs neis
+
+test1 :: Test
+test1 = do
+ let name = "Graph from edges"
+ gr1 = graphFromEdges edgesTest1
+ case gr1 == graphTest1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show graphTest1) (show gr1)
+
+testRemoveReverseEdges :: Test
+testRemoveReverseEdges = do
+ let name = "Remove reverse edges from komplete 5 graph"
+ k5 = completeGraph 5
+ dk5 = removeReverseEdges k5
+ expected = [ (Edge 1 2)
+ , (Edge 1 3)
+ , (Edge 1 4)
+ , (Edge 1 5)
+ , (Edge 2 3)
+ , (Edge 2 4)
+ , (Edge 2 5)
+ , (Edge 3 4)
+ , (Edge 3 5)
+ , (Edge 4 5)
+ ]
+ if edges dk5 == expected
+ then
+ testPassed name "passed!"
+ else
+ testFailed name $ (,) (show expected) (show dk5)
diff --git a/test/Test/Graph/AdjacencyList/BFS.hs b/test/Test/Graph/AdjacencyList/BFS.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/BFS.hs
@@ -0,0 +1,83 @@
+module Test.Graph.AdjacencyList.BFS where
+
+import Data.Maybe
+import Data.List
+import Data.List.Unique
+import TestHS
+
+import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+
+import qualified Data.Graph.Inductive as I
+import qualified Data.Graph.Inductive.Graph as G
+import qualified Data.Graph.Inductive.Query.BFS as IBFS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.BFS
+import Data.Graph.AdjacencyList.Grid
+
+fastTests :: [Test]
+fastTests = [ test1
+ , test2
+ , spanningtreetest
+ , spanningtreeUndirected
+ ]
+
+
+graphTest1 =
+ let vs = [1..7]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [5,3]
+ nei 3 = [4]
+ nei 4 = []
+ nei 5 = [4,7]
+ nei 6 = [7]
+ nei 7 = [4]
+ in nei v
+ )
+ in createGraph vs neis
+
+test1 :: Test
+test1 = do
+ let name = "Test bfs on TestGraph1"
+ out = level $ bfs graphTest1 1
+ expe = IM.fromList [(1,0),(2,1),(5,1),(6,1),(3,2),(4,2),(7,2)]
+ in case out == expe of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show expe) (show out)
+
+test2 :: Test
+test2 = do
+ let name = "BFS in undirected grid tested against fgl library"
+ l = (6 :: L)
+ d = (3 :: D)
+ lat = graphCubicPBC (PBCSquareLattice l d)
+ latbfs = bfs lat 18
+ out = sort $ IM.toList (level latbfs)
+ vs = map (\v -> (v,())) $ vertices lat :: [G.UNode]
+ es = map (\(f,t) -> (f,t,1)) $ (map toTuple (edges lat)) :: [G.LEdge Double]
+ ingr = G.mkGraph vs es :: I.Gr () Double
+ expe = sort $ IBFS.level 18 ingr
+ case expe == out of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) ("\n" ++ show expe)
+ ("\n" ++ show out ++ "\n" ++ show latbfs ++ "\n" ++ show lat)
+
+spanningtreetest :: Test
+spanningtreetest = do
+ let name = "Get Spanning Tree from BFS"
+ out = spanningTree $ bfs graphTest1 1
+ expe = map fromTuple [(1,2),(2,3),(5,4),(1,5),(1,6),(5,7)]
+ in case out == expe of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show expe) (show out)
+
+spanningtreeUndirected :: Test
+spanningtreeUndirected = do
+ let name = "Get Spanning Tree from BFS undirected graph"
+ ungr = makeUndirected graphTest1
+ out = spanningTree $ bfs ungr 1
+ expe = map fromTuple [(1,2),(2,3),(5,4),(1,5),(1,6),(5,7)]
+ in case out == expe of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show expe) (show out)
diff --git a/test/Test/Graph/AdjacencyList/DFS.hs b/test/Test/Graph/AdjacencyList/DFS.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/DFS.hs
@@ -0,0 +1,141 @@
+module Test.Graph.AdjacencyList.DFS where
+
+import Data.Maybe
+import Data.List
+import Data.List.Unique
+import TestHS
+
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Sequence as Seq
+import qualified Data.IntSet as Set
+import Data.Maybe
+
+import qualified Data.Graph.Inductive as I
+import qualified Data.Graph.Inductive.Graph as G
+import qualified Data.Graph.Inductive.Query.DFS as IDFS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.DFS
+import Data.Graph.AdjacencyList.Grid
+
+fastTests :: [Test]
+fastTests = [ testdfs1
+ , testlongest1
+ , testlongest2
+ , testlongest3
+ , testlongest4
+ , testdfs2
+ , outofrange
+ , getdirect
+ ]
+
+-- | DAG
+graphTest1 =
+ let vs = [1..8]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [3,5]
+ nei 3 = [4,6]
+ nei 4 = [7]
+ nei 5 = [4,7]
+ nei 6 = [8,7]
+ nei 7 = []
+ nei 8 = [7]
+ in nei v
+ )
+ in createGraph vs neis
+
+testdfs1 :: Test
+testdfs1 = do
+ let name = "Test DFS topsort on a graph with hamiltonian path"
+ testgraph = graphFromEdges $ (edges graphTest1) ++ [(Edge 3 5),(Edge 5 6),(Edge 8 4)]
+ out = dfs testgraph 1
+ expe = [1,2,3,5,6,8,4,7]
+ in case topsort out == expe of
+ True -> testPassed name $ "passed!" <> (show out)
+ False -> testFailed name $ (,) (show expe) (show out)
+
+-- | DAG
+graphTest2 =
+ let vs = [1..4]
+ neis = (\v -> let nei 1 = [2,3]
+ nei 2 = []
+ nei 3 = [4]
+ nei 4 = [2]
+ in nei v
+ )
+ in createGraph vs neis
+
+testdfs2 :: Test
+testdfs2 = do
+ let name = "Test DFS on TestGraph2"
+ out = dfs graphTest2 1
+ expe = [1,3,4,2]
+ in case topsort out == expe of
+ True -> testPassed name $ "passed!" <> (show out)
+ False -> testFailed name $ (,) (show expe) (show $ topsort out)
+
+testlongest1 :: Test
+testlongest1 = do
+ let name = "Test longest path 1 7 on TestGraph1"
+ out = map toTuple $ longestPath graphTest1 1 7
+ outdfs = dfs graphTest1 1
+ expe = [(1,2),(2,3),(3,6),(6,8),(8,7)]
+ in case out == expe of
+ True -> testPassed name $ "passed!" <> (show out)
+ False -> testFailed name $ (,) (show expe) (show out <> show outdfs)
+
+testlongest2 :: Test
+testlongest2 = do
+ let name = "Test longest path 1 8 on TestGraph1"
+ out = map toTuple $ longestPath graphTest1 1 8
+ tdfs = dfs graphTest1 1
+ expe = [(1,2),(2,3),(3,6),(6,8)]
+ in case out == expe of
+ True -> testPassed name $ "passed!" <> (show out)
+ False -> testFailed name $ (,) (show expe) (show out <> show tdfs)
+
+testlongest3 :: Test
+testlongest3 = do
+ let name = "Test longest path 2 8 on TestGraph2"
+ out = map toTuple $ longestPath graphTest1 2 8
+ expe = [(2,3),(3,6),(6,8)]
+ in case out == expe of
+ True -> testPassed name $ "passed!" <> (show out)
+ False -> testFailed name $ (,) (show expe) (show out)
+
+graphTest3 =
+ let edges =
+ map fromTuple
+ [(1,3),(2,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,3),(4,5),(5,1),(5,3),(6,1),(6,3),(6,4)]
+ in graphFromEdges edges
+
+testlongest4 :: Test
+testlongest4 = do
+ let name = "topsort 2 3 on TestGraph3"
+ tdfs = dfs graphTest3 2
+ out = postordering tdfs
+ expe = [3,1,5,4,6,2]
+ tgr = map (neighbors graphTest3) [1..6]
+ in case out == expe of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) (show expe) (show tdfs <> show tgr)
+
+outofrange :: Test
+outofrange = do
+ let name = "longest from 3 to 2 on TestGraph3"
+ tdfs = dfs graphTest3 3
+ out = longestPath graphTest3 3 2
+ in case null out of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) ("[]") (show out)
+
+getdirect :: Test
+getdirect = do
+ let name = "longest of direct"
+ gr = graphFromEdges $ map fromTuple [(4,5),(1,5)]
+ tdfs = dfs gr 1
+ out = longestPath gr 1 5
+ expe = map fromTuple [(1,5)]
+ in case out == expe of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) ("[(1,5)]") (show out)
diff --git a/test/Test/Graph/AdjacencyList/Grid.hs b/test/Test/Graph/AdjacencyList/Grid.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/Grid.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Test.Graph.AdjacencyList.Grid where
+
+import Data.Bifunctor
+import Data.List
+import Data.List.Unique
+import Data.Maybe
+import qualified Data.Map.Lazy as M
+
+import TestHS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Grid
+
+fastTests :: [Test]
+fastTests = [ test2dpbc1
+ , test2dpbc2
+ , test3dpbc1
+ , test3dpbc2
+ , test4dpbc1
+ , testforwards
+ , vertexToCVertexToVertex
+ , testEdgeUndir
+ , testEdgeDir
+ ]
+
+test2dpbc1 :: Test
+test2dpbc1 = do
+ let name = "Neighbors of 1 in a square"
+ neigh1 = [2,3]
+ out = sortUniq $ neighbors (graphCubicPBC (PBCSquareLattice (2 :: L) (2 :: D))) (1 :: Vertex)
+ case out == neigh1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show neigh1) (show out)
+
+test2dpbc2 :: Test
+test2dpbc2 = do
+ let name = "Neighbors of 1 in L=4 D=2"
+ neigh1 = [2,4,5,13]
+ out = sortUniq $ neighbors (undirectedGraphCubicPBC (PBCSquareLattice (4 :: L) (2 :: D))) (1 :: Vertex)
+ case out == neigh1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show neigh1) (show out)
+
+test3dpbc1 :: Test
+test3dpbc1 = do
+ let name = "Neighbors of 1 in L=2 D=3"
+ neigh1 = [2,3,5]
+ out = sortUniq $ neighbors (graphCubicPBC (PBCSquareLattice (2 :: L) (3 :: D))) (1 :: Vertex)
+ case out == neigh1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show neigh1) (show out)
+
+
+test3dpbc2 :: Test
+test3dpbc2 = do
+ let name = "Neighbors of 1 in L=4 D=3"
+ neigh1 = [2,4, 5,13, 17,49]
+ out = sortUniq $ neighbors (undirectedGraphCubicPBC (PBCSquareLattice (4 :: L) (3 :: D))) (1 :: Vertex)
+ case out == neigh1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show neigh1) (show out)
+
+test4dpbc1 :: Test
+test4dpbc1 = do
+ let name = "Neighbors of 1 in L=2 D=4"
+ neigh1 = [2,3,5,9]
+ out = sortUniq $ neighbors (graphCubicPBC (PBCSquareLattice (2 :: L) (4 :: D))) (1 :: Vertex)
+ case out == neigh1 of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (bimap <$> id <*> id) show (neigh1, out)
+
+testforwards :: Test
+testforwards = do
+ let name = "Edges of pbcsql L=3 D=2"
+ lat = graphCubicPBC (PBCSquareLattice (3 :: L) (2 :: D))
+ expe = [(1,2),(1,4),(2,3),(2,5),(3,1),(3,6),(4,5),(4,7),(5,6),(5,8),(6,4),(6,9),(7,8),(7,1),(8,9),(8,2),(9,7),(9,3)]
+ out = map toTuple $ edges lat
+ case all id (map (\e -> elem e expe) out) of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (bimap <$> id <*> id) show (expe, out)
+
+vertexToCVertexToVertex :: Test
+vertexToCVertexToVertex = do
+ let name = "Turn vertex to cartesian vertex and back for PBCSquare lattice"
+ l = (3 :: L)
+ d = (3 :: D)
+ lat = undirectedGraphCubicPBC (PBCSquareLattice l d)
+ vs = vertices lat
+ cvs = map (vertexToCVertex l d) vs
+ vs' = map (cVertexToVertex l d) cvs
+ case vs == vs' of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (bimap <$> id <*> id) (show . take 10) (vs, vs')
+
+testEdgeUndir :: Test
+testEdgeUndir = do
+ let name = "grid undirected Edges to ids"
+ l = (10 :: L)
+ d = (2 :: D)
+ lattice = undirectedGraphCubicPBC (PBCSquareLattice l d)
+ es = edges lattice
+ eids = M.fromList $ zip es $ map (\e -> fromJust (edgeIndex lattice e)) es
+ expe = edgeMap lattice
+ case eids == expe of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show eids) (show es)
+
+testEdgeDir :: Test
+testEdgeDir = do
+ let name = "grid directed Edges to ids"
+ l = (40 :: L)
+ d = (3 :: D)
+ lattice = graphCubicPBC (PBCSquareLattice l d)
+ es = edges lattice
+ eids = M.fromList $ zip es $ map (\e -> fromJust (pbcEdgeIx l d e)) es
+ expe = edgeMap lattice
+ case eids == expe of
+ True -> testPassed name "passed!"
+ False -> testFailed name $ (,) (show eids) (show es)
diff --git a/test/Test/Graph/AdjacencyList/Metrics.hs b/test/Test/Graph/AdjacencyList/Metrics.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/Metrics.hs
@@ -0,0 +1,125 @@
+module Test.Graph.AdjacencyList.Metrics where
+
+import Data.Maybe
+import Data.List
+import Data.List.Unique
+import TestHS
+
+import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Grid
+
+import Data.Graph.AdjacencyList.WFI
+import Data.Graph.AdjacencyList.Metrics
+
+import qualified Data.Binary as Bin
+
+fastTests :: [Test]
+fastTests = [ testEccentricity
+ , testRadius
+ , testDiameter
+ , testDensity
+ ]
+
+ioTests :: [IO Test]
+ioTests = [ test481150
+ , test480967
+ ]
+
+-- | DAG
+graphTest =
+ let vs = [1..8]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [3,5]
+ nei 3 = [4,6]
+ nei 4 = [7]
+ nei 5 = [4,7]
+ nei 6 = [8,7]
+ nei 7 = []
+ nei 8 = [7]
+ in nei v
+ )
+ in createGraph vs neis
+
+graphTestDisco =
+ let vs = [1..10]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [3,5]
+ nei 3 = [4,6]
+ nei 4 = [7]
+ nei 5 = [4,7]
+ nei 6 = [8,7]
+ nei 7 = []
+ nei 8 = [7]
+ nei 9 = [10]
+ nei 10 = []
+ in nei v
+ )
+ in createGraph vs neis
+
+testEccentricity :: Test
+testEccentricity = do
+ let name = "Eccentricity of vertex 2 in test graph"
+ dists = unweightedShortestDistances graphTest
+ out = graphEccentricity 2 dists
+ expe = Just 3
+ in case out == expe of
+ True -> testPassed name $ "passed! " <> (show out)
+ False -> testFailed name $ (,) (show dists) (show out)
+
+testRadius :: Test
+testRadius = do
+ let name = "Radius of test graph should be 1 (8-7)"
+ dists = unweightedShortestDistances graphTest
+ out = graphRadius dists
+ expe = Just 1
+ in case out == expe of
+ True -> testPassed name $ "passed! "
+ False -> testFailed name $ (,) (show expe) (show out)
+
+testDiameter :: Test
+testDiameter = do
+ let name = "Diameter 3 (2-7)"
+ dists = unweightedShortestDistances graphTestDisco
+ out = graphDiameter dists
+ expe = Just 3
+ in case out == expe of
+ True -> testPassed name $ "passed! "
+ False -> testFailed name $ (,) (show expe) (show out)
+
+testDensity :: Test
+testDensity = do
+ let name = "Density of testgraph should be 13/56"
+ out = graphDensity graphTest
+ expe = 13 / 56
+ in case out == expe of
+ True -> testPassed name $ "passed! "
+ False -> testFailed name $ (,) (show expe) (show out)
+
+test481150 :: IO Test
+test481150 = do
+ let name = "compare with netmeta's distance matrix network 481150"
+ es <- Bin.decodeFile "test/481150.edges"
+ let gr = graphFromEdges es
+ dists = unweightedShortestDistances $ makeUndirected gr
+ rad = graphRadius dists
+ diam = graphDiameter dists
+ expe = (Just 2, Just 2)
+ in case (rad, diam) == expe of
+ True -> return $ testPassed name $ "passed! " <> (show dists)
+ False -> return $ testFailed name $ (,) (show expe) (show rad)
+
+test480967 :: IO Test
+test480967 = do
+ let name = "compare with netmeta's distance matrix network 480967"
+ es <- Bin.decodeFile "test/480967.edges"
+ let gr = graphFromEdges es
+ dists = unweightedShortestDistances $ makeUndirected gr
+ rad = graphRadius dists
+ diam = graphDiameter dists
+ expe = (Just 2, Just 3)
+ in case (rad, diam) == expe of
+ True -> return $ testPassed name $ "passed! "
+ False -> return $ testFailed name $ (,) (show expe) (show rad)
diff --git a/test/Test/Graph/AdjacencyList/PushRelabel/FGLComparison.hs b/test/Test/Graph/AdjacencyList/PushRelabel/FGLComparison.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/PushRelabel/FGLComparison.hs
@@ -0,0 +1,119 @@
+module Test.Graph.AdjacencyList.PushRelabel.FGLComparison where
+
+import Data.Maybe
+import Data.List
+import qualified Data.Map.Strict as M
+
+import qualified Data.Graph.Inductive as I
+import qualified Data.Graph.Inductive.Graph as G
+import qualified Data.Graph.Inductive.Query.MaxFlow as MF
+
+import Test.QuickCheck
+
+import TestHS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Network
+import Data.Graph.AdjacencyList.PushRelabel.Internal
+import Data.Graph.AdjacencyList.PushRelabel.Pure (pushRelabel)
+
+-- ================================================================
+-- Random network generator
+-- ================================================================
+
+data TestNetwork = TestNetwork
+ { tnNetwork :: Network
+ , tnNumVerts :: Int
+ , tnNumEdges :: Int
+ } deriving (Show)
+
+instance Arbitrary TestNetwork where
+ arbitrary = do
+ n <- choose (3, 20)
+ let s = 1
+ t = n
+ -- Guarantee a path from source to sink
+ let pathEdges = [(i, i+1) | i <- [1..n-1]]
+ numExtra <- choose (0, n * (n-1) `div` 2)
+ extraEdges <- genExtraEdges n numExtra pathEdges
+ let allEdgePairs = nub $ pathEdges ++ extraEdges
+ es = map (\(u,v) -> Edge u v) allEdgePairs
+ caps <- mapM (\_ -> choose (1, 100 :: Int)) allEdgePairs
+ let capMap = M.fromList $ zip es (map toRational caps)
+ g = graphFromEdges es
+ net = Network { graph = g
+ , source = s
+ , sink = t
+ , capacities = capMap
+ , flow = M.empty
+ }
+ return $ TestNetwork net n (length allEdgePairs)
+
+ shrink _ = []
+
+genExtraEdges :: Int -> Int -> [(Int,Int)] -> Gen [(Int,Int)]
+genExtraEdges _ 0 _ = return []
+genExtraEdges n numExtra existing = do
+ pairs <- vectorOf (numExtra * 2) $ do
+ u <- choose (1, n)
+ v <- choose (1, n)
+ return (u, v)
+ let valid = filter (\(u,v) -> u /= v) pairs
+ unique = nub valid
+ new = filter (`notElem` existing) unique
+ return $ take numExtra new
+
+-- ================================================================
+-- Convert to FGL
+-- ================================================================
+
+networkToFGL :: Network -> (I.Gr () Double, Int, Int)
+networkToFGL net =
+ let g = graph net
+ s = source net
+ t = sink net
+ vs = map (\v -> (v, ())) $ vertices g
+ es = map (\e -> (from e, to e,
+ fromRational $ fromJust $ M.lookup e (capacities net)))
+ $ edges g
+ in (G.mkGraph vs es, s, t)
+
+-- ================================================================
+-- Properties
+-- ================================================================
+
+-- | Tide max flow equals FGL max flow
+prop_maxFlowMatchesFGL :: TestNetwork -> Property
+prop_maxFlowMatchesFGL (TestNetwork net _ _) =
+ case pushRelabel net of
+ Left err -> counterexample ("pushRelabel failed: " ++ err) False
+ Right res ->
+ let tideFlow = netFlow res
+ (fglGraph, s, t) = networkToFGL net
+ fglFlow = toRational (MF.maxFlow fglGraph s t :: Double)
+ in counterexample
+ ("Tide: " ++ show (fromRational tideFlow :: Double)
+ ++ " FGL: " ++ show (fromRational fglFlow :: Double)
+ ++ " (" ++ show (length $ vertices $ graph net) ++ " vertices, "
+ ++ show (length $ edges $ graph net) ++ " edges)")
+ (tideFlow == fglFlow)
+
+-- ================================================================
+-- Test runner
+-- ================================================================
+
+qcCount :: Int
+qcCount = 10000
+
+ioTests :: [IO Test]
+ioTests =
+ [ qcTest "Tide max flow == FGL max flow" prop_maxFlowMatchesFGL
+ ]
+
+qcTest :: Testable prop => String -> prop -> IO Test
+qcTest name prop = do
+ result <- quickCheckWithResult stdArgs { maxSuccess = qcCount, chatty = False } prop
+ case result of
+ Success {} -> return $ testPassed name
+ ("passed (" ++ show qcCount ++ " random graphs)")
+ failure -> return $ testFailed name ("QuickCheck failure", show failure)
diff --git a/test/Test/Graph/AdjacencyList/PushRelabel/Pure.hs b/test/Test/Graph/AdjacencyList/PushRelabel/Pure.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/PushRelabel/Pure.hs
@@ -0,0 +1,65 @@
+module Test.Graph.AdjacencyList.PushRelabel.Pure where
+
+
+import Data.Maybe
+import Data.List
+import Data.List.Unique
+import qualified Data.Vector as V
+import qualified Data.Map.Strict as M
+import qualified Data.IntMap.Strict as IM
+
+import qualified Data.Graph.Inductive as I
+import qualified Data.Graph.Inductive.Graph as G
+import qualified Data.Graph.Inductive.Query.MaxFlow as MF
+import qualified Data.Graph.Inductive.Query.BFS as IBFS
+
+import TestHS
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Grid
+import Data.Graph.AdjacencyList.Network
+import Data.Graph.AdjacencyList.PushRelabel.Internal
+import Data.Graph.AdjacencyList.PushRelabel.Pure
+
+fastTests :: [Test]
+fastTests = [
+ test1
+ ]
+
+
+graphTest1 =
+ let vs = [1..7]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [5,3]
+ nei 3 = [4]
+ nei 4 = []
+ nei 5 = [4,7]
+ nei 6 = [7]
+ nei 7 = [4]
+ in nei v
+ )
+ in createGraph vs neis
+
+fg = Network { graph = graphTest1
+ , source = 1
+ , sink = 7
+ , capacities = M.fromList $ zip (edges (graph fg)) (map toRational $ repeat 1.2)
+ , flow = M.empty
+ }
+
+test1 :: Test
+test1 = do
+ let name = "pushRelabel with FGL's MaxFlow"
+ let eout = pushRelabel fg
+ let vs = map (\v -> (v,())) $ vertices (graph fg) :: [G.UNode]
+ let es = map (\(f,t) -> (f,t,1.2)) $ (map toTuple (edges (graph fg))) :: [G.LEdge Double]
+ let mfg = G.mkGraph vs es :: I.Gr () Double
+ let expe = MF.maxFlow mfg 1 7 :: Double
+ case eout of
+ Left err -> testFailed name ("push relabel error", err)
+ Right out -> do
+ let netout = netFlow out
+ let fglout = toRational expe
+ case netout == fglout of
+ True -> testPassed name $ "passed!" ++ (show expe)
+ False -> testFailed name $ (,) (show fglout) (show netout)
diff --git a/test/Test/Graph/AdjacencyList/WFI.hs b/test/Test/Graph/AdjacencyList/WFI.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Graph/AdjacencyList/WFI.hs
@@ -0,0 +1,84 @@
+module Test.Graph.AdjacencyList.WFI where
+
+import Data.Maybe
+import Data.List
+import Data.List.Unique
+import TestHS
+
+import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+
+import Data.Graph.AdjacencyList
+import Data.Graph.AdjacencyList.Grid
+
+import Data.Graph.AdjacencyList.WFI
+
+fastTests :: [Test]
+fastTests = [ testWFI1
+ , testWFI2
+ , testDisconnected
+ ]
+
+-- | DAG
+graphTestWFI =
+ let vs = [1..8]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [3,5]
+ nei 3 = [4,6]
+ nei 4 = [7]
+ nei 5 = [4,7]
+ nei 6 = [8,7]
+ nei 7 = []
+ nei 8 = [7]
+ in nei v
+ )
+ in createGraph vs neis
+
+graphTestDisco =
+ let vs = [1..10]
+ neis = (\v -> let nei 1 = [2,5,6]
+ nei 2 = [3,5]
+ nei 3 = [4,6]
+ nei 4 = [7]
+ nei 5 = [4,7]
+ nei 6 = [8,7]
+ nei 7 = []
+ nei 8 = [7]
+ nei 9 = [10]
+ nei 10 = []
+ in nei v
+ )
+ in createGraph vs neis
+
+testWFI1 :: Test
+testWFI1 = do
+ let name = "Test Shortest paths Floyd-Warshall algorithm on a directed graph"
+ (Distances dists) = unweightedShortestDistances graphTestWFI
+ out :: [(Vertex,Rational)]
+ out = IM.toList $ fromJust $ IM.lookup 1 $ dists
+ expe = [(1,0),(2,1),(3,2),(4,2),(5,1),(6,1),(7,2),(8,2)]
+ in case out == expe of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) (show expe) (show out)
+
+testWFI2 :: Test
+testWFI2 = do
+ let name = "Test Shortest paths Floyd-Warshall algorithm undirected graph"
+ (Distances dists) = unweightedShortestDistances $ makeUndirected graphTestWFI
+ out :: [(Vertex,Rational)]
+ out = IM.toList $ fromJust $ IM.lookup 1 $ dists
+ expe = [(1,0),(2,1),(3,2),(4,2),(5,1),(6,1),(7,2),(8,2)]
+ in case out == expe of
+ True -> testPassed name $ "passed!"
+ False -> testFailed name $ (,) (show expe) (show out)
+
+testDisconnected :: Test
+testDisconnected = do
+ let name = "Test Shortest paths Floyd-Warshall algorithm on disconnected graph"
+ (Distances dists) = unweightedShortestDistances graphTestDisco
+ out :: [(Vertex,Rational)]
+ out = IM.toList $ fromJust $ IM.lookup 1 $ dists
+ expe = [(1,0),(2,1),(3,2),(4,2),(5,1),(6,1),(7,2),(8,2)]
+ in case out == expe of
+ True -> testPassed name $ "passed!" <> (show dists)
+ False -> testFailed name $ (,) (show expe) (show out)