implement ff algo function

find_path is still WIP

src/ffalgo.ml

@@ -2,6 +2,11 @@ open Graph
 open Printf
 open Tools
 
+module Int_set = Set.Make(struct
+    type t = int
+    let compare = compare
+  end)
+
 type 'a network = {
   graph: 'a graph;
   origin: id;
@@ -15,6 +20,7 @@ type flow = {
 
 type path = (id * id) list
 
+
 (* int graph -> flow graph *)
 let initialize_graph gr = gmap gr (fun c -> { current = 0; capacity = c })
 
@@ -24,14 +30,46 @@ let build_res_network gr = let gr_res = clone_nodes gr in
       let new_g = add_arc g origin destination (fl.capacity - fl.current) in
       add_arc new_g destination origin fl.current ) gr_res
 
+(* pseudo code implémenté  *)
+(* TODO : trouver le chemin final *)
+(* sauvegarder le prédécéseur quand on ajoute au queue ? *)
+(* et quand trouvé dest, reverse ? *)
 (* int network -> path *)
-let find_path network = assert false
+let find_path res_network = let queue = Queue.create () in
+  let () = Queue.add res_network.origin queue in
+  let visited = Int_set.add res_network.origin Int_set.empty in
+  let rec find_path_rec r_n q v acu = match Queue.take_opt q with
+    | None -> acu
+    | Some x -> let arcs = out_arcs r_n.graph x in
+      let arcs_seq = List.to_seq ( 
+          List.map (fun (dest, _) -> dest) (
+            List.filter (fun (dest, _) -> not (Int_set.mem dest v) ) arcs
+          ) 
+        ) in
+      let new_v = Int_set.add_seq arcs_seq v in
+      let () = Queue.add_seq q arcs_seq in
+      find_path_rec r_n q new_v acu
+  in 
+  find_path_rec res_network queue visited []
 
-(* path -> int *)
-let find_min path = assert false
 
-(* flow graph -> path -> aug -> flow graph *)
-let apply_path graph path aug = assert false
+
+(* int graph -> path -> int *)
+let find_min gr path = List.fold_left (fun current_min (s, d) -> 
+    let current = find_arc gr s d in
+    match current with
+    | None -> raise Not_found
+    | Some x -> min x current_min)
+    max_int path 
+
+(* flow graph -> path -> int -> flow graph *)
+let apply_path gr path aug = List.fold_left (fun new_gr (s, d) -> 
+    match find_arc new_gr s d with
+    | None -> (match find_arc new_gr d s with
+        | None -> raise Not_found
+        | Some x -> new_arc new_gr d s {current = x.current - aug; capacity = x.capacity})
+    | Some x -> new_arc new_gr s d {current = x.current + aug; capacity = x.capacity})
+    gr path
 
 
 let run_ff network = assert false