diff --git a/acceptable_project/Makefile b/acceptable_project/Makefile deleted file mode 100644 index 876857b..0000000 --- a/acceptable_project/Makefile +++ /dev/null @@ -1,20 +0,0 @@ - -build: - @echo "\n==== COMPILING ====\n" - ocamlbuild ftest.native - -format: - ocp-indent --inplace src/* - -edit: - code . -n - -demo: build - @echo "\n==== EXECUTING ====\n" - ./ftest.native graphs/graph1 1 2 outfile - @echo "\n==== RESULT ==== (content of outfile) \n" - @cat outfile - -clean: - -rm -rf _build/ - -rm ftest.native diff --git a/acceptable_project/README.md b/acceptable_project/README.md deleted file mode 100644 index 2ee1f32..0000000 --- a/acceptable_project/README.md +++ /dev/null @@ -1,21 +0,0 @@ -Base project for Ocaml project on Ford-Fulkerson. This project contains some simple configuration files to facilitate editing Ocaml in VSCode. - -To use, you should install the *OCaml* extension in VSCode. Other extensions might work as well but make sure there is only one installed. -Then open VSCode in the root directory of this repository (command line: `code path/to/ocaml-maxflow-project`). - -Features : - - full compilation as VSCode build task (Ctrl+Shift+b) - - highlights of compilation errors as you type - - code completion - - automatic indentation on file save - - -A makefile provides some useful commands: - - `make build` to compile. This creates an ftest.native executable - - `make demo` to run the `ftest` program with some arguments - - `make format` to indent the entire project - - `make edit` to open the project in VSCode - - `make clean` to remove build artifacts - -In case of trouble with the VSCode extension (e.g. the project does not build, there are strange mistakes), a common workaround is to (1) close vscode, (2) `make clean`, (3) `make build` and (4) reopen vscode (`make edit`). - diff --git a/acceptable_project/_tags b/acceptable_project/_tags deleted file mode 100644 index e8bfe6d..0000000 --- a/acceptable_project/_tags +++ /dev/null @@ -1,3 +0,0 @@ -: include - - diff --git a/acceptable_project/graphs/graph1 b/acceptable_project/graphs/graph1 deleted file mode 100644 index 54b8523..0000000 --- a/acceptable_project/graphs/graph1 +++ /dev/null @@ -1,24 +0,0 @@ -%% Test graph #1 - -%% Nodes - -n 88 209 % This is node #0, with its coordinates (which are not used by the algorithms). -n 408 183 -n 269 491 -n 261 297 -n 401 394 -n 535 294 % This is node #5. - - -%% Edges - -e 3 1 11 % An edge from 3 to 1, labeled "11". -e 3 2 2 -e 1 5 21 -e 4 5 14 -e 1 4 1 -e 0 1 7 -e 0 3 10 -e 3 4 5 -e 2 4 12 -e 0 2 8 diff --git a/acceptable_project/graphs/graph1.svg b/acceptable_project/graphs/graph1.svg deleted file mode 100644 index 0e114ab..0000000 --- a/acceptable_project/graphs/graph1.svg +++ /dev/null @@ -1,106 +0,0 @@ - - -]> - - - - -finite_state_machine - - -0 - -0 - - -2 - -2 - - -0->2 - - -8 - - -3 - -3 - - -0->3 - - -10 - - -1 - -1 - - -0->1 - - -7 - - -4 - -4 - - -2->4 - - -12 - - -3->2 - - -2 - - -3->1 - - -11 - - -3->4 - - -5 - - -1->4 - - -1 - - -5 - -5 - - -1->5 - - -21 - - -4->5 - - -14 - - - diff --git a/acceptable_project/graphs/graph2 b/acceptable_project/graphs/graph2 deleted file mode 100644 index c3f8fb0..0000000 --- a/acceptable_project/graphs/graph2 +++ /dev/null @@ -1,21 +0,0 @@ -% This is a graph. - -n 0.0 1.0 -n 1.0 1.0 -n 2.0 1.0 -n 3.0 1.0 -n 4.0 1.0 -n 5.0 1.0 - -e 0 1 16 -e 0 2 13 -e 1 2 10 -e 1 3 12 -e 2 1 4 -e 2 4 14 -e 3 2 9 -e 3 5 20 -e 4 3 7 -e 4 5 4 - -% End of graph diff --git a/acceptable_project/src/BLF.ml b/acceptable_project/src/BLF.ml deleted file mode 100644 index 11316de..0000000 --- a/acceptable_project/src/BLF.ml +++ /dev/null @@ -1,50 +0,0 @@ -open Graph - -type path = id list - -(*type record avec id noeud et son cout*) -type t_cost={ - mutable cout:int; - mutable father:int - } - -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 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 file_id=[id_src] in - let file_marque =[] in - - let rec blf_rec gr file_id file_marque= match file_id with - |[]-> blf_tab - |a::b-> - let l_out_arc=out_arcs gr a in - let rec loop_suc l_out_arc blf_tab file = - match l_out_arc with - |[]-> blf_rec gr file (a::file_marque) - |(id,label)::d-> - if label != 0 && (blf_tab.(a).cout+label)None - |a->if a == id_src then Some (id_src::path) else loop (a::path) blf_tab id_src a in - loop path blf_tab id_src id_dest diff --git a/acceptable_project/src/BLF.mli b/acceptable_project/src/BLF.mli deleted file mode 100644 index e8dc9e4..0000000 --- a/acceptable_project/src/BLF.mli +++ /dev/null @@ -1,12 +0,0 @@ -open Graph - -type path = id list - -type t_cost={ - mutable cout:int; - mutable father:int - } - -val blf: int graph -> id -> id -> t_cost array - -val get_path: int graph -> id -> id -> path option \ No newline at end of file diff --git a/acceptable_project/src/FFAlgorithm.ml b/acceptable_project/src/FFAlgorithm.ml deleted file mode 100644 index bd0223b..0000000 --- a/acceptable_project/src/FFAlgorithm.ml +++ /dev/null @@ -1,111 +0,0 @@ -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 - - -(* Create a list of pairs (origin,end) from a list of nodes *) -let rec create_arcs_from_nodes = function - | [] -> [] - | a :: [] -> [] - | a :: b :: rest -> (a,b) :: (create_arcs_from_nodes (b :: rest)) - - - -(* 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 min = List.fold_left - ( - fun acu (id1, id2) -> - let label = find_arc graph id1 id2 in - if label < acu then label else acu - ) min path in - match min with - |None -> 999 - |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) = - List.fold_left - ( - fun acu (id1, id2) -> - add_arc acu id1 id2 value - ) - graph path - - -(* Reverse a path and its edges - ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *) -let rev_arcs (path : (id * id) list) = - List.map (fun (id1, id2) -> (id2, id1)) path - -(* 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) = - - (* First get the initial and residual graph as string graphs *) - let initGraphString = initGraph in - let residualGraphString = 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*) - e_fold initGraph - ( - fun acu id1 id2 x -> - let label_arc = (match find_arc initGraphString id1 id2 with - |None -> 0 - |Some x -> x) in - let label_rev_arc = match find_arc residualGraphString id2 id1 with - |None -> 0 - |Some x -> (match find_arc initGraphString id2 id1 with - |None -> x - |Some y -> x-y) in - let label_arc = string_of_int label_arc in - let label_rev_arc = if (label_rev_arc > 0) then (string_of_int label_rev_arc) else "0" in - new_arc acu id1 id2 (label_rev_arc^"/"^label_arc) - ) - finalGraph - -let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) = - let flow = 0 in - - let initGraph = graph in - let rec boucle graph origin sink flow = - - let path = get_path graph origin sink in - match path with - |None -> (flow, graph) - |Some x -> - (let path = x in - let arcs = create_arcs_from_nodes path in - - (*let () = printf "dans boucle\n" in*) - - (* Find the min value of the path *) - 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 - - - (* Get the reverse path *) - let reverse = rev_arcs arcs in - - (* Add the min to every arc of the reverse path *) - let graph = add_value_to_arcs graph reverse min in - - (* Add the min to the flow *) - let flow = 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 - (maxFlow, finalGraph) - \ No newline at end of file diff --git a/acceptable_project/src/FFAlgorithm.mli b/acceptable_project/src/FFAlgorithm.mli deleted file mode 100644 index 8a19f29..0000000 --- a/acceptable_project/src/FFAlgorithm.mli +++ /dev/null @@ -1,20 +0,0 @@ -open Graph -open Tool -open BLF - - -val g_to_int: string graph -> int graph - -val ford_fulk_algorithm : int graph -> id -> id -> (int * string graph) - -(* val g_to_string: int graph -> string graph *) - -(* val only_one_edge: int graph -> int 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 get_final_graph: int graph -> int graph -> string graph *) \ No newline at end of file diff --git a/acceptable_project/src/ftest.ml b/acceptable_project/src/ftest.ml deleted file mode 100644 index 33135d5..0000000 --- a/acceptable_project/src/ftest.ml +++ /dev/null @@ -1,48 +0,0 @@ -open Gfile -open Tool -open FFAlgorithm -open BLF -open Format -open Sys - -let () = - - (*/!\ Format de la commande pour lancer le test : - ./ftest.native [nom_fichier_lecture] [id_source] [id_dest] [nom_fichier_ecriture] - ex : ./ftest.native graphs/graph1 0 5 graphs/graph3 *) - - (* Check the number of command-line arguments *) - if Array.length Sys.argv <> 5 then - begin - Printf.printf "\nUsage: %s infile source sink outfile\n\n%!" Sys.argv.(0) ; - exit 0 - end ; - - - (* Arguments are : infile(1) source-id(2) sink-id(3) outfile(4) *) - - let infile = Sys.argv.(1) - and outfile = Sys.argv.(4) - - (* 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 - let initGraph = g_to_int 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 () = write_file outfile finalGraph in - let () = export outfile finalGraph in - (* let () = export infile graph in *) - - - (*Uncomment the following line if you have graphviz installed *) - (*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in*) - () - diff --git a/acceptable_project/src/gfile.ml b/acceptable_project/src/gfile.ml deleted file mode 100644 index abdc387..0000000 --- a/acceptable_project/src/gfile.ml +++ /dev/null @@ -1,119 +0,0 @@ -open Graph -open Printf - -type path = string - -(* Format of text files: - % This is a comment - - % A node with its coordinates (which are not used). - n 88.8 209.7 - n 408.9 183.0 - - % The first node has id 0, the next is 1, and so on. - - % Edges: e source dest label - e 3 1 11 - e 0 2 8 - -*) - -let write_file path graph = - - (* Open a write-file. *) - let ff = open_out path in - - (* Write in this file. *) - fprintf ff "%% This is a graph.\n\n" ; - - (* Write all nodes (with fake coordinates) *) - n_iter_sorted graph (fun id -> fprintf ff "n %.1f 1.0\n" (float_of_int id)) ; - fprintf ff "\n" ; - - (* Write all arcs *) - e_iter graph (fun id1 id2 lbl -> fprintf ff "e %d %d %s\n" id1 id2 lbl) ; - - fprintf ff "\n%% End of graph\n" ; - - - - close_out ff ; - () - -(* Reads a line with a node. *) -let read_node id graph line = - try Scanf.sscanf line "n %f %f" (fun _ _ -> new_node graph id) - with e -> - Printf.printf "Cannot read node in line - %s:\n%s\n%!" (Printexc.to_string e) line ; - failwith "from_file" - -(* Ensure that the given node exists in the graph. If not, create it. - * (Necessary because the website we use to create online graphs does not generate correct files when some nodes have been deleted.) *) -let ensure graph id = if node_exists graph id then graph else new_node graph id - -(* Reads a line with an arc. *) -let read_arc graph line = - try Scanf.sscanf line "e %d %d %s" - (fun id1 id2 label -> new_arc (ensure (ensure graph id1) id2) id1 id2 label) - with e -> - Printf.printf "Cannot read arc in line - %s:\n%s\n%!" (Printexc.to_string e) line ; - failwith "from_file" - -(* Reads a comment or fail. *) -let read_comment graph line = - try Scanf.sscanf line " %%" graph - with _ -> - Printf.printf "Unknown line:\n%s\n%!" line ; - failwith "from_file" - -let from_file path = - - let infile = open_in path in - - (* Read all lines until end of file. - * n is the current node counter. *) - let rec loop n graph = - try - let line = input_line infile in - - (* Remove leading and trailing spaces. *) - let line = String.trim line in - - let (n2, graph2) = - (* Ignore empty lines *) - if line = "" then (n, graph) - - (* The first character of a line determines its content : n or e. *) - else match line.[0] with - | 'n' -> (n+1, read_node n graph line) - | 'e' -> (n, read_arc graph line) - - (* It should be a comment, otherwise we complain. *) - | _ -> (n, read_comment graph line) - in - loop n2 graph2 - - with End_of_file -> graph (* Done *) - in - - let final_graph = loop 0 empty_graph in - - close_in infile ; - final_graph - - -(* Write the graph in a .dot file*) -let export path graph = - (* Open a write-file. *) - let ff = open_out (path^".dot") in - - (* Write in this file. *) - fprintf ff "digraph graphique1 {\n\tsize=\"20\"\n\tnode [shape = circle];\n"; - - (* Write all arcs *) - e_iter graph (fun id1 id2 lbl -> fprintf ff "\t%d -> %d [ label = \"%s\" ];\n" id1 id2 lbl) ; - - fprintf ff "}\n" ; - - close_out ff ; - () diff --git a/acceptable_project/src/gfile.mli b/acceptable_project/src/gfile.mli deleted file mode 100644 index f94c5e4..0000000 --- a/acceptable_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/acceptable_project/src/graph.ml b/acceptable_project/src/graph.ml deleted file mode 100644 index 33f7a15..0000000 --- a/acceptable_project/src/graph.ml +++ /dev/null @@ -1,49 +0,0 @@ -type id = int - -type 'a out_arcs = (id * 'a) list - -(* A graph is just a list of pairs: a node & its outgoing arcs. *) -type 'a graph = (id * 'a out_arcs) list - -exception Graph_error of string - -let empty_graph = [] - -let node_exists gr id = List.mem_assoc id gr - -let out_arcs gr id = - try List.assoc id gr - with Not_found -> raise (Graph_error ("Node " ^ string_of_int id ^ " does not exist in this graph.")) - -let find_arc gr id1 id2 = - let out = out_arcs gr id1 in - try Some (List.assoc id2 out) - with Not_found -> None - -let new_node gr id = - if node_exists gr id then raise (Graph_error ("Node " ^ string_of_int id ^ " already exists in the graph.")) - else (id, []) :: gr - -let new_arc gr id1 id2 lbl = - - (* Existing out-arcs *) - let outa = out_arcs gr id1 in - - (* Update out-arcs. - * remove_assoc does not fail if id2 is not bound. *) - let outb = (id2, lbl) :: List.remove_assoc id2 outa in - - (* Replace out-arcs in the graph. *) - let gr2 = List.remove_assoc id1 gr in - (id1, outb) :: gr2 - -let n_iter gr f = List.iter (fun (id, _) -> f id) gr - -let n_iter_sorted gr f = n_iter (List.sort compare gr) f - -let n_fold gr f acu = List.fold_left (fun acu (id, _) -> f acu id) acu gr - -let e_iter gr f = List.iter (fun (id1, out) -> List.iter (fun (id2, x) -> f id1 id2 x) out) gr - -let e_fold gr f acu = List.fold_left (fun acu (id1, out) -> List.fold_left (fun acu (id2, x) -> f acu id1 id2 x) acu out) acu gr - diff --git a/acceptable_project/src/graph.mli b/acceptable_project/src/graph.mli deleted file mode 100644 index 416e158..0000000 --- a/acceptable_project/src/graph.mli +++ /dev/null @@ -1,63 +0,0 @@ - -(* Type of a directed graph in which arcs have labels of type 'a. *) -type 'a graph - -(* Each node has a unique identifier (a number). *) -type id = int - -exception Graph_error of string - - -(************** CONSTRUCTORS **************) - -(* The empty graph. *) -val empty_graph: 'a graph - -(* Add a new node with the given identifier. - * @raise Graph_error if the id already exists. *) -val new_node: 'a graph -> id -> 'a graph - -(* new_arc gr id1 id2 lbl : adds an arc from node id1 to node id2 with label lbl - * Both nodes must already exist in the graph. - * If the arc already exists, its label is replaced by lbl. - * @raise Graph_error if node id1 or id2 does not exist in the graph. *) -val new_arc: 'a graph -> id -> id -> 'a -> 'a graph - - -(************** GETTERS *****************) - -(* node_exists gr id indicates if the node with identifier id exists in graph gr. *) -val node_exists: 'a graph -> id -> bool - -(* Type of lists of outgoing arcs of a node. - * An arc is represented by a pair of the destination identifier and the arc label. *) -type 'a out_arcs = (id * 'a) list - -(* Find the out_arcs of a node. - * @raise Graph_error if the id is unknown in the graph. *) -val out_arcs: 'a graph -> id -> 'a out_arcs - -(* find_arc gr id1 id2 finds an arc between id1 and id2 and returns its label. Returns None if the arc does not exist. - * @raise Graph_error if id1 is unknown. *) -val find_arc: 'a graph -> id -> id -> 'a option - - -(************** COMBINATORS, ITERATORS **************) - -(* Iterate on all nodes, in no special order. *) -val n_iter: 'a graph -> (id -> unit) -> unit - -(* Like n_iter, but the nodes are sorted. *) -val n_iter_sorted: 'a graph -> (id -> unit) -> unit - -(* Fold on all (unsorted) nodes. You must remember what List.fold_left does. *) -val n_fold: 'a graph -> ('b -> id -> 'b) -> 'b -> 'b - - -(* Iter on all arcs (edges) *) -val e_iter: 'a graph -> (id -> id -> 'a -> unit) -> unit - -(* Fold on all arcs (edges) *) -val e_fold: 'a graph -> ('b -> id -> id -> 'a -> 'b) -> 'b -> 'b - - diff --git a/acceptable_project/src/tool.ml b/acceptable_project/src/tool.ml deleted file mode 100644 index aa680f9..0000000 --- a/acceptable_project/src/tool.ml +++ /dev/null @@ -1,19 +0,0 @@ -(* Yes, we have to repeat open Graph. *) -open Graph - -(* assert false is of type ∀α.α, so the type-checker is happy. *) - - -let clone_nodes gr = n_fold gr new_node empty_graph - - -(* Clone the nodes first then clone every arc but change their label by applying f*) -let gmap gr f = - let new_graph = clone_nodes gr in - e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph - -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) diff --git a/acceptable_project/src/tool.mli b/acceptable_project/src/tool.mli deleted file mode 100644 index 0ca3797..0000000 --- a/acceptable_project/src/tool.mli +++ /dev/null @@ -1,9 +0,0 @@ -open Graph - -(* Clone a graph by keeping only its nodes *) -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 diff --git a/medium_project/Makefile b/medium_project/Makefile deleted file mode 100644 index 466c808..0000000 --- a/medium_project/Makefile +++ /dev/null @@ -1,21 +0,0 @@ - -build: - @echo "\n==== COMPILING ====\n" - #ocamlbuild ftest.native# - ocamlbuild MSftest.native - -format: - ocp-indent --inplace src/* - -edit: - code . -n - -demo: build - @echo "\n==== EXECUTING ====\n" - ./ftest.native graphs/graph1 1 2 outfile - @echo "\n==== RESULT ==== (content of outfile) \n" - @cat outfile - -clean: - -rm -rf _build/ - -rm MSftest.native diff --git a/medium_project/README.md b/medium_project/README.md deleted file mode 100644 index 2ee1f32..0000000 --- a/medium_project/README.md +++ /dev/null @@ -1,21 +0,0 @@ -Base project for Ocaml project on Ford-Fulkerson. This project contains some simple configuration files to facilitate editing Ocaml in VSCode. - -To use, you should install the *OCaml* extension in VSCode. Other extensions might work as well but make sure there is only one installed. -Then open VSCode in the root directory of this repository (command line: `code path/to/ocaml-maxflow-project`). - -Features : - - full compilation as VSCode build task (Ctrl+Shift+b) - - highlights of compilation errors as you type - - code completion - - automatic indentation on file save - - -A makefile provides some useful commands: - - `make build` to compile. This creates an ftest.native executable - - `make demo` to run the `ftest` program with some arguments - - `make format` to indent the entire project - - `make edit` to open the project in VSCode - - `make clean` to remove build artifacts - -In case of trouble with the VSCode extension (e.g. the project does not build, there are strange mistakes), a common workaround is to (1) close vscode, (2) `make clean`, (3) `make build` and (4) reopen vscode (`make edit`). - diff --git a/medium_project/_tags b/medium_project/_tags deleted file mode 100644 index e8bfe6d..0000000 --- a/medium_project/_tags +++ /dev/null @@ -1,3 +0,0 @@ -: include - - diff --git a/medium_project/graphs/graph1 b/medium_project/graphs/graph1 deleted file mode 100644 index 54b8523..0000000 --- a/medium_project/graphs/graph1 +++ /dev/null @@ -1,24 +0,0 @@ -%% Test graph #1 - -%% Nodes - -n 88 209 % This is node #0, with its coordinates (which are not used by the algorithms). -n 408 183 -n 269 491 -n 261 297 -n 401 394 -n 535 294 % This is node #5. - - -%% Edges - -e 3 1 11 % An edge from 3 to 1, labeled "11". -e 3 2 2 -e 1 5 21 -e 4 5 14 -e 1 4 1 -e 0 1 7 -e 0 3 10 -e 3 4 5 -e 2 4 12 -e 0 2 8 diff --git a/medium_project/graphs/graph1.svg b/medium_project/graphs/graph1.svg deleted file mode 100644 index 0e114ab..0000000 --- a/medium_project/graphs/graph1.svg +++ /dev/null @@ -1,106 +0,0 @@ - - -]> - - - - -finite_state_machine - - -0 - -0 - - -2 - -2 - - -0->2 - - -8 - - -3 - -3 - - -0->3 - - -10 - - -1 - -1 - - -0->1 - - -7 - - -4 - -4 - - -2->4 - - -12 - - -3->2 - - -2 - - -3->1 - - -11 - - -3->4 - - -5 - - -1->4 - - -1 - - -5 - -5 - - -1->5 - - -21 - - -4->5 - - -14 - - - diff --git a/medium_project/src/BLF.ml b/medium_project/src/BLF.ml deleted file mode 100644 index 740ada8..0000000 --- a/medium_project/src/BLF.ml +++ /dev/null @@ -1,50 +0,0 @@ -open Graph - -type path = id list - -(*type record avec id noeud et son cout*) -type t_cost={ - mutable cout:float; - mutable father:int - } - -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_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_float; father=(-1)}; acu ) acu in - blf_tab.(id_src).cout<-0.0; - let file_id=[id_src] in - let file_marque =[] in - - let rec blf_rec gr file_id file_marque= match file_id with - |[]-> blf_tab - |a::b-> - let l_out_arc=out_arcs gr a in - let rec loop_suc l_out_arc blf_tab file = - match l_out_arc with - |[]-> blf_rec gr file (a::file_marque) - |(id,label)::d-> - if label != 0.0 && (Float.add blf_tab.(a).cout label)<(blf_tab.(id).cout) then - begin - 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 - else loop_suc d blf_tab file in - loop_suc l_out_arc blf_tab b in - blf_rec gr file_id file_marque - -(*avec blf_tab, on retrace chemin avec les pères*) -let get_path gr id_src id_dest= - let blf_tab=blf gr id_src id_dest in - let path=[id_dest] in - let rec loop path blf_tab id_src id_dest= - let father_id=blf_tab.(id_dest).father in match father_id with - |(-1)->None - |a->if a == id_src then Some (id_src::path) else loop (a::path) blf_tab id_src a in - loop path blf_tab id_src id_dest diff --git a/medium_project/src/BLF.mli b/medium_project/src/BLF.mli deleted file mode 100644 index c59fd93..0000000 --- a/medium_project/src/BLF.mli +++ /dev/null @@ -1,12 +0,0 @@ -open Graph - -type path = id list - -type t_cost={ - mutable cout:float; - mutable father:int - } - -val blf: float graph -> id -> id -> t_cost array - -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 deleted file mode 100644 index f450336..0000000 --- a/medium_project/src/FFAlgorithm.ml +++ /dev/null @@ -1,137 +0,0 @@ -open Graph -open Tool -open BLF - -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 *) -let rec create_arcs_from_nodes = function - | [] -> [] - | a :: [] -> [] - | a :: b :: rest -> (a,b) :: (create_arcs_from_nodes (b :: rest)) - - - -(* Return the minimum value of a path's edge*) -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) -> - let label = find_arc graph id1 id2 in - if label < acu then label else acu - ) min path in - match min with - |None -> 999.0 - |Some x -> x - - -(* Add a value to every egde of a path *) -let add_value_to_arcs (graph : float graph) (path : (id * id) list) (value : float) = - List.fold_left - ( - fun acu (id1, id2) -> - add_arc acu id1 id2 value - ) - graph path - - -(* Reverse a path and its edges - ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *) -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 - - -(* 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 = g_to_string initGraph 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.0/max_capacity" otherwise*) - e_fold initGraph - ( - fun acu id1 id2 x -> - let label_arc = (match find_arc initGraphString id1 id2 with - |None -> "-1" - |Some x -> x) in - let label_rev_arc = find_arc residualGraphString id2 id1 in - match label_rev_arc with - |None -> new_arc acu id1 id2 ("0/"^label_arc) - |Some x -> new_arc acu id1 id2 (""^x^"/"^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 = - - let path = get_path graph origin sink in - match path with - |None -> (flow, graph) - |Some x -> - (let path = x in - let arcs = create_arcs_from_nodes path in - - (*let () = printf "dans boucle\n" in*) - - (* Find the min value of the path *) - 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 (Float.neg min) in - - - (* Get the reverse path *) - let reverse = rev_arcs arcs in - - (* Add the min to every arc of the reverse path *) - let graph = add_value_to_arcs graph reverse min in - - (* Add the min to the flow *) - 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 - (maxFlow, finalGraph) - \ No newline at end of file diff --git a/medium_project/src/FFAlgorithm.mli b/medium_project/src/FFAlgorithm.mli deleted file mode 100644 index 461f90c..0000000 --- a/medium_project/src/FFAlgorithm.mli +++ /dev/null @@ -1,20 +0,0 @@ -open Graph -open Tool -open BLF - - -val g_to_float: string graph -> float graph - -val ford_fulk_algorithm : float graph -> id -> id -> (float * string graph) - -(* val g_to_string: float graph -> string 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: float graph -> (id * id) list -> float -> float graph - -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 deleted file mode 100644 index fbba757..0000000 --- a/medium_project/src/MSftest.ml +++ /dev/null @@ -1,48 +0,0 @@ -open MSgfile -open Tool -open FFAlgorithm -open BLF -open Format -open Sys - -let () = - - (*/!\ Format de la commande pour lancer le test : - ./ftest.native [nom_fichier_lecture] [id_source] [id_dest] [nom_fichier_ecriture] - ex : ./ftest.native graphs/graph1 0 5 graphs/graph3 *) - - (* Check the number of command-line arguments *) - if Array.length Sys.argv <> 5 then - begin - Printf.printf "\nUsage: %s infile source sink outfile\n\n%!" Sys.argv.(0) ; - exit 0 - end ; - - - (* Arguments are : infile(1) source-id(2) sink-id(3) outfile(4) *) - - let infile = Sys.argv.(1) - and outfile = Sys.argv.(4) - - (* 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, l_id) = from_file infile in - let initGraph = graph in - - (* Rewrite the graph that has been read. *) - - let (flow,finalGraph) = ford_fulk_algorithm initGraph _source _sink 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 *) - - - (*Uncomment the following line if you have graphviz installed *) - (*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in*) - () - diff --git a/medium_project/src/MSgfile.ml b/medium_project/src/MSgfile.ml deleted file mode 100644 index 751f4dc..0000000 --- a/medium_project/src/MSgfile.ml +++ /dev/null @@ -1,113 +0,0 @@ -open Graph -open Printf -open MoneySharing - -type path = string - -(* Format of text files: - % Welcome to MoneySharing, your favorite tool to ease your reimbursements ! - - % Please, type the name of all users of your group: - u Gaby - u Flo - 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 - -*) - - -let write_file path graph l_id= - - (* Open a write-file. *) - let ff = open_out path in - - (* Write in this file. *) - fprintf ff "%% Here is your MoneySharing graph.\n\n" ; - - (* Write all users *) - n_iter_sorted graph (fun id -> fprintf ff "u %s\n" (get_user id l_id)) ; - fprintf ff "\n" ; - - fprintf ff "%% Here are the reimbursements to be made.\n\n" ; - - (* Write all arcs *) - 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" ; - - close_out ff ; - () - -let read_comment graph line l_id= - try Scanf.sscanf line " %%" (graph, l_id) - with _ -> - Printf.printf "Unknown line:\n%s\n%!" line ; - failwith "from_file" - -(* Reads a line with a user. *) -let read_user id graph l_id line = - try Scanf.sscanf line "u %s" (fun user -> 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 ; - failwith "from_file" - -(* Reads a line with a payement. *) -let read_payement graph l_id line = - try Scanf.sscanf line "p %s %s %f" - (fun user l_user label -> paiement graph user (String.split_on_char ',' l_user) label l_id) - with e -> - Printf.printf "Cannot read arc in line - %s:\n%s\n%!" (Printexc.to_string e) line ; - failwith "from_file" - -let from_file path = - - let infile = open_in path in - - (* Read all lines until end of file. - * n is the current node counter. *) - let rec loop n graph l_id= - try - let line = input_line infile in - - (* Remove leading and trailing spaces. *) - let line = String.trim line in - - let (n2, (graph2, l2)) = - (* Ignore empty lines *) - if line = "" then (n, (graph, l_id)) - - (* The first character of a line determines its content : u or p. *) - else match line.[0] with - | 'u' -> (n+1, read_user n graph l_id line) - | 'p' -> (n, read_payement graph l_id line) - - (* It should be a comment, otherwise we complain. *) - | _ -> (n, read_comment graph line l_id) - in - loop n2 graph2 l2 - - with End_of_file -> (graph, l_id) (* Done *) - in - let final_graph_lid= loop 0 empty_graph [] in - - close_in infile ; - final_graph_lid - -(* Write the graph in a .dot file*) -let export path graph = - (* Open a write-file. *) - let ff = open_out (path^".dot") in - - (* Write in this file. *) - fprintf ff "digraph graphique1 {\n\tsize=\"20\"\n\tnode [shape = circle];\n"; - - (* Write all arcs *) - e_iter graph (fun id1 id2 lbl -> fprintf ff "\t%d -> %d [ label = \"%s\" ];\n" id1 id2 lbl) ; - - fprintf ff "}\n" ; - - close_out ff ; - () \ No newline at end of file diff --git a/medium_project/src/MSgfile.mli b/medium_project/src/MSgfile.mli deleted file mode 100644 index 4d7f9df..0000000 --- a/medium_project/src/MSgfile.mli +++ /dev/null @@ -1,10 +0,0 @@ -open Graph - -type path = string - -val from_file: path -> (float graph * (string * id * float) list) - -val write_file: path -> string graph -> (string * id * float) list -> unit - -val export: path -> string graph -> unit - diff --git a/medium_project/src/graph.ml b/medium_project/src/graph.ml deleted file mode 100644 index 33f7a15..0000000 --- a/medium_project/src/graph.ml +++ /dev/null @@ -1,49 +0,0 @@ -type id = int - -type 'a out_arcs = (id * 'a) list - -(* A graph is just a list of pairs: a node & its outgoing arcs. *) -type 'a graph = (id * 'a out_arcs) list - -exception Graph_error of string - -let empty_graph = [] - -let node_exists gr id = List.mem_assoc id gr - -let out_arcs gr id = - try List.assoc id gr - with Not_found -> raise (Graph_error ("Node " ^ string_of_int id ^ " does not exist in this graph.")) - -let find_arc gr id1 id2 = - let out = out_arcs gr id1 in - try Some (List.assoc id2 out) - with Not_found -> None - -let new_node gr id = - if node_exists gr id then raise (Graph_error ("Node " ^ string_of_int id ^ " already exists in the graph.")) - else (id, []) :: gr - -let new_arc gr id1 id2 lbl = - - (* Existing out-arcs *) - let outa = out_arcs gr id1 in - - (* Update out-arcs. - * remove_assoc does not fail if id2 is not bound. *) - let outb = (id2, lbl) :: List.remove_assoc id2 outa in - - (* Replace out-arcs in the graph. *) - let gr2 = List.remove_assoc id1 gr in - (id1, outb) :: gr2 - -let n_iter gr f = List.iter (fun (id, _) -> f id) gr - -let n_iter_sorted gr f = n_iter (List.sort compare gr) f - -let n_fold gr f acu = List.fold_left (fun acu (id, _) -> f acu id) acu gr - -let e_iter gr f = List.iter (fun (id1, out) -> List.iter (fun (id2, x) -> f id1 id2 x) out) gr - -let e_fold gr f acu = List.fold_left (fun acu (id1, out) -> List.fold_left (fun acu (id2, x) -> f acu id1 id2 x) acu out) acu gr - diff --git a/medium_project/src/graph.mli b/medium_project/src/graph.mli deleted file mode 100644 index 416e158..0000000 --- a/medium_project/src/graph.mli +++ /dev/null @@ -1,63 +0,0 @@ - -(* Type of a directed graph in which arcs have labels of type 'a. *) -type 'a graph - -(* Each node has a unique identifier (a number). *) -type id = int - -exception Graph_error of string - - -(************** CONSTRUCTORS **************) - -(* The empty graph. *) -val empty_graph: 'a graph - -(* Add a new node with the given identifier. - * @raise Graph_error if the id already exists. *) -val new_node: 'a graph -> id -> 'a graph - -(* new_arc gr id1 id2 lbl : adds an arc from node id1 to node id2 with label lbl - * Both nodes must already exist in the graph. - * If the arc already exists, its label is replaced by lbl. - * @raise Graph_error if node id1 or id2 does not exist in the graph. *) -val new_arc: 'a graph -> id -> id -> 'a -> 'a graph - - -(************** GETTERS *****************) - -(* node_exists gr id indicates if the node with identifier id exists in graph gr. *) -val node_exists: 'a graph -> id -> bool - -(* Type of lists of outgoing arcs of a node. - * An arc is represented by a pair of the destination identifier and the arc label. *) -type 'a out_arcs = (id * 'a) list - -(* Find the out_arcs of a node. - * @raise Graph_error if the id is unknown in the graph. *) -val out_arcs: 'a graph -> id -> 'a out_arcs - -(* find_arc gr id1 id2 finds an arc between id1 and id2 and returns its label. Returns None if the arc does not exist. - * @raise Graph_error if id1 is unknown. *) -val find_arc: 'a graph -> id -> id -> 'a option - - -(************** COMBINATORS, ITERATORS **************) - -(* Iterate on all nodes, in no special order. *) -val n_iter: 'a graph -> (id -> unit) -> unit - -(* Like n_iter, but the nodes are sorted. *) -val n_iter_sorted: 'a graph -> (id -> unit) -> unit - -(* Fold on all (unsorted) nodes. You must remember what List.fold_left does. *) -val n_fold: 'a graph -> ('b -> id -> 'b) -> 'b -> 'b - - -(* Iter on all arcs (edges) *) -val e_iter: 'a graph -> (id -> id -> 'a -> unit) -> unit - -(* Fold on all arcs (edges) *) -val e_fold: 'a graph -> ('b -> id -> id -> 'a -> 'b) -> 'b -> 'b - - diff --git a/medium_project/src/moneySharing.ml b/medium_project/src/moneySharing.ml deleted file mode 100644 index 2714b21..0000000 --- a/medium_project/src/moneySharing.ml +++ /dev/null @@ -1,41 +0,0 @@ -open Graph -open Tool - - -(*fonction qui créé le noeud associé à un utilisateur et rentre la correspondance dans la table des id*) -let init_node g user id l_id= - ( (new_node g id), ((user,id,0.0)::l_id) ) - - -(*fonction qui renvoie l'id d'un utilisateur*) -let rec get_id utilisateur l_id= match l_id with - |[]-> raise Not_found - |(a,id1,value)::b-> if a=utilisateur then id1 else get_id utilisateur b - -(*fonction qui renvoie le nom correspondant à un id*) -let rec get_user id1 l_id= match l_id with - |[]-> raise Not_found - |(nom,a,value)::b-> if a=id1 then nom else get_user id1 b - -let set_val_du a l_id montant l_utilisateurs= - List.map (fun (nom,id,value)-> if nom=a - then (nom,id,(Float.sub value (Float.div montant (Float.of_int(List.length l_utilisateurs))))) - else (nom,id,value) - ) l_id - -let set_val_pret utilisateur montant l_id= - List.map (fun (nom,id,value)-> if nom=utilisateur - then (nom,id,(Float.add value montant)) - else (nom,id,value) - ) l_id - -(*fonction qui rentre les paiements réalisés*) -let paiement g utilisateur l_utilisateurs montant l_id= - let rec paye g utilisateur l_utilisateurs montant l_id=match l_utilisateurs with - |[]-> (g, l_id) - |a::b-> paye g utilisateur b montant (set_val_du a l_id montant l_utilisateurs) in - let l_id= set_val_pret utilisateur montant l_id in - paye g utilisateur l_utilisateurs montant l_id - - - diff --git a/medium_project/src/moneySharing.mli b/medium_project/src/moneySharing.mli deleted file mode 100644 index 012addc..0000000 --- a/medium_project/src/moneySharing.mli +++ /dev/null @@ -1,13 +0,0 @@ -open Graph - -val paiement: float graph -> string -> string list -> float -> (string * id * float) list -> (float graph * (string * id * float) list) - -val init_node: float graph -> string -> id -> (string * id * float) list-> (float graph * (string * id * float) list) - -val get_id: string -> (string * id * float) list -> id - -val get_user: id -> (string * id * float) list -> string - -val set_val_du: string -> (string * id * float) list -> float -> string list -> (string * id * float) list - -val set_val_pret: string -> float -> (string * id * float) list -> (string * id * float) list \ No newline at end of file diff --git a/medium_project/src/tool.ml b/medium_project/src/tool.ml deleted file mode 100644 index 71736c9..0000000 --- a/medium_project/src/tool.ml +++ /dev/null @@ -1,19 +0,0 @@ -(* Yes, we have to repeat open Graph. *) -open Graph - -(* assert false is of type ∀α.α, so the type-checker is happy. *) - - -let clone_nodes gr = n_fold gr new_node empty_graph - - -(* Clone the nodes first then clone every arc but change their label by applying f*) -let gmap gr f = - let new_graph = clone_nodes gr in - e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph - -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 (Float.add n x) diff --git a/medium_project/src/tool.mli b/medium_project/src/tool.mli deleted file mode 100644 index 20676be..0000000 --- a/medium_project/src/tool.mli +++ /dev/null @@ -1,9 +0,0 @@ -open Graph - -(* Clone a graph by keeping only its nodes *) -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: float graph -> id -> id -> float -> float graph \ No newline at end of file