From 4e99858ad543e84e56f3626f4d4673a81404e5f7 Mon Sep 17 00:00:00 2001 From: kevin Date: Fri, 20 Nov 2020 14:21:55 +0100 Subject: [PATCH] =?UTF-8?q?correction=20graph=20doubles=20fl=C3=AAches?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/FFAlgorithm.ml | 45 +++++++++++++++++++++++++++++++++++++-------- src/FFAlgorithm.mli | 4 ++++ src/ftest.ml | 4 +++- 3 files changed, 44 insertions(+), 9 deletions(-) diff --git a/src/FFAlgorithm.ml b/src/FFAlgorithm.ml index feac1c4..79ffba9 100644 --- a/src/FFAlgorithm.ml +++ b/src/FFAlgorithm.ml @@ -5,6 +5,7 @@ open BLF let g_to_string gr = gmap gr string_of_int let g_to_int gr = gmap gr int_of_string + (* Create a list of pairs (origin,end) from a list of nodes *) let rec create_arcs_from_nodes = function | [] -> [] @@ -13,7 +14,7 @@ let rec create_arcs_from_nodes = function -(* Return the minimum value of a path's arcs*) +(* Return the minimum value of a path's edge*) let get_min_label_from_path (graph : int graph) (path : (id * id) list) = let min = Some 999 in let min = List.fold_left @@ -27,7 +28,7 @@ let get_min_label_from_path (graph : int graph) (path : (id * id) list) = |Some x -> x -(* Add a value to every arc of a path *) +(* Add a value to every egde of a path *) let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) = List.fold_left ( @@ -37,11 +38,39 @@ let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) graph path -(* Reverse a path and its arc +(* Reverse a path and its edges ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *) let rev_arcs (path : (id * id) list) = List.map (fun (id1, id2) -> (id2, id1)) path + +(* Removes the edges whose label = 0 *) +let remove_zeroes (graph : int graph) = + let initGraph = clone_nodes graph in + e_fold graph + ( + fun acu id1 id2 x -> + if x = 0 then acu else new_arc acu id1 id2 x + ) initGraph + +(* Remove bi-directional edges between 2 nodes*) +let only_one_edge (graph : int graph) = + let graphWithZeroes = e_fold graph + ( + fun acu id1 id2 x -> + let path = [(id1,id2);(id2,id1)] in + + let label_rev = (match find_arc graph id2 id1 with + |None -> 0 + |Some x -> x) in + let mini = min x label_rev in + let gr = add_value_to_arcs graph path (-mini) in + if x = 0 || mini = 0 then acu else gr + ) + graph in + let graphWithoutZeroes = remove_zeroes graphWithZeroes in + graphWithoutZeroes + (* Get the final graph after the FFalgorithm The label of every arc becomes "x/max_capacity" where x @@ -60,20 +89,20 @@ let get_final_graph (initGraph : int graph) (residualGraph : int graph) = e_fold initGraph ( fun acu id1 id2 x -> - let label_arc = find_arc initGraphString id1 id2 in - let label_arc = (match label_arc with + let label_arc = (match find_arc initGraphString id1 id2 with |None -> "-1" |Some x -> x) in let label_rev_arc = find_arc residualGraphString id2 id1 in match label_rev_arc with |None -> new_arc acu id1 id2 ("0/"^label_arc) |Some x -> new_arc acu id1 id2 (""^x^"/"^label_arc) - ) finalGraph -let ford_fulk_algorithm graph origin sink = +let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) = let flow = 0 in + + let graph = only_one_edge graph in let initGraph = graph in let rec boucle graph origin sink flow = @@ -103,6 +132,6 @@ let ford_fulk_algorithm graph origin sink = let flow = flow + min in boucle graph origin sink flow) in let (maxFlow, residualGraph) = boucle graph origin sink flow in - let finalGraph = get_final_graph initGraph residualGraph in + let finalGraph = get_final_graph initGraph residualGraph in (maxFlow, finalGraph) \ No newline at end of file diff --git a/src/FFAlgorithm.mli b/src/FFAlgorithm.mli index d428251..8a19f29 100644 --- a/src/FFAlgorithm.mli +++ b/src/FFAlgorithm.mli @@ -7,6 +7,10 @@ val g_to_int: string graph -> int graph val ford_fulk_algorithm : int graph -> id -> id -> (int * string graph) +(* val g_to_string: int graph -> string graph *) + +(* val only_one_edge: int graph -> int graph *) + (* for testing purpose *) (* val rev_arcs: (id * id) list -> (id * id) list diff --git a/src/ftest.ml b/src/ftest.ml index f72736a..33135d5 100644 --- a/src/ftest.ml +++ b/src/ftest.ml @@ -39,8 +39,10 @@ let () = let () = printf "max flow = %d\n" flow in let () = write_file outfile finalGraph in let () = export outfile finalGraph in + (* let () = export infile graph in *) + (*Uncomment the following line if you have graphviz installed *) - (* let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in *) + (*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in*) ()