Maximum Flow and Shortest Augmenting Path Algorithm solution in F#

Today I am going to post some code in F# that solves the maximum flow problem using the simple Shortest Augmenting Path Algorithm.


Maximum Flow Problem:

Given a graph (or network) as shown below, where each edge in the network has a maximum capacity, what is the maximum flow of resources that I can send from a starting node to a final (sink) node.
This problem is very common in modern life in industry and technology. For example, suppose you have a number of cities with roads in between them (this would form a network). I want to send a continuous flow of a certain good from one city s to another city t. Each road in the network only allows me to send a certain flow a goods depending on the road's capacity.


The Shortest Augmenting Path Algorithm solves this problem by finding the shortest path from the initial node s to the sink node t and then sending the maximum flow of goods possible through that path by saturating its capacity (namely it sends a flow of goods that is equals to the smallest capacity of all the edges in the path). After that path has been saturated, the algorithm accounts for the fact that many of the edges in that path will have less capacity after saturating the path. The algorithm proceeds to do this process until no more paths can be found to send goods from the initial node to the final node. This algorithm is not the fastest solution for this problem, but it is simple and it always finds the correct solution.


Well, I wrote some code in F# that applies the algorithm.
To find the shortest path in this algorithm I use a breadth-first-search:
-----------------------------------

let SetArrayValues (theArray : int []) (markList : int list) (aValue : int) =
let rec MarkHead markList =
match markList with
| head::tail -> Array.set theArray head aValue
MarkHead tail
| [] -> []
MarkHead markList
;;


let MarkVisited visited markList =
SetArrayValues visited markList 1
;;


let MarkParents parents children theParent =
SetArrayValues parents children theParent
;;


let FindInList list1 elem =
let rec SearchList list1 elem i =
match list1 with
| head::tail -> if elem = head
then i
else SearchList tail elem (i+1)
| [] -> -1
SearchList list1 elem 0
;;


let rec ListContains list elem =
match list with
| head::tail -> if head = elem
then head
else ListContains tail elem
| [] -> -1
;;


let clearInvalidEdges iNode adjList weightList list array =
List.filter (fun x ->  (not ((array : int array).[x] = 1) 
&& ((weightList : int [] list).[iNode] : int []).[FindInList (adjList : int list list).[iNode] x] > 0)
) list
;;


let GetPath parents curr =
let rec traverse parents curr path =
let father = (parents : int array).[curr]
let path = curr::path
if father = -1
then path
else traverse parents father path
traverse parents curr []
;;


let BFS_for_SAPA weightList adjList s t = 
let n = (adjList : int list list).Length
let visited = (Array.zeroCreate n : int array)
let parents = Array.create n -1
let q = []
let loc = s
Array.set visited loc 1
let q = loc::q
let nextQ = []
let rec traverse q nextQ =
match q with
| head::tail -> let neighbors = (adjList : int list list).[head]
let children = clearInvalidEdges head adjList weightList neighbors visited
MarkParents parents children head
let posFound = ListContains children t
if posFound > -1
then GetPath parents posFound
else
MarkVisited visited children
let nextQ = children @ nextQ
traverse tail nextQ
| [] -> match nextQ with
| head::tail -> traverse nextQ []
| [] -> []
traverse q nextQ
;;
----------------------------------------------
After running this code we are ready to apply the Shortest Augmenting Path Algorithm (SAPA) below:
----------------

let GetMinResidue path weightList adjList =
let rec NextEdge path =
match path with
| head::tail -> let head1 = head
let tail1 = tail
match tail with
| head::tail -> let head2 = head
let node2Index = FindInList (adjList : int list list).[head1] head2
if node2Index < 0
then -1
else let residue = (weightList : int [] list).[head1].[node2Index]
let recResidue = NextEdge tail1
if residue < recResidue || recResidue = -1
then residue
else recResidue
| [] -> -1
| [] -> -1
let r = NextEdge path
r
;;


let AugmentFlow r path weightList adjList =
let rec NextEdge path =
match path with
| head::tail -> let head1 = head
let tail1 = tail
match tail with
| head::tail -> let head2 = head
let node2Index = FindInList (adjList : int list list).[head1] head2
if node2Index < 0
then 0
else let oldResidue = (weightList : int [] list).[head1].[node2Index]
Array.set (weightList : int [] list).[head1] node2Index (oldResidue - r)
let ret = NextEdge tail1
ret
| [] -> 0
| [] -> 0
NextEdge path
;;


let SAPA_max_flow adjList weightList s t =
let adjList = (adjList : int list list)
let weightList = (weightList : int [] list)
let rec ShortestAugmentingPath voidArg =
let path = BFS_for_SAPA weightList adjList s t
match path with
| head::tail -> let r = GetMinResidue path weightList adjList
AugmentFlow r path weightList adjList
let nextAugPath = ShortestAugmentingPath voidArg
let flow = fst nextAugPath
let tupleList = snd nextAugPath
let tupleList = (r, path)::tupleList
let tuple = ( (r + flow), tupleList )
tuple
| [] -> (0, [])
let iMaxFlow = ShortestAugmentingPath 0
iMaxFlow
;;

---------------------------------------

And we are ready to run some cases with this.



'test SAPA (Shortest Augmenting Path Algorithm)
' adjList - stores the node connectivity information as an adjacency matrix
' weightList - keeps the edge capacities of the edges in the adjacency matrix


let adjList = [[1; 2; 3];
[0; 4];
[0; 4];
[0; 4];
[1; 2; 3; 5; 6; 7];
[4; 8];
[4; 8];
[4; 8];
[5; 6; 7]
];;


let weightList = [[|7; 5; 3|];
[|7; 2|];
[|5; 3|];
[|3; 3|];
[|2; 3; 3; 1; 4; 3|];
[|1; 2|];
[|4; 6|];
[|3; 3|];
[|2; 6; 3|]
];;
Then run the algorithm to find the maxFlow from node 0 to node 8:


SAPA_max_flow adjList weightList 0 8;;


The result:

val it : int * (int * int list) list =
  (8, [(1, [0; 1; 4; 5; 8]); (1, [0; 1; 4; 6; 8]); (3, [0; 2; 4; 6; 8]); (3, [0; 3; 4; 7; 8])])


Means that the Maximum Flow found is equals to 8.
Send a volume of 1 through path [0; 1; 4; 5; 8]
Send a volume of 1 through path [0; 1; 4; 6; 8]
Send a volume of 3 through path [0; 2; 4; 6; 8]
Send a volume of 3 through path [0; 3; 4; 7; 8]


Sorry I didn't illustrate the sample case better with pictures :)