usecase

src/FFAlgorithm.ml

@@ -44,42 +44,67 @@ 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 initGraphString = g_to_string initGraph in
-  let residualGraphString = residualGraph 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
+    |None -> "-1"
     |Some x -> x) in
-    let label_rev_arc = match find_arc residualGraphString id2 id1 with
+    let label_rev_arc = find_arc residualGraphString id2 id1 in
-      |None -> 0.0
+    match label_rev_arc with
-      |Some x -> (match find_arc initGraphString id2 id1 with
+    |None -> new_arc acu id1 id2 ("0/"^label_arc) 
-        |None -> x
+    |Some x -> new_arc acu id1 id2 (""^x^"/"^label_arc)  
-        |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)  
   )
   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,7 +123,6 @@ 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
     
@@ -111,3 +135,4 @@ let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) =
   let (maxFlow, residualGraph) = boucle graph origin sink flow in
   let finalGraph = get_final_graph initGraph residualGraph in 
   (maxFlow, finalGraph) 
+  

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

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
+