From e3d6967d6b07ff7490983198b44cfe2eaeb484f5 Mon Sep 17 00:00:00 2001 From: gallois Date: Sun, 6 Dec 2020 17:19:02 +0100 Subject: [PATCH] busackerg --- src/BLF.ml | 4 ++-- src/FFAlgorithm.ml | 47 +++++++++++++++++++++++++++++++--------------- src/tool.ml | 6 +++--- src/tool.mli | 2 +- 4 files changed, 38 insertions(+), 21 deletions(-) diff --git a/src/BLF.ml b/src/BLF.ml index ea7c757..9839b9b 100644 --- a/src/BLF.ml +++ b/src/BLF.ml @@ -17,7 +17,7 @@ let blf gr id_src id_dest= 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*) 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_marque =[] in @@ -29,7 +29,7 @@ let blf gr id_src id_dest= match l_out_arc with |[]-> blf_rec gr file (a::file_marque) |(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 blf_tab.(id).cout<-(Int.add blf_tab.(a).cout lcout); blf_tab.(id).father<-a; diff --git a/src/FFAlgorithm.ml b/src/FFAlgorithm.ml index a1d43f4..148e290 100644 --- a/src/FFAlgorithm.ml +++ b/src/FFAlgorithm.ml @@ -15,26 +15,38 @@ let rec create_arcs_from_nodes = function (* 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 List.fold_left ( fun acu (id1, id2) -> let label = ( match find_arc graph id1 id2 with |None -> 999999999 - |Some (cout,capa) -> cout) in + |Some (cout,capa) -> capa) in if label < acu then label else acu ) min 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 ( fun acu (id1, id2) -> add_arc acu id1 id2 value ) 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 @@ -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 |None -> 0 |Some (cout_x,capa_x) -> (match find_arc initGraphString id2 id1 with - |None -> cout_x - |Some (cout_y, capa_y) -> Int.sub cout_x cout_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 - new_arc acu id1 id2 (label_rev_arc, capa_x) + |None -> capa_x + |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) else "capa:0" in + new_arc acu id1 id2 ((string_of_int cout_x), label_rev_arc) ) 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 flow = 0 in @@ -84,21 +99,23 @@ let ford_fulk_algorithm (graph : (int * int) graph) (origin : id) (sink : id) = (let path = x in let arcs = create_arcs_from_nodes path in - (* Find the min value of the path *) - let min = get_min_label_from_path graph arcs in + (* Find the min capacity of the path *) + let min = get_min_capa_from_path graph arcs in - (* Substract the min to every arc of the path *) - let graph = add_value_to_arcs graph arcs (Int.neg min) in + (* Substract the min capacity to every arc of the path *) + let graph = add_capa_to_arcs graph arcs (Int.neg min) in (* 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 *) - let graph = add_value_to_arcs graph reverse min in + (* Add the cost to every arc of the reverse path *) + (*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 *) let flow = Int.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) + let cout_total = get_cout_total residualGraph in + (maxFlow, cout_total,finalGraph) diff --git a/src/tool.ml b/src/tool.ml index f5c1ed6..2453968 100644 --- a/src/tool.ml +++ b/src/tool.ml @@ -12,11 +12,11 @@ let gmap gr f = let new_graph = clone_nodes gr in 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 match f with - |None->new_arc g id1 id2 (cout,1) - |Some x->new_arc g id1 id2 ((Int.add cout x),1) + |None->raise Not_Found + |Some (l_cout,l_capa)->new_arc g id1 id2 (l_cout,(Int.add capa l_capa)) let get_max_id graph = n_fold graph (fun acu id -> max id acu) 0 \ No newline at end of file diff --git a/src/tool.mli b/src/tool.mli index 9cd712c..da02bf4 100644 --- a/src/tool.mli +++ b/src/tool.mli @@ -6,6 +6,6 @@ val clone_nodes: 'a graph -> 'b graph (* Apply a function f to every label of the graph's arcs *) 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 \ No newline at end of file