prise en compte arcs bi-directionnels
This commit is contained in:
parent
b359e086ed
commit
3c12f22c7d
1 changed files with 25 additions and 49 deletions
|
|
@ -2,8 +2,8 @@ open Graph
|
|||
open Tool
|
||||
open BLF
|
||||
|
||||
let g_to_string gr = gmap gr string_of_float
|
||||
let g_to_float gr = gmap gr float_of_string
|
||||
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 *)
|
||||
|
|
@ -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 : float graph) (path : (id * id) list) =
|
||||
let min = Some 999.0 in
|
||||
let get_min_label_from_path (graph : int graph) (path : (id * id) list) =
|
||||
let min = Some 999 in
|
||||
let min = List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
|
|
@ -24,12 +24,12 @@ let get_min_label_from_path (graph : float graph) (path : (id * id) list) =
|
|||
if label < acu then label else acu
|
||||
) min path in
|
||||
match min with
|
||||
|None -> 999.0
|
||||
|None -> 999
|
||||
|Some x -> x
|
||||
|
||||
|
||||
(* Add a value to every egde of a path *)
|
||||
let add_value_to_arcs (graph : float graph) (path : (id * id) list) (value : float) =
|
||||
let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) =
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
|
|
@ -44,65 +44,41 @@ 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 : float graph) =
|
||||
let initGraph = clone_nodes graph in
|
||||
e_fold graph
|
||||
(
|
||||
fun acu id1 id2 x ->
|
||||
if x = 0.0 then acu else new_arc acu id1 id2 x
|
||||
) initGraph
|
||||
|
||||
(* Remove bi-directional edges between 2 nodes*)
|
||||
let only_one_edge (graph : float 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.0
|
||||
|Some x -> x) in
|
||||
let mini = min x label_rev in
|
||||
let gr = add_value_to_arcs graph path (Float.neg mini) in
|
||||
if x = 0.0 || mini = 0.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
|
||||
is the value of the opposite arc on the residual graph*)
|
||||
let get_final_graph (initGraph : float graph) (residualGraph : float graph) =
|
||||
let get_final_graph (initGraph : int graph) (residualGraph : int graph) =
|
||||
|
||||
(* First get the initial and residual graph as string graphs *)
|
||||
let initGraphString = g_to_string initGraph in
|
||||
let residualGraphString = g_to_string residualGraph in
|
||||
let initGraphString = initGraph in
|
||||
let residualGraphString = residualGraph in
|
||||
let finalGraph = clone_nodes initGraph in
|
||||
|
||||
(* For every arc in the initial graph, we get its label (aka max_capacity)
|
||||
then, we get the label of the opposite arc in the residual graph.
|
||||
If it exists then the arc of the final graph gets the label "x/max_capacity",
|
||||
"0.0/max_capacity" otherwise*)
|
||||
"0/max_capacity" otherwise*)
|
||||
e_fold initGraph
|
||||
(
|
||||
fun acu id1 id2 x ->
|
||||
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)
|
||||
|None -> 0
|
||||
|Some x -> x) in
|
||||
let label_rev_arc = match find_arc residualGraphString id2 id1 with
|
||||
|None -> 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
|
||||
new_arc acu id1 id2 (label_rev_arc^"/"^label_arc)
|
||||
)
|
||||
finalGraph
|
||||
|
||||
let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) =
|
||||
let flow = 0.0 in
|
||||
|
||||
let graph = only_one_edge graph in
|
||||
let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) =
|
||||
let flow = 0 in
|
||||
|
||||
let initGraph = graph in
|
||||
let rec boucle graph origin sink flow =
|
||||
|
||||
|
|
@ -119,7 +95,7 @@ let ford_fulk_algorithm (graph : float 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 (Float.neg min) in
|
||||
let graph = add_value_to_arcs graph arcs (-min) in
|
||||
|
||||
|
||||
(* Get the reverse path *)
|
||||
|
|
@ -129,7 +105,7 @@ let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) =
|
|||
let graph = add_value_to_arcs graph reverse min in
|
||||
|
||||
(* Add the min to the flow *)
|
||||
let flow = Float.add flow min in
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue