From 541995f586a5f191e71678bb851b731fb0aba95e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onie=20Gallois?= Date: Wed, 25 Nov 2020 11:51:43 +0100 Subject: [PATCH] usecase --- src/FFAlgorithm.ml | 61 ++++++++++++++++++++++++++++++++------------- src/MSgfile.ml | 2 +- src/moneySharing.ml | 10 ++++++++ 3 files changed, 54 insertions(+), 19 deletions(-) diff --git a/src/FFAlgorithm.ml b/src/FFAlgorithm.ml index 77709ee..4c0bf2b 100644 --- a/src/FFAlgorithm.ml +++ b/src/FFAlgorithm.ml @@ -43,43 +43,68 @@ let add_value_to_arcs (graph : float graph) (path : (id * id) list) (value : flo 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 + +(*si graph init a arc bidirectionnel alors on fait la difference entre capa de l'arc dans un sens donné du graphe init avec label du meme arc du meme sens dans residual graph +si diff negative alors on garde larc inverse avec label le resultat de la diff en absolue sinon +si diff positive alors on garde arc dans meme sens avec label res de la diff*) (* 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) = (* First get the initial and residual graph as string graphs *) - let initGraphString = initGraph in - let residualGraphString = residualGraph in + let initGraphString = g_to_string initGraph in + let residualGraphString = g_to_string 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/max_capacity" otherwise*) + "0.0/max_capacity" otherwise*) e_fold initGraph ( fun acu id1 id2 x -> let label_arc = (match find_arc initGraphString id1 id2 with - |None -> 0.0 - |Some x -> x) in - let label_rev_arc = match find_arc residualGraphString id2 id1 with - |None -> 0.0 - |Some x -> (match find_arc initGraphString id2 id1 with - |None -> x - |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) + |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 : float graph) (origin : id) (sink : id) = let flow = 0.0 in + let graph = only_one_edge graph in let initGraph = graph in let rec boucle graph origin sink flow = @@ -98,16 +123,16 @@ let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) = (* Substract the min to every arc of the path *) let graph = add_value_to_arcs graph arcs (Float.neg min) in - (* Get the reverse path *) 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 min to the flow *) 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) + \ No newline at end of file diff --git a/src/MSgfile.ml b/src/MSgfile.ml index 751f4dc..c02ed14 100644 --- a/src/MSgfile.ml +++ b/src/MSgfile.ml @@ -91,7 +91,7 @@ let from_file path = with End_of_file -> (graph, l_id) (* Done *) in - let final_graph_lid= loop 0 empty_graph [] in + let final_graph_lid= loop 1 empty_graph [] in close_in infile ; final_graph_lid diff --git a/src/moneySharing.ml b/src/moneySharing.ml index 2714b21..3944a48 100644 --- a/src/moneySharing.ml +++ b/src/moneySharing.ml @@ -37,5 +37,15 @@ let paiement g utilisateur l_utilisateurs montant l_id= let l_id= set_val_pret utilisateur montant l_id in paye g utilisateur l_utilisateurs montant l_id +let set_sink_origin l_id graph= + let graph= new_node graph 0 in + let n=List.fold_left (fun acu triplet-> acu+1) 1 l_id in + let graph =new_node graph n in + let rec loop l_id graph n=match l_id with + |[]->graph + |(nom, id, 0.0)::b-> loop b graph n + |(nom,id,value)::b-> if value<0.0 then loop b (new_arc graph 0 id value) n else loop b (new_arc graph id n value) n in + loop l_id graph n +