usecase en cours

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
+    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;
+    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)<blf_tab.(id).cout then
+                    if label != 0.0 && (Float.add blf_tab.(a).cout label)<(blf_tab.(id).cout) then
                     begin
-                        blf_tab.(id).cout<-(blf_tab.(a).cout+label);
+                        blf_tab.(id).cout<-(Float.add blf_tab.(a).cout label);
                         blf_tab.(id).father<-a; 
                         if not (List.mem id file_marque) then loop_suc d blf_tab (id::file) else loop_suc d blf_tab file
                     end

medium_project/src/BLF.mli

@@ -3,10 +3,10 @@ open Graph
 type path = id list
 
 type t_cost={
-    mutable cout:int;
+    mutable cout:float;
     mutable father:int 
     }
 
-val blf: int graph -> id -> id -> t_cost array
+val blf: float graph -> id -> id -> t_cost array
 
-val get_path: int graph -> id -> id -> path option
+val get_path: float graph -> id -> id -> path option

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_string gr = gmap gr string_of_float
-let g_to_int gr = gmap gr int_of_string
+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 get_min_label_from_path (graph : float graph) (path : (id * id) list) =
-  let min = Some 999 in
+  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
+    let gr = add_value_to_arcs graph path (Float.neg mini) in
-    if x = 0 || mini = 0 then acu else gr
+    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 ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) = 
-  let flow = 0 in
+  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 

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 *)
+val get_final_graph: float graph -> float graph -> string graph *)

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 *)

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 Flo Gaby,Flo,Macha 11.0
-   p Gaby [Flo] 8.5
+   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"
+  try Scanf.sscanf line "p %s %s %f"
-        (fun u l_u label -> ((paiement graph u l_u label), l_id))
+    (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"
@@ -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 )
+          | 'u' -> (n+1, (read_user n graph l_id line))
-          | 'p' -> (n, read_arc graph line l_id)
+          | 'p' -> (n, read_payement graph line l_id)
 
           (* It should be a comment, otherwise we complain. *)
           | _ -> (n, read_comment graph line l_id)

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
 

medium_project/src/gfile.mli

@@ -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
-*)

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) 
+    |a::b-> if not(a=utilisateur) 
-            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 
+            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
 
 

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
+val get_user: id -> (string * id) list -> string

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)

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
+val add_arc: float graph -> id -> id -> float -> float graph