kcavaill/ocaml_project
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

correction float FF

Browse source
This commit is contained in:
Kevin Cavailles 2020-11-25 10:40:46 +01:00
parent 3c12f22c7d
commit 04ae053231
1 changed files with 18 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/FFAlgorithm.ml
View file

@ -2,8 +2,8 @@ open Graph
open Tool
open BLF
let g_to_string gr = gmap gr string_of_int
let g_to_int gr = gmap gr int_of_string
let g_to_string gr = gmap gr string_of_float
let g_to_float gr = gmap gr float_of_string
(* Create a list of pairs (origin,end) from a list of nodes *)
@ -15,8 +15,8 @@ let rec create_arcs_from_nodes = function
(* 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 get_min_label_from_path (graph : float graph) (path : (id * id) list) =
let min = Some 999.0 in
let min = List.fold_left
(
fun acu (id1, id2) ->
@ -24,12 +24,12 @@ let get_min_label_from_path (graph : int graph) (path : (id * id) list) =
if label < acu then label else acu
) min path in
match min with
|None -> 999
|None -> 999.0
|Some x -> x
(* Add a value to every egde of a path *)
let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) =
let add_value_to_arcs (graph : float graph) (path : (id * id) list) (value : float) =
List.fold_left
(
fun acu (id1, id2) ->
@ -43,11 +43,11 @@ let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int)
let rev_arcs (path : (id * id) list) =
List.map (fun (id1, id2) -> (id2, id1)) path
(* Get the final graph after the FFalgorithm
The label of every arc becomes "x/max_capacity" where x
is the value of the opposite arc on the residual graph*)
let get_final_graph (initGraph : int graph) (residualGraph : int graph) =
let get_final_graph (initGraph : float graph) (residualGraph : float graph) =
(* First get the initial and residual graph as string graphs *)
let initGraphString = initGraph in
@ -62,22 +62,23 @@ let get_final_graph (initGraph : int graph) (residualGraph : int graph) =
(
fun acu id1 id2 x ->
let label_arc = (match find_arc initGraphString id1 id2 with
|None -> 0
|None -> 0.0
|Some x -> x) in
let label_rev_arc = match find_arc residualGraphString id2 id1 with
|None -> 0
|None -> 0.0
|Some x -> (match find_arc initGraphString id2 id1 with
|None -> x
|Some y -> x-y) in
let label_arc = string_of_int label_arc in
let label_rev_arc = if (label_rev_arc > 0) then (string_of_int label_rev_arc) else "0" in
|Some y -> Float.sub x y ) in
let label_arc = string_of_float label_arc in
let label_rev_arc = if (label_rev_arc > 0.0) then (string_of_float label_rev_arc) else "0" in
new_arc acu id1 id2 (label_rev_arc^"/"^label_arc)
)
finalGraph
let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) =
let flow = 0 in
let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) =
let flow = 0.0 in
let initGraph = graph in
let rec boucle graph origin sink flow =
@ -95,7 +96,7 @@ let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) =
let min = get_min_label_from_path graph arcs in
(* Substract the min to every arc of the path *)
let graph = add_value_to_arcs graph arcs (-min) in
let graph = add_value_to_arcs graph arcs (Float.neg min) in
(* Get the reverse path *)
@ -105,9 +106,8 @@ let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) =
let graph = add_value_to_arcs graph reverse min in
(* Add the min to the flow *)
let flow = flow + min in
let flow = Float.add 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
(maxFlow, finalGraph)