63 lines
2.3 KiB
OCaml
63 lines
2.3 KiB
OCaml
open Graph
|
|
open Tools
|
|
open Display
|
|
open List
|
|
open Printf
|
|
|
|
|
|
|
|
(*returns a way (i.e. list of nodes that link s1 to s2, and the maximum capacity that could be added to it) *)
|
|
let rec way g n1 n2 =
|
|
|
|
let rec inner g (xs, capa) visited n1 n2 = match n1, n2 with
|
|
| a, b when a = n2 -> Some ((List.rev xs), capa) (*Destination reached --> return the value*)
|
|
| a, b ->
|
|
|
|
let findNext x (arcId, arcCapa) = match x with
|
|
| None -> inner g (arcId :: xs, (min capa arcCapa)) (arcId :: visited) arcId n2 (*If we are returned a none then this branch
|
|
is empty --> we need to search in the others*)
|
|
| Some a -> Some a
|
|
in
|
|
|
|
let out = List.filter (*all the possible outgoing edges from this node that haven't been visited*)
|
|
(fun x -> not (List.exists
|
|
(fun y -> (fst x) = y) visited))
|
|
(out_arcs g a) in
|
|
|
|
if List.length out > 0
|
|
then
|
|
fold_left findNext None out
|
|
else
|
|
None
|
|
|
|
in
|
|
if n1 == n2 (*Same node --> No path*)
|
|
then None
|
|
else inner g ([n1], (maxCapaGraph g)) [] n1 n2 (*We search through the graph using the graph's maximum capacity
|
|
as our starting point for the maximum capacity*)
|
|
|
|
(*updates the difference graph according to a path,
|
|
removes any 0-worth edge and tests for the graph sanity (only positive-valued edges)*)
|
|
let update g (nodes,capa) =
|
|
let rec updateCapacityAlongPath g (nodes,capa) =
|
|
match nodes with (* goes over all nodes*)
|
|
| [] -> g
|
|
| x :: [] -> g
|
|
| x::y::xs ->
|
|
let removedCapacityUsed = sub_arc g x y capa in (*decrements the value of the edge*)
|
|
let addPossibleUndo = add_arc removedCapacityUsed y x capa in (*adds the opposite edge for the difference graph*)
|
|
updateCapacityAlongPath addPossibleUndo (y::xs,capa)
|
|
in
|
|
testGraphSanity (
|
|
clearNull (
|
|
updateCapacityAlongPath g (nodes,capa)
|
|
)
|
|
)
|
|
|
|
(*takes a graph, a start/end node and returns a finished difference graph*)
|
|
let rec main g idS idE =
|
|
let path = way g idS idE in
|
|
match path with
|
|
| None -> g
|
|
| Some (xs, capa) -> main (update g (xs, capa)) idS idE
|
|
|