Makefile

@@ -1,15 +1,6 @@
-BOLD=\e[1m
-BLUE=\e[34m
-GREEN=\e[32m
-NORMAL=\e[0m
-
-COMPILING="\n$(BOLD)$(BLUE)==== COMPILING ====$(NORMAL)\n"
-EXECUTING="\n$(BOLD)$(GREEN)==== EXECUTING ====$(NORMAL)\n"
-BUILDING_SVG="\n$(BOLD)$(GREEN)==== BUILDING SVG ====$(NORMAL)\n"
-RESULT="\n$(BOLD)$(GREEN)==== RESULT ====$(NORMAL)\n"
 
 build:
-	@echo $(COMPILING)
+	@echo "\n==== COMPILING ====\n"
 	ocamlbuild ftest.native
 
 format:
@@ -19,34 +10,11 @@ edit:
 	codium . -n
 
 demo: build
-	@echo $(EXECUTING)
+	@echo "\n==== EXECUTING ====\n"
 	./ftest.native graphs/graph1 1 2 outfile
-	@echo $(RESULT)
+	@echo "\n==== RESULT ==== (content of outfile) \n"
 	@cat outfile
 
-test: build
-	@echo $(EXECUTING)
-	./ftest.native graphs/graph1 1 2 outfile
-	@echo $(BUILDING_SVG)
-	@echo "outfile..."
-	@dot -Tsvg outfile > outfile.svg
-	@echo "graph_init..."
-	@dot -Tsvg graph_init > graph_init.svg
-	@echo "graph_apply..."
-	@dot -Tsvg graph_apply > graph_apply.svg
-	@echo "graph_res..."
-	@dot -Tsvg graph_res > graph_res.svg
-	@echo ""
-
-run: build
-	@echo $(EXECUTING)
-	./ftest.native graphs/test1 0 3 solution
-	@echo $(BUILDING_SVG)
-	@echo "solution..."
-	@dot -Tsvg solution > solution.svg
-	@echo ""
-
-
 clean:
 	-rm -rf _build/
 	-rm ftest.native

graphs/test1

@@ -1,10 +0,0 @@
-n 100 200
-n 241 300
-n 241 100
-n 382 200
-
-e 0 1 2
-e 0 2 4
-e 1 2 3
-e 2 3 5
-e 1 3 1

src/ffalgo.ml

@@ -7,11 +7,6 @@ module Int_set = Set.Make(struct
     let compare = compare
   end)
 
-module Int_map = Map.Make(struct
-    type t = int
-    let compare = compare
-  end)
-
 type 'a network = {
   graph: 'a graph;
   origin: id;
@@ -29,57 +24,34 @@ type path = (id * id) list
 (* int graph -> flow graph *)
 let initialize_graph gr = gmap gr (fun c -> { current = 0; capacity = c })
 
-(* int graph -> int -> int -> int -> int graph *)
-let add_res_arc gr origin destination value = match value with
-  | 0 -> gr
-  | _ -> add_arc gr origin destination value
-
-
 (* flow graph -> int graph *)
-let build_res_graph gr = let gr_res = clone_nodes gr in
+let build_res_network gr = let gr_res = clone_nodes gr in
-  e_fold gr (fun g origin destination fl ->
+  e_fold gr (fun g origin destination fl ->  
-      let forward = fl.capacity - fl.current in
+      let new_g = add_arc g origin destination (fl.capacity - fl.current) in
-      let backward = fl.current in
+      add_arc new_g destination origin fl.current ) gr_res
-      let new_g = add_res_arc g origin destination forward in
-      add_res_arc new_g destination origin backward )
-    gr_res
-
-(* Int_map -> id -> id -> path *)
-let predecessors_to_path predecessors origin destination =
-  let rec loop o d acu = if o = d then
-      acu
-    else
-      match Int_map.find_opt d predecessors with
-      | None -> []
-      | Some x -> let new_acu = (x, d) :: acu in
-        if x = o then new_acu else
-          loop o x new_acu
-  in
-  loop origin destination []
 
+(* 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 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 q v pred = match Queue.take_opt q with
+  let rec find_path_rec r_n q v acu = match Queue.take_opt q with
-    | None -> predecessors_to_path pred res_network.origin res_network.destination
+    | None -> acu
-    | Some x -> if x = res_network.destination then
+    | Some x -> let arcs = out_arcs r_n.graph x in
-        predecessors_to_path pred res_network.origin res_network.destination
+      let arcs_seq = List.to_seq ( 
-      else
+          List.map (fun (dest, _) -> dest) (
-        let arcs = out_arcs res_network.graph x in
+            List.filter (fun (dest, _) -> not (Int_set.mem dest v) ) arcs
-        let filtered_arcs = List.filter (fun (dest, _) -> not (Int_set.mem dest v) ) arcs in
+          ) 
-        let successors_seq = List.to_seq ( 
+        ) in
-            List.map (fun (dest, _) -> dest) filtered_arcs
+      let new_v = Int_set.add_seq arcs_seq v in
-          ) in
+      let () = Queue.add_seq q arcs_seq in
-        let predecessors_seq = List.to_seq ( 
+      find_path_rec r_n q new_v acu
-            List.map (fun (dest, _) -> (dest, x)) filtered_arcs
-          ) in 
-        let new_pred = Int_map.add_seq predecessors_seq pred in
-        let new_v = Int_set.add_seq successors_seq v in
-        let () = Queue.add_seq q successors_seq in
-        find_path_rec q new_v new_pred
   in 
-  find_path_rec queue visited Int_map.empty
+  find_path_rec res_network queue visited []
+
 
 
 (* int graph -> path -> int *)
@@ -99,20 +71,6 @@ let apply_path gr path aug = List.fold_left (fun new_gr (s, d) ->
     | Some x -> new_arc new_gr s d {current = x.current + aug; capacity = x.capacity})
     gr path
 
-(* flow network -> int *)
-let get_max_flow flow_network = let arcs = out_arcs flow_network.graph flow_network.origin in
-  List.fold_left (fun current (dest, flow) -> current + flow.current ) 0 arcs
 
-(* int network -> flow network *)
+let run_ff network = assert false
-let run_ff network = let flow_graph = initialize_graph network.graph in
-  let rec loop fl = 
-    let res_graph = build_res_graph fl in
-    let path = find_path {graph = res_graph; origin = network.origin; destination = network.destination } in
-    match path with
-    | [] -> {graph = fl; origin = network.origin; destination = network.destination }
-    | _ ->
-      let aug = find_min res_graph path in
-      let new_fl = apply_path fl path aug in
-      loop new_fl
-  in loop flow_graph
 

src/ffalgo.mli

@@ -1,31 +1,9 @@
 open Graph
 
-
 type 'a network = {
   graph: 'a graph;
-  origin: id;
+  origin: int;
-  destination: id;
+  destination: int;
 }
 
-type flow = {
+val run_ff: int network -> int
-  current: int;
-  capacity: int;
-}
-
-type path = (id * id) list
-
-(* // TODO REMOVE AFTER TESTS *)
-val initialize_graph: int graph -> flow graph
-
-val apply_path: flow graph -> path -> int -> flow graph
-
-val build_res_graph: flow graph -> int graph
-
-val find_min: int graph -> path -> int
-
-val find_path: int network -> path
-
-(* KEEP THIS *)
-val run_ff: int network -> flow network
-
-val get_max_flow: flow network -> int

src/ftest.ml

@@ -2,44 +2,6 @@ open Gfile
 open Tools
 open Ffalgo
 
-
-let flow_to_string gr = gmap gr (fun fl -> String.concat "/" [(string_of_int fl.current); (string_of_int fl.capacity)])
-
-let test_ffalgo_init gr =
-  let graph_init = initialize_graph gr in
-  let () = export "graph_init" (flow_to_string graph_init) in
-  graph_init
-
-let test_ffalgo_apply gr =
-  let graph_apply = apply_path gr [(0, 3); (3, 1); (1, 4); (4, 5)] 1 in
-  let () = export "graph_apply" (flow_to_string graph_apply) in
-  graph_apply
-
-let test_ffalgo_res gr =
-  let graph_res = build_res_graph gr in
-  let () = export "graph_res" (gmap graph_res string_of_int) in
-  graph_res
-
-let test_ffalgo_min gr =
-  let min = find_min gr [(0, 3); (3, 1); (1, 4); (4, 5)] in
-  Printf.printf "min: %d\n%!" min
-
-let test_ffalgo_path gr =   
-  let predecessors = find_path {
-      graph = gr;
-      origin = 0;
-      destination = 4;
-    } in
-  List.iter (fun (o, d) -> Printf.printf "%d -> %d\n%!" o d ) predecessors 
-
-let test_ffalgo gr = 
-  let graph_init = test_ffalgo_init gr in
-  let graph_apply = test_ffalgo_apply graph_init in
-  let graph_res = test_ffalgo_res graph_apply in
-  let () = test_ffalgo_min gr in
-  test_ffalgo_path graph_res
-
-
 let () =
 
   (* Check the number of command-line arguments *)
@@ -54,30 +16,19 @@ let () =
 
   let infile = Sys.argv.(1)
   and outfile = Sys.argv.(4)
-  and source = int_of_string Sys.argv.(2)
+
-  and sink = int_of_string Sys.argv.(3)
+  (* These command-line arguments are not used for the moment. *)
+  and _source = int_of_string Sys.argv.(2)
+  and _sink = int_of_string Sys.argv.(3)
   in
 
   (* Open file *)
   let graph = from_file infile in
-  (* Convert graph *)
-  let int_graph = (gmap graph int_of_string) in
-  (* Execute FF *)
-  let flow_network = run_ff {graph = int_graph; origin = source; destination = sink} in
-  (* Print max flow *)
-  let () = Printf.printf "Max flow: %d\n%!" (get_max_flow flow_network) in
-  (* Convert to string for export *)
-  let final_graph = flow_to_string flow_network.graph in
-
-  (* TESTS *)
-  (* let () = test_ffalgo (gmap graph int_of_string) in *)
   (* let graph2 = clone_nodes graph in *)
   (* let graph2 = gmap (gmap (gmap graph int_of_string) (fun x -> x + 1)) string_of_int in *)
   (* let graph2 = gmap (add_arc (gmap graph int_of_string) 2 1 13) string_of_int in *)
-  (* END TESTS *)
-
   (* Rewrite the graph that has been read. *)
-  let () = export outfile final_graph in
+  let () = export outfile graph in
 
   ()