From 96f15c704535bf93d1ab7854d95773f4ad439a63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onie=20Gallois?= Date: Mon, 23 Nov 2020 12:38:57 +0100 Subject: [PATCH] usecase en cours --- medium_project/src/BLF.ml | 12 +++++----- medium_project/src/BLF.mli | 6 ++--- medium_project/src/FFAlgorithm.ml | 36 ++++++++++++++--------------- medium_project/src/FFAlgorithm.mli | 12 +++++----- medium_project/src/MSftest.ml | 4 ++-- medium_project/src/MSgfile.ml | 18 +++++++-------- medium_project/src/MSgfile.mli | 4 ++-- medium_project/src/gfile.mli | 19 --------------- medium_project/src/moneySharing.ml | 11 +++++---- medium_project/src/moneySharing.mli | 8 +++---- medium_project/src/tool.ml | 2 +- medium_project/src/tool.mli | 2 +- 12 files changed, 58 insertions(+), 76 deletions(-) delete mode 100644 medium_project/src/gfile.mli diff --git a/medium_project/src/BLF.ml b/medium_project/src/BLF.ml index 11316de..740ada8 100644 --- a/medium_project/src/BLF.ml +++ b/medium_project/src/BLF.ml @@ -4,7 +4,7 @@ type path = id list (*type record avec id noeud et son cout*) type t_cost={ - mutable cout:int; + mutable cout:float; mutable father:int } @@ -12,12 +12,12 @@ let blf gr id_src id_dest= (*je compte le nb de noeuds dans le graphe pour instancier mon tableau*) let nb_n=n_fold gr (fun acu id->acu+1) 0 in - let cost ={cout=max_int; father=(-1)} in + let cost ={cout=max_float; father=(-1)} 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*) - 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; + let blf_tab=n_fold gr (fun acu id->acu.(id)<-{cout=max_float; father=(-1)}; acu ) acu in + blf_tab.(id_src).cout<-0.0; let file_id=[id_src] in let file_marque =[] in @@ -29,9 +29,9 @@ let blf gr id_src id_dest= match l_out_arc with |[]-> blf_rec gr file (a::file_marque) |(id,label)::d-> - if label != 0 && (blf_tab.(a).cout+label) id -> id -> t_cost array +val blf: float graph -> id -> id -> t_cost array -val get_path: int graph -> id -> id -> path option \ No newline at end of file +val get_path: float graph -> id -> id -> path option \ No newline at end of file diff --git a/medium_project/src/FFAlgorithm.ml b/medium_project/src/FFAlgorithm.ml index 79ffba9..f450336 100644 --- a/medium_project/src/FFAlgorithm.ml +++ b/medium_project/src/FFAlgorithm.ml @@ -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) -> @@ -45,27 +45,27 @@ let rev_arcs (path : (id * id) list) = (* Removes the edges whose label = 0 *) -let remove_zeroes (graph : int graph) = +let remove_zeroes (graph : float graph) = let initGraph = clone_nodes graph in e_fold graph ( fun acu id1 id2 x -> - if x = 0 then acu else new_arc 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 : int graph) = +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 + |None -> 0.0 |Some x -> x) in let mini = min x label_rev in - let gr = add_value_to_arcs graph path (-mini) in - if x = 0 || mini = 0 then acu else gr + 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 @@ -75,7 +75,7 @@ let only_one_edge (graph : int graph) = (* 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 = g_to_string initGraph in @@ -85,7 +85,7 @@ let get_final_graph (initGraph : int graph) (residualGraph : int graph) = (* 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 -> @@ -99,8 +99,8 @@ let get_final_graph (initGraph : int graph) (residualGraph : int graph) = ) 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 graph = only_one_edge graph in let initGraph = graph in @@ -119,7 +119,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 *) @@ -129,7 +129,7 @@ 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 diff --git a/medium_project/src/FFAlgorithm.mli b/medium_project/src/FFAlgorithm.mli index 8a19f29..461f90c 100644 --- a/medium_project/src/FFAlgorithm.mli +++ b/medium_project/src/FFAlgorithm.mli @@ -3,18 +3,18 @@ open Tool open BLF -val g_to_int: string graph -> int graph +val g_to_float: string graph -> float graph -val ford_fulk_algorithm : int graph -> id -> id -> (int * string graph) +val ford_fulk_algorithm : float graph -> id -> id -> (float * string graph) -(* val g_to_string: int graph -> string graph *) +(* val g_to_string: float graph -> string graph *) -(* val only_one_edge: int graph -> int graph *) +(* val only_one_edge: float graph -> float graph *) (* for testing purpose *) (* val rev_arcs: (id * id) list -> (id * id) list -val add_value_to_arcs: int graph -> (id * id) list -> int -> int graph +val add_value_to_arcs: float graph -> (id * id) list -> float -> float graph -val get_final_graph: int graph -> int graph -> string graph *) \ No newline at end of file +val get_final_graph: float graph -> float graph -> string graph *) \ No newline at end of file diff --git a/medium_project/src/MSftest.ml b/medium_project/src/MSftest.ml index b648041..5df431c 100644 --- a/medium_project/src/MSftest.ml +++ b/medium_project/src/MSftest.ml @@ -31,12 +31,12 @@ let () = (* Open file *) let (graph, l_id) = from_file infile in - let initGraph = g_to_int graph in + let initGraph = g_to_float graph in (* Rewrite the graph that has been read. *) let (flow,finalGraph) = ford_fulk_algorithm initGraph _source _sink in - let () = printf "max flow = %d\n" flow in + let () = printf "max flow = %f\n" flow in let () = write_file outfile finalGraph l_id in let () = export outfile finalGraph in (* let () = export infile graph in *) diff --git a/medium_project/src/MSgfile.ml b/medium_project/src/MSgfile.ml index e80670a..3c73b0c 100644 --- a/medium_project/src/MSgfile.ml +++ b/medium_project/src/MSgfile.ml @@ -13,8 +13,8 @@ type path = string u Macha % You can now enter your payements as it follows: p userWhoPaid [forWhichUser1; forWhichUser2 ..] amount - p Flo [Gaby; Flo; Macha] 11.0 - p Gaby [Flo] 8.5 + p Flo Gaby,Flo,Macha 11.0 + p Gaby Flo 8.5 *) @@ -34,7 +34,7 @@ let write_file path graph l_id= fprintf ff "%% Here are the reimbursements to be made.\n\n" ; (* Write all arcs *) - e_iter graph (fun id1 id2 lbl -> fprintf ff "p %d %d %s\n" (get_user id1 l_id) (get_user id2 l_id) lbl) ; + e_iter graph (fun id1 id2 lbl -> fprintf ff "p %s %s %s\n" (get_user id1 l_id) (get_user id2 l_id) lbl) ; fprintf ff "\n%% End of reimbursements\n" ; @@ -50,7 +50,7 @@ let read_comment graph line l_id= failwith "from_file" (* Reads a line with a user. *) -let read_user id graph line l_id= +let read_user id graph l_id line = try Scanf.sscanf line "u %s" (fun user l_id-> ((init_node graph user id), l_id) ) with e -> Printf.printf "Cannot read node in line - %s:\n%s\n%!" (Printexc.to_string e) line ; @@ -58,8 +58,8 @@ let read_user id graph line l_id= (* Reads a line with a payement. *) let read_payement graph line l_id= - try Scanf.sscanf line "p %s %r %f" - (fun u l_u label -> ((paiement graph u l_u label), l_id)) + try Scanf.sscanf line "p %s %s %f" + (fun u l_u label -> ((paiement graph u (String.split_on_char ',' l_u) label), l_id)) with e -> Printf.printf "Cannot read arc in line - %s:\n%s\n%!" (Printexc.to_string e) line ; failwith "from_file" @@ -72,7 +72,7 @@ let from_file path = * n is the current node counter. *) let rec loop n graph l_id= try - let line = input_line infile in + let line = input_line infile in (* Remove leading and trailing spaces. *) let line = String.trim line in @@ -83,8 +83,8 @@ let from_file path = (* The first character of a line determines its content : n or e. *) else match line.[0] with - | 'u' -> (n+1, read_node n graph line l_id ) - | 'p' -> (n, read_arc graph line l_id) + | 'u' -> (n+1, (read_user n graph l_id line)) + | 'p' -> (n, read_payement graph line l_id) (* It should be a comment, otherwise we complain. *) | _ -> (n, read_comment graph line l_id) diff --git a/medium_project/src/MSgfile.mli b/medium_project/src/MSgfile.mli index aa15b64..c67744d 100644 --- a/medium_project/src/MSgfile.mli +++ b/medium_project/src/MSgfile.mli @@ -2,9 +2,9 @@ open Graph type path = string -val from_file: path -> (string graph, (string,id) list) +val from_file: path -> (string graph * (string * id) list) -val write_file: path -> string graph -> (string,id) list-> unit +val write_file: path -> string graph -> (string * id) list-> unit val export: path -> string graph -> unit diff --git a/medium_project/src/gfile.mli b/medium_project/src/gfile.mli deleted file mode 100644 index f94c5e4..0000000 --- a/medium_project/src/gfile.mli +++ /dev/null @@ -1,19 +0,0 @@ -(* Read a graph from a file, - * Write a graph to a file. *) - -open Graph - -type path = string - -(* Values are read as strings. *) -val from_file: path -> string graph - -(* Similarly, we write only a string graph. - * If necessary, use gmap (to be written by you) to prepare the input graph. *) -val write_file: path -> string graph -> unit - -val export: path -> string graph -> unit - -(* The format of files is compatible with the files generated by: - https://www-m9.ma.tum.de/graph-algorithms/flow-ford-fulkerson/index_en.html -*) diff --git a/medium_project/src/moneySharing.ml b/medium_project/src/moneySharing.ml index 263b2e3..7c7705b 100644 --- a/medium_project/src/moneySharing.ml +++ b/medium_project/src/moneySharing.ml @@ -1,4 +1,5 @@ open Graph +open Tool (*fonction qui créé le noeud associé à un utilisateur et rentre la correspondance dans la table des id*) @@ -7,20 +8,20 @@ let init_node g user id l_id= (*fonction qui renvoie l'id d'un utilisateur*) -let get_id utilisateur l_id= match l_id with +let rec get_id utilisateur l_id= match l_id with |[]-> raise Not_found - |(a,id1)::b-> if a=utlisateur then id1 else get_id utilisateur b + |(a,id1)::b-> if a=utilisateur then id1 else get_id utilisateur b (*fonction qui renvoie le nom correspondant à un id*) -let get_user id1 l_id= match l_id with +let rec get_user id1 l_id= match l_id with |[]-> raise Not_found |(nom,a)::b-> if a=id1 then nom else get_user id1 b (*fonction qui rentre les paiements réalisés*) let rec paiement g utilisateur l_utilisateurs montant l_id= match l_utilisateurs with |[]-> (g, l_id) - |a::b-> if not(a=utlisateur) - then paiement (add_arc g (get_id utilisateur l_id) (get_id a l_id) (montant/(List.length l_utilisateurs))) utilisateur b montant l_id + |a::b-> if not(a=utilisateur) + then paiement (add_arc g (get_id utilisateur l_id) (get_id a l_id) (Float.div montant (Float.of_int(List.length l_utilisateurs)))) utilisateur b montant l_id else paiement g utilisateur b montant l_id diff --git a/medium_project/src/moneySharing.mli b/medium_project/src/moneySharing.mli index 1a34691..7971efb 100644 --- a/medium_project/src/moneySharing.mli +++ b/medium_project/src/moneySharing.mli @@ -1,9 +1,9 @@ open Graph -val paiement: int graphe -> string -> string list -> float -> (string,id) list -> (int graphe, (string,id) list) +val paiement: float graph -> string -> string list -> float -> (string * id) list -> (float graph * (string * id) list) -val init_node: int graphe -> string ->id -> (string,id) list-> (int graphe, (string,id) list) +val init_node: float graph -> string ->id -> (string * id) list-> (float graph * (string * id) list) -val get_id: string -> (string, id) list -> id +val get_id: string -> (string * id) list -> id -val get_user: id -> (string, id) list -> string \ No newline at end of file +val get_user: id -> (string * id) list -> string \ No newline at end of file diff --git a/medium_project/src/tool.ml b/medium_project/src/tool.ml index aa680f9..71736c9 100644 --- a/medium_project/src/tool.ml +++ b/medium_project/src/tool.ml @@ -16,4 +16,4 @@ let add_arc g id1 id2 n = let f = find_arc g id1 id2 in match f with |None->new_arc g id1 id2 n - |Some x->new_arc g id1 id2 (n+x) + |Some x->new_arc g id1 id2 (Float.add n x) diff --git a/medium_project/src/tool.mli b/medium_project/src/tool.mli index 0ca3797..20676be 100644 --- a/medium_project/src/tool.mli +++ b/medium_project/src/tool.mli @@ -6,4 +6,4 @@ 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 graph -> id -> id -> int -> int graph \ No newline at end of file +val add_arc: float graph -> id -> id -> float -> float graph \ No newline at end of file