busackerg
This commit is contained in:
parent
131d5c6fe3
commit
e3d6967d6b
4 changed files with 38 additions and 21 deletions
|
@ -17,7 +17,7 @@ let blf gr id_src id_dest=
|
||||||
let acu =Array.make nb_n cost in
|
let acu =Array.make nb_n cost in
|
||||||
(*je fais un fold_left pour pouvoir individualiser au niveau de la mémoire les cases de la table*)
|
(*je fais un fold_left pour pouvoir individualiser au niveau de la mémoire les cases de la table*)
|
||||||
let blf_tab=n_fold gr (fun acu id->acu.(id)<-{cout=max_int; father=(-1)}; acu ) acu in
|
let blf_tab=n_fold gr (fun acu id->acu.(id)<-{cout=max_int; father=(-1)}; acu ) acu in
|
||||||
blf_tab.(id_src).cout<-0.0;
|
blf_tab.(id_src).cout<-0;
|
||||||
let file_id=[id_src] in
|
let file_id=[id_src] in
|
||||||
let file_marque =[] in
|
let file_marque =[] in
|
||||||
|
|
||||||
|
@ -29,7 +29,7 @@ let blf gr id_src id_dest=
|
||||||
match l_out_arc with
|
match l_out_arc with
|
||||||
|[]-> blf_rec gr file (a::file_marque)
|
|[]-> blf_rec gr file (a::file_marque)
|
||||||
|(id,(lcout,lcapa))::d->
|
|(id,(lcout,lcapa))::d->
|
||||||
if lcout <> 0.0 && (Int.add blf_tab.(a).cout lcout)<(blf_tab.(id).cout) then
|
if lcapa <> 0 && (Int.add blf_tab.(a).cout lcout)<(blf_tab.(id).cout) then
|
||||||
begin
|
begin
|
||||||
blf_tab.(id).cout<-(Int.add blf_tab.(a).cout lcout);
|
blf_tab.(id).cout<-(Int.add blf_tab.(a).cout lcout);
|
||||||
blf_tab.(id).father<-a;
|
blf_tab.(id).father<-a;
|
||||||
|
|
|
@ -15,26 +15,38 @@ let rec create_arcs_from_nodes = function
|
||||||
|
|
||||||
|
|
||||||
(* Return the minimum value of a path's edge*)
|
(* Return the minimum value of a path's edge*)
|
||||||
let get_min_label_from_path (graph : (int * int) graph) (path : (id * id) list) =
|
let get_min_capa_from_path (graph : (int * int) graph) (path : (id * id) list) =
|
||||||
let min = 999999999 in
|
let min = 999999999 in
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(
|
(
|
||||||
fun acu (id1, id2) ->
|
fun acu (id1, id2) ->
|
||||||
let label = ( match find_arc graph id1 id2 with
|
let label = ( match find_arc graph id1 id2 with
|
||||||
|None -> 999999999
|
|None -> 999999999
|
||||||
|Some (cout,capa) -> cout) in
|
|Some (cout,capa) -> capa) in
|
||||||
if label < acu then label else acu
|
if label < acu then label else acu
|
||||||
) min path
|
) min path
|
||||||
|
|
||||||
|
|
||||||
(* Add a value to every egde of a path *)
|
(* Add a value to every egde of a path *)
|
||||||
let add_value_to_arcs (graph : (int * int) graph) (path : (id * id) list) (value : int) =
|
let add_capa_to_arcs (graph : (int * int) graph) (path : (id * id) list) (value : int) =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(
|
(
|
||||||
fun acu (id1, id2) ->
|
fun acu (id1, id2) ->
|
||||||
add_arc acu id1 id2 value
|
add_arc acu id1 id2 value
|
||||||
)
|
)
|
||||||
graph path
|
graph path
|
||||||
|
|
||||||
|
(* Add a value to every egde of a path *)
|
||||||
|
let add_cost_to_arcs (graph : (int * int) graph) (path : (id * id) list) (min : int)=
|
||||||
|
List.fold_left
|
||||||
|
(
|
||||||
|
fun acu (id1, id2) ->
|
||||||
|
let (cout,capa)=match find_arc graph id1 id2 with
|
||||||
|
|None -> raise Not_Found
|
||||||
|
|Some (cout,capa)->(cout,capa) in
|
||||||
|
new_arc acu id2 id1 (Int.neg cout,Int.add min capa)
|
||||||
|
)
|
||||||
|
graph path
|
||||||
|
|
||||||
|
|
||||||
(* Reverse a path and its edges
|
(* Reverse a path and its edges
|
||||||
|
@ -63,14 +75,17 @@ let get_final_graph (initGraph : (int * int) graph) (residualGraph : (int * int)
|
||||||
let label_rev_arc = match find_arc residualGraphString id2 id1 with
|
let label_rev_arc = match find_arc residualGraphString id2 id1 with
|
||||||
|None -> 0
|
|None -> 0
|
||||||
|Some (cout_x,capa_x) -> (match find_arc initGraphString id2 id1 with
|
|Some (cout_x,capa_x) -> (match find_arc initGraphString id2 id1 with
|
||||||
|None -> cout_x
|
|None -> capa_x
|
||||||
|Some (cout_y, capa_y) -> Int.sub cout_x cout_y ) in
|
|Some (cout_y, capa_y) -> Int.sub capa_x capa_y ) in
|
||||||
let label_rev_arc = if (label_rev_arc > 0) then ((string_of_int label_rev_arc),(string_of_int capa_x )) else "cout:0,capa:"^(string_of_int capa_x) in
|
let label_rev_arc = if (label_rev_arc > 0) then (string_of_int label_rev_arc) else "capa:0" in
|
||||||
new_arc acu id1 id2 (label_rev_arc, capa_x)
|
new_arc acu id1 id2 ((string_of_int cout_x), label_rev_arc)
|
||||||
)
|
)
|
||||||
finalGraph
|
finalGraph
|
||||||
|
|
||||||
|
let get_cout_total (residualGraph : (int * int) graph) =
|
||||||
|
e_fold residualGraph (fun acu id1 id2 (l_cout, l_capa) -> if l_cout > 0 then (Int.add acu (Int.mul l_capa l_cout) else acu) 0
|
||||||
|
|
||||||
|
(*ne pas oublier d'afficher le cout*)
|
||||||
let ford_fulk_algorithm (graph : (int * int) graph) (origin : id) (sink : id) =
|
let ford_fulk_algorithm (graph : (int * int) graph) (origin : id) (sink : id) =
|
||||||
let flow = 0 in
|
let flow = 0 in
|
||||||
|
|
||||||
|
@ -84,21 +99,23 @@ let ford_fulk_algorithm (graph : (int * int) graph) (origin : id) (sink : id) =
|
||||||
(let path = x in
|
(let path = x in
|
||||||
let arcs = create_arcs_from_nodes path in
|
let arcs = create_arcs_from_nodes path in
|
||||||
|
|
||||||
(* Find the min value of the path *)
|
(* Find the min capacity of the path *)
|
||||||
let min = get_min_label_from_path graph arcs in
|
let min = get_min_capa_from_path graph arcs in
|
||||||
|
|
||||||
(* Substract the min to every arc of the path *)
|
(* Substract the min capacity to every arc of the path *)
|
||||||
let graph = add_value_to_arcs graph arcs (Int.neg min) in
|
let graph = add_capa_to_arcs graph arcs (Int.neg min) in
|
||||||
|
|
||||||
(* Get the reverse path *)
|
(* Get the reverse path *)
|
||||||
let reverse = rev_arcs arcs in
|
(*let reverse = rev_arcs arcs in*)
|
||||||
|
|
||||||
(* Add the min to every arc of the reverse path *)
|
(* Add the cost to every arc of the reverse path *)
|
||||||
let graph = add_value_to_arcs graph reverse min in
|
(*blf prend chemin seulement si capa non saturé, donc dans tous les cas on met un arc inverse avec -cout et un arc normal avec +cout*)
|
||||||
|
let graph = add_cost_to_arcs graph arcs min in
|
||||||
|
|
||||||
(* Add the min to the flow *)
|
(* Add the min to the flow *)
|
||||||
let flow = Int.add flow min in
|
let flow = Int.add flow min in
|
||||||
boucle graph origin sink flow) in
|
boucle graph origin sink flow) in
|
||||||
let (maxFlow, residualGraph) = 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)
|
let cout_total = get_cout_total residualGraph in
|
||||||
|
(maxFlow, cout_total,finalGraph)
|
||||||
|
|
|
@ -12,11 +12,11 @@ let gmap gr f =
|
||||||
let new_graph = clone_nodes gr in
|
let new_graph = clone_nodes gr in
|
||||||
e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph
|
e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph
|
||||||
|
|
||||||
let add_arc g id1 id2 cout =
|
let add_capa g id1 id2 capa =
|
||||||
let f = find_arc g id1 id2 in
|
let f = find_arc g id1 id2 in
|
||||||
match f with
|
match f with
|
||||||
|None->new_arc g id1 id2 (cout,1)
|
|None->raise Not_Found
|
||||||
|Some x->new_arc g id1 id2 ((Int.add cout x),1)
|
|Some (l_cout,l_capa)->new_arc g id1 id2 (l_cout,(Int.add capa l_capa))
|
||||||
|
|
||||||
let get_max_id graph =
|
let get_max_id graph =
|
||||||
n_fold graph (fun acu id -> max id acu) 0
|
n_fold graph (fun acu id -> max id acu) 0
|
|
@ -6,6 +6,6 @@ val clone_nodes: 'a graph -> 'b graph
|
||||||
(* Apply a function f to every label of the graph's arcs *)
|
(* Apply a function f to every label of the graph's arcs *)
|
||||||
val gmap: 'a graph -> ('a -> 'b) -> 'b graph
|
val gmap: 'a graph -> ('a -> 'b) -> 'b graph
|
||||||
|
|
||||||
val add_arc: (int * int) graph -> id -> id -> int -> (int * int) graph
|
val add_capa: (int * int) graph -> id -> id -> int -> (int * int) graph
|
||||||
|
|
||||||
val get_max_id : 'a graph -> id
|
val get_max_id : 'a graph -> id
|
Loading…
Reference in a new issue