Browse Source

nettoyage

Leonie Gallois 3 years ago
parent
commit
4ba9d5239b

+ 0
- 20
acceptable_project/Makefile View File

@@ -1,20 +0,0 @@
1
-
2
-build:
3
-	@echo "\n==== COMPILING ====\n"
4
-	ocamlbuild ftest.native
5
-
6
-format:
7
-	ocp-indent --inplace src/*
8
-
9
-edit:
10
-	code . -n
11
-
12
-demo: build
13
-	@echo "\n==== EXECUTING ====\n"
14
-	./ftest.native graphs/graph1 1 2 outfile
15
-	@echo "\n==== RESULT ==== (content of outfile) \n"
16
-	@cat outfile
17
-
18
-clean:
19
-	-rm -rf _build/
20
-	-rm ftest.native

+ 0
- 21
acceptable_project/README.md View File

@@ -1,21 +0,0 @@
1
-Base project for Ocaml project on Ford-Fulkerson. This project contains some simple configuration files to facilitate editing Ocaml in VSCode.
2
-
3
-To use, you should install the *OCaml* extension in VSCode. Other extensions might work as well but make sure there is only one installed.
4
-Then open VSCode in the root directory of this repository (command line: `code path/to/ocaml-maxflow-project`).
5
-
6
-Features :
7
- - full compilation as VSCode build task (Ctrl+Shift+b)
8
- - highlights of compilation errors as you type
9
- - code completion
10
- - automatic indentation on file save
11
-
12
-
13
-A makefile provides some useful commands:
14
- - `make build` to compile. This creates an ftest.native executable
15
- - `make demo` to run the `ftest` program with some arguments
16
- - `make format` to indent the entire project
17
- - `make edit` to open the project in VSCode
18
- - `make clean` to remove build artifacts
19
-
20
-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`).
21
-

+ 0
- 3
acceptable_project/_tags View File

@@ -1,3 +0,0 @@
1
-<src/**>: include
2
-
3
-

+ 0
- 24
acceptable_project/graphs/graph1 View File

@@ -1,24 +0,0 @@
1
-%% Test graph #1
2
-
3
-%% Nodes
4
-
5
-n 88 209     % This is node #0, with its coordinates (which are not used by the algorithms).
6
-n 408 183
7
-n 269 491
8
-n 261 297
9
-n 401 394
10
-n 535 294    % This is node #5.
11
-
12
-
13
-%% Edges
14
-
15
-e 3 1 11     % An edge from 3 to 1, labeled "11".
16
-e 3 2 2
17
-e 1 5 21
18
-e 4 5 14
19
-e 1 4 1
20
-e 0 1 7
21
-e 0 3 10
22
-e 3 4 5
23
-e 2 4 12
24
-e 0 2 8

+ 0
- 106
acceptable_project/graphs/graph1.svg View File

@@ -1,106 +0,0 @@
1
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
2
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"
3
- "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd" [
4
- <!ATTLIST svg xmlns:xlink CDATA #FIXED "http://www.w3.org/1999/xlink">
5
-]>
6
-<!-- Generated by dot version 2.7.20060111.0540 (Fri Sep  3 08:16:42 UTC 2010)
7
-     For user: (lebotlan) D. Le Botlan,,, -->
8
-<!-- Title: finite_state_machine Pages: 1 -->
9
-<svg width="689px" height="302px"
10
- viewBox = "0 0 517 227"
11
- xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
12
-<g id="graph0" class="graph" style="font-family:Times-Roman;font-size:14.00;">
13
-<title>finite_state_machine</title>
14
-<polygon style="fill:white;stroke:white;" points="0,227 0,-11 528,-11 528,227 0,227"/>
15
-<!-- 0 -->
16
-<g id="node1" class="node"><title>0</title>
17
-<ellipse style="fill:none;stroke:black;" cx="29" cy="112" rx="18" ry="18"/>
18
-<text text-anchor="middle" x="29" y="119">0</text>
19
-</g>
20
-<!-- 2 -->
21
-<g id="node3" class="node"><title>2</title>
22
-<ellipse style="fill:none;stroke:black;" cx="259" cy="43" rx="18" ry="18"/>
23
-<text text-anchor="middle" x="259" y="50">2</text>
24
-</g>
25
-<!-- 0&#45;&gt;2 -->
26
-<g id="edge2" class="edge"><title>0&#45;&gt;2</title>
27
-<path style="fill:none;stroke:black;" d="M51,100C59,95 68,90 77,86 127,64 140,59 192,48 201,47 212,46 221,44"/>
28
-<polygon style="fill:black;stroke:black;" points="221,39 235,44 221,48 221,39"/>
29
-<text text-anchor="middle" x="144" y="52">8</text>
30
-</g>
31
-<!-- 3 -->
32
-<g id="node5" class="node"><title>3</title>
33
-<ellipse style="fill:none;stroke:black;" cx="144" cy="112" rx="18" ry="18"/>
34
-<text text-anchor="middle" x="144" y="119">3</text>
35
-</g>
36
-<!-- 0&#45;&gt;3 -->
37
-<g id="edge4" class="edge"><title>0&#45;&gt;3</title>
38
-<path style="fill:none;stroke:black;" d="M53,112C69,112 89,112 107,112"/>
39
-<polygon style="fill:black;stroke:black;" points="107,107 120,112 107,116 107,107"/>
40
-<text text-anchor="middle" x="87" y="108">10</text>
41
-</g>
42
-<!-- 1 -->
43
-<g id="node7" class="node"><title>1</title>
44
-<ellipse style="fill:none;stroke:black;" cx="259" cy="191" rx="18" ry="18"/>
45
-<text text-anchor="middle" x="259" y="198">1</text>
46
-</g>
47
-<!-- 0&#45;&gt;1 -->
48
-<g id="edge6" class="edge"><title>0&#45;&gt;1</title>
49
-<path style="fill:none;stroke:black;" d="M48,127C65,142 93,160 120,170 153,182 192,187 221,188"/>
50
-<polygon style="fill:black;stroke:black;" points="221,184 235,190 221,192 221,184"/>
51
-<text text-anchor="middle" x="144" y="162">7</text>
52
-</g>
53
-<!-- 4 -->
54
-<g id="node9" class="node"><title>4</title>
55
-<ellipse style="fill:none;stroke:black;" cx="373" cy="120" rx="18" ry="18"/>
56
-<text text-anchor="middle" x="373" y="127">4</text>
57
-</g>
58
-<!-- 2&#45;&gt;4 -->
59
-<g id="edge8" class="edge"><title>2&#45;&gt;4</title>
60
-<path style="fill:none;stroke:black;" d="M279,56C296,68 321,86 343,99"/>
61
-<polygon style="fill:black;stroke:black;" points="345,95 353,107 340,103 345,95"/>
62
-<text text-anchor="middle" x="316" y="72">12</text>
63
-</g>
64
-<!-- 3&#45;&gt;2 -->
65
-<g id="edge12" class="edge"><title>3&#45;&gt;2</title>
66
-<path style="fill:none;stroke:black;" d="M165,99C183,90 207,75 225,63"/>
67
-<polygon style="fill:black;stroke:black;" points="224,59 237,55 229,66 224,59"/>
68
-<text text-anchor="middle" x="201" y="71">2</text>
69
-</g>
70
-<!-- 3&#45;&gt;1 -->
71
-<g id="edge14" class="edge"><title>3&#45;&gt;1</title>
72
-<path style="fill:none;stroke:black;" d="M161,128C171,136 181,146 192,152 203,159 215,167 225,172"/>
73
-<polygon style="fill:black;stroke:black;" points="228,168 237,179 224,176 228,168"/>
74
-<text text-anchor="middle" x="201" y="148">11</text>
75
-</g>
76
-<!-- 3&#45;&gt;4 -->
77
-<g id="edge10" class="edge"><title>3&#45;&gt;4</title>
78
-<path style="fill:none;stroke:black;" d="M168,114C208,115 288,118 336,119"/>
79
-<polygon style="fill:black;stroke:black;" points="336,114 349,119 336,123 336,114"/>
80
-<text text-anchor="middle" x="259" y="114">5</text>
81
-</g>
82
-<!-- 1&#45;&gt;4 -->
83
-<g id="edge16" class="edge"><title>1&#45;&gt;4</title>
84
-<path style="fill:none;stroke:black;" d="M280,179C293,171 311,162 325,152 331,150 336,146 343,142"/>
85
-<polygon style="fill:black;stroke:black;" points="340,138 353,135 344,146 340,138"/>
86
-<text text-anchor="middle" x="316" y="148">1</text>
87
-</g>
88
-<!-- 5 -->
89
-<g id="node15" class="node"><title>5</title>
90
-<ellipse style="fill:none;stroke:black;" cx="488" cy="168" rx="18" ry="18"/>
91
-<text text-anchor="middle" x="488" y="175">5</text>
92
-</g>
93
-<!-- 1&#45;&gt;5 -->
94
-<g id="edge18" class="edge"><title>1&#45;&gt;5</title>
95
-<path style="fill:none;stroke:black;" d="M283,188C311,186 357,182 397,178 415,175 433,174 451,172"/>
96
-<polygon style="fill:black;stroke:black;" points="451,168 464,171 451,176 451,168"/>
97
-<text text-anchor="middle" x="373" y="174">21</text>
98
-</g>
99
-<!-- 4&#45;&gt;5 -->
100
-<g id="edge20" class="edge"><title>4&#45;&gt;5</title>
101
-<path style="fill:none;stroke:black;" d="M396,130C412,138 435,147 453,154"/>
102
-<polygon style="fill:black;stroke:black;" points="455,150 465,159 451,158 455,150"/>
103
-<text text-anchor="middle" x="431" y="138">14</text>
104
-</g>
105
-</g>
106
-</svg>

+ 0
- 21
acceptable_project/graphs/graph2 View File

@@ -1,21 +0,0 @@
1
-% This is a graph.
2
-
3
-n 0.0 1.0
4
-n 1.0 1.0
5
-n 2.0 1.0
6
-n 3.0 1.0
7
-n 4.0 1.0
8
-n 5.0 1.0
9
-
10
-e 0 1 16
11
-e 0 2 13
12
-e 1 2 10
13
-e 1 3 12
14
-e 2 1 4
15
-e 2 4 14
16
-e 3 2 9
17
-e 3 5 20
18
-e 4 3 7
19
-e 4 5 4
20
-
21
-% End of graph

+ 0
- 50
acceptable_project/src/BLF.ml View File

@@ -1,50 +0,0 @@
1
-open Graph
2
-
3
-type path = id list
4
-
5
-(*type record avec id noeud et son cout*)
6
-type t_cost={
7
-    mutable cout:int;
8
-    mutable father:int 
9
-    }
10
-
11
-let blf gr id_src id_dest=
12
-    (*je compte le nb de noeuds dans le graphe pour instancier mon tableau*)
13
-    let nb_n=n_fold gr (fun acu id->acu+1) 0 in
14
-    
15
-    let cost ={cout=max_int; father=(-1)} in
16
-
17
-    let acu =Array.make nb_n cost in
18
-    (*je fais un fold_left pour pouvoir individualiser au niveau de la mémoire les cases de la table*)
19
-    let blf_tab=n_fold gr (fun acu id->acu.(id)<-{cout=max_int; father=(-1)}; acu ) acu in
20
-    blf_tab.(id_src).cout<-0;
21
-    let file_id=[id_src] in
22
-    let file_marque =[] in
23
-
24
-    let rec blf_rec gr file_id file_marque= match file_id with
25
-        |[]-> blf_tab
26
-        |a::b-> 
27
-        let l_out_arc=out_arcs gr a in
28
-            let rec loop_suc l_out_arc blf_tab file =
29
-                match l_out_arc with
30
-                |[]-> blf_rec gr file (a::file_marque)
31
-                |(id,label)::d-> 
32
-                    if label != 0 && (blf_tab.(a).cout+label)<blf_tab.(id).cout then
33
-                    begin
34
-                        blf_tab.(id).cout<-(blf_tab.(a).cout+label);
35
-                        blf_tab.(id).father<-a; 
36
-                        if not (List.mem id file_marque) then loop_suc d blf_tab (id::file) else loop_suc d blf_tab file
37
-                    end
38
-                    else loop_suc d blf_tab file in
39
-        loop_suc l_out_arc blf_tab b in
40
-    blf_rec gr file_id file_marque 
41
-
42
-(*avec blf_tab, on retrace chemin avec les pères*)
43
-let get_path gr id_src id_dest=
44
-    let blf_tab=blf gr id_src id_dest in
45
-    let path=[id_dest] in
46
-    let rec loop path blf_tab id_src id_dest= 
47
-        let father_id=blf_tab.(id_dest).father in match father_id with
48
-           |(-1)->None 
49
-           |a->if a == id_src then Some (id_src::path) else loop (a::path) blf_tab id_src a in
50
-    loop path blf_tab id_src id_dest

+ 0
- 12
acceptable_project/src/BLF.mli View File

@@ -1,12 +0,0 @@
1
-open Graph
2
-
3
-type path = id list
4
-
5
-type t_cost={
6
-    mutable cout:int;
7
-    mutable father:int 
8
-    }
9
-
10
-val blf: int graph -> id -> id -> t_cost array
11
-
12
-val get_path: int graph -> id -> id -> path option

+ 0
- 111
acceptable_project/src/FFAlgorithm.ml View File

@@ -1,111 +0,0 @@
1
-open Graph
2
-open Tool
3
-open BLF
4
-
5
-let g_to_string gr = gmap gr string_of_int
6
-let g_to_int gr = gmap gr int_of_string
7
-
8
-
9
-(* Create a list of pairs (origin,end) from a list of nodes *)
10
-let rec create_arcs_from_nodes = function
11
-  | [] -> []
12
-  | a :: [] -> []
13
-  | a :: b :: rest -> (a,b) :: (create_arcs_from_nodes (b :: rest))
14
-  
15
-
16
-
17
-(* Return the minimum value of a path's edge*)
18
-let get_min_label_from_path (graph : int graph) (path : (id * id) list) =
19
-  let min = Some 999 in
20
-  let min = List.fold_left
21
-    (
22
-      fun acu (id1, id2) -> 
23
-        let label = find_arc graph id1 id2 in 
24
-        if label < acu then label else acu
25
-    ) min path in
26
-    match min with
27
-    |None -> 999
28
-    |Some x -> x
29
-
30
-
31
-(* Add a value to every egde of a path *)
32
-let add_value_to_arcs (graph : int graph) (path : (id * id) list) (value : int) = 
33
-  List.fold_left 
34
-    (
35
-      fun acu (id1, id2) -> 
36
-        add_arc acu id1 id2 value    
37
-    ) 
38
-    graph path
39
- 
40
-
41
-(* Reverse a path and its edges 
42
-   ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *)
43
-let rev_arcs (path : (id * id) list) =
44
-  List.map (fun (id1, id2) -> (id2, id1)) path
45
-
46
-(* Get the final graph after the FFalgorithm 
47
-  The label of every arc becomes "x/max_capacity" where x 
48
-  is the value of the opposite arc on the residual graph*)
49
-let get_final_graph (initGraph : int graph) (residualGraph : int graph) =
50
-  
51
-  (* First get the initial and residual graph as string graphs *)
52
-  let initGraphString = initGraph in
53
-  let residualGraphString = residualGraph in
54
-  let finalGraph = clone_nodes initGraph in
55
-  
56
-  (* For every arc in the initial graph, we get its label (aka max_capacity)
57
-    then, we get the label of the opposite arc in the residual graph. 
58
-    If it exists then the arc of the final graph gets the label "x/max_capacity",
59
-    "0/max_capacity" otherwise*)
60
-  e_fold initGraph
61
-  (
62
-    fun acu id1 id2 x ->
63
-    let label_arc = (match find_arc initGraphString id1 id2 with
64
-      |None -> 0
65
-      |Some x -> x) in
66
-    let label_rev_arc = match find_arc residualGraphString id2 id1 with
67
-      |None -> 0
68
-      |Some x -> (match find_arc initGraphString id2 id1 with
69
-        |None -> x
70
-        |Some y -> x-y) in
71
-    let label_arc = string_of_int label_arc in
72
-    let label_rev_arc = if (label_rev_arc > 0) then (string_of_int label_rev_arc) else "0" in
73
-    new_arc acu id1 id2 (label_rev_arc^"/"^label_arc)  
74
-  )
75
-  finalGraph
76
-
77
-let ford_fulk_algorithm (graph : int graph) (origin : id) (sink : id) = 
78
-  let flow = 0 in
79
-
80
-  let initGraph = graph in
81
-  let rec boucle graph origin sink flow = 
82
-    
83
-    let path = get_path graph origin sink in
84
-    match path with
85
-      |None -> (flow, graph)
86
-      |Some x ->
87
-        (let path = x in 
88
-        let arcs = create_arcs_from_nodes path in
89
-        
90
-        (*let () = printf "dans boucle\n" in*)
91
-        
92
-        (* Find the min value of the path *)
93
-        let min = get_min_label_from_path graph arcs in
94
-    
95
-        (* Substract the min to every arc of the path *)
96
-        let graph = add_value_to_arcs graph arcs (-min) in
97
-
98
-
99
-        (* Get the reverse path *)
100
-        let reverse = rev_arcs arcs in
101
-    
102
-        (* Add the min to every arc of the reverse path *)
103
-        let graph = add_value_to_arcs graph reverse min in
104
-    
105
-        (* Add the min to the flow *) 
106
-        let flow = flow + min in
107
-        boucle graph origin sink flow) in
108
-  let (maxFlow, residualGraph) = boucle graph origin sink flow in
109
-  let finalGraph = get_final_graph initGraph residualGraph in 
110
-  (maxFlow, finalGraph) 
111
-  

+ 0
- 20
acceptable_project/src/FFAlgorithm.mli View File

@@ -1,20 +0,0 @@
1
-open Graph
2
-open Tool
3
-open BLF
4
-
5
-
6
-val g_to_int: string graph -> int graph
7
-
8
-val ford_fulk_algorithm : int graph -> id -> id -> (int * string graph)
9
-
10
-(* val g_to_string: int graph -> string graph *)
11
-
12
-(* val only_one_edge: int graph -> int graph *)
13
-
14
-(* for testing purpose *)
15
-
16
-(* val rev_arcs: (id * id) list -> (id * id) list
17
-
18
-val add_value_to_arcs: int graph -> (id * id) list -> int -> int graph
19
-
20
-val get_final_graph: int graph -> int graph -> string graph *)

+ 0
- 48
acceptable_project/src/ftest.ml View File

@@ -1,48 +0,0 @@
1
-open Gfile
2
-open Tool
3
-open FFAlgorithm
4
-open BLF
5
-open Format
6
-open Sys
7
-
8
-let () =
9
- 
10
-  (*/!\ Format de la commande pour lancer le test : 
11
-        ./ftest.native [nom_fichier_lecture] [id_source] [id_dest] [nom_fichier_ecriture]
12
-   ex : ./ftest.native graphs/graph1 0 5 graphs/graph3 *)
13
-
14
-  (* Check the number of command-line arguments *)
15
-  if Array.length Sys.argv <> 5 then
16
-    begin
17
-      Printf.printf "\nUsage: %s infile source sink outfile\n\n%!" Sys.argv.(0) ;
18
-      exit 0
19
-    end ;
20
-
21
-
22
-  (* Arguments are : infile(1) source-id(2) sink-id(3) outfile(4) *)
23
-
24
-  let infile = Sys.argv.(1)
25
-  and outfile = Sys.argv.(4)
26
-
27
-  (* These command-line arguments are not used for the moment. *)
28
-  and _source = int_of_string Sys.argv.(2)
29
-  and _sink = int_of_string Sys.argv.(3)
30
-  in
31
-
32
-  (* Open file *)
33
-  let graph = from_file infile in
34
-  let initGraph = g_to_int graph in
35
-
36
-  (* Rewrite the graph that has been read. *)
37
- 
38
-  let (flow,finalGraph) = ford_fulk_algorithm initGraph _source _sink in
39
-  let () = printf "max flow = %d\n" flow in
40
-  let () = write_file outfile finalGraph in
41
-  let () = export outfile finalGraph in
42
-  (* let () = export infile graph in *)
43
-
44
-  
45
-  (*Uncomment the following line if you have graphviz installed  *)
46
-  (*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in*)
47
-  ()
48
-

+ 0
- 119
acceptable_project/src/gfile.ml View File

@@ -1,119 +0,0 @@
1
-open Graph
2
-open Printf
3
-
4
-type path = string
5
-
6
-(* Format of text files:
7
-   % This is a comment
8
-
9
-   % A node with its coordinates (which are not used).
10
-   n 88.8 209.7
11
-   n 408.9 183.0
12
-
13
-   % The first node has id 0, the next is 1, and so on.
14
-
15
-   % Edges: e source dest label
16
-   e 3 1 11
17
-   e 0 2 8
18
-
19
-*)
20
-
21
-let write_file path graph =
22
-
23
-  (* Open a write-file. *)
24
-  let ff = open_out path in
25
-
26
-  (* Write in this file. *)
27
-  fprintf ff "%% This is a graph.\n\n" ;
28
-
29
-  (* Write all nodes (with fake coordinates) *)
30
-  n_iter_sorted graph (fun id -> fprintf ff "n %.1f 1.0\n" (float_of_int id)) ;
31
-  fprintf ff "\n" ;
32
-
33
-  (* Write all arcs *)
34
-  e_iter graph (fun id1 id2 lbl -> fprintf ff "e %d %d %s\n" id1 id2 lbl) ;
35
-
36
-  fprintf ff "\n%% End of graph\n" ;
37
-
38
-  
39
-
40
-  close_out ff ;
41
-  ()
42
-
43
-(* Reads a line with a node. *)
44
-let read_node id graph line =
45
-  try Scanf.sscanf line "n %f %f" (fun _ _ -> new_node graph id)
46
-  with e ->
47
-    Printf.printf "Cannot read node in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
48
-    failwith "from_file"
49
-    
50
-(* Ensure that the given node exists in the graph. If not, create it. 
51
- * (Necessary because the website we use to create online graphs does not generate correct files when some nodes have been deleted.) *)
52
-let ensure graph id = if node_exists graph id then graph else new_node graph id
53
-
54
-(* Reads a line with an arc. *)
55
-let read_arc graph line =
56
-  try Scanf.sscanf line "e %d %d %s"
57
-        (fun id1 id2 label -> new_arc (ensure (ensure graph id1) id2) id1 id2 label)
58
-  with e ->
59
-    Printf.printf "Cannot read arc in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
60
-    failwith "from_file"
61
-
62
-(* Reads a comment or fail. *)
63
-let read_comment graph line =
64
-  try Scanf.sscanf line " %%" graph
65
-  with _ ->
66
-    Printf.printf "Unknown line:\n%s\n%!" line ;
67
-    failwith "from_file"
68
-
69
-let from_file path =
70
-
71
-  let infile = open_in path in
72
-
73
-  (* Read all lines until end of file. 
74
-   * n is the current node counter. *)
75
-  let rec loop n graph =
76
-    try
77
-      let line = input_line infile in
78
-
79
-      (* Remove leading and trailing spaces. *)
80
-      let line = String.trim line in
81
-
82
-      let (n2, graph2) =
83
-        (* Ignore empty lines *)
84
-        if line = "" then (n, graph)
85
-
86
-        (* The first character of a line determines its content : n or e. *)
87
-        else match line.[0] with
88
-          | 'n' -> (n+1, read_node n graph line)
89
-          | 'e' -> (n, read_arc graph line)
90
-
91
-          (* It should be a comment, otherwise we complain. *)
92
-          | _ -> (n, read_comment graph line)
93
-      in      
94
-      loop n2 graph2
95
-
96
-    with End_of_file -> graph (* Done *)
97
-  in
98
-
99
-  let final_graph = loop 0 empty_graph in
100
-
101
-  close_in infile ;
102
-  final_graph
103
-
104
-
105
-(* Write the graph in a .dot file*)
106
-let export path graph =
107
-  (* Open a write-file. *)
108
-  let ff = open_out (path^".dot") in
109
-
110
-  (* Write in this file. *)
111
-  fprintf ff "digraph graphique1 {\n\tsize=\"20\"\n\tnode [shape = circle];\n";
112
-
113
-  (* Write all arcs *)
114
-  e_iter graph (fun id1 id2 lbl -> fprintf ff "\t%d -> %d [ label = \"%s\" ];\n" id1 id2 lbl) ;
115
-
116
-  fprintf ff "}\n" ;
117
-
118
-  close_out ff ;
119
-  ()

+ 0
- 19
acceptable_project/src/gfile.mli View File

@@ -1,19 +0,0 @@
1
-(* Read a graph from a file,
2
- * Write a graph to a file. *)
3
-
4
-open Graph
5
-
6
-type path = string
7
-
8
-(* Values are read as strings. *)
9
-val from_file: path -> string graph
10
-
11
-(* Similarly, we write only a string graph.
12
- * If necessary, use gmap (to be written by you) to prepare the input graph. *)
13
-val write_file: path -> string graph -> unit
14
-
15
-val export: path -> string graph -> unit
16
-
17
-(* The format of files is compatible with the files generated by:
18
-   https://www-m9.ma.tum.de/graph-algorithms/flow-ford-fulkerson/index_en.html
19
-*)

+ 0
- 49
acceptable_project/src/graph.ml View File

@@ -1,49 +0,0 @@
1
-type id = int
2
-
3
-type 'a out_arcs = (id * 'a) list
4
-
5
-(* A graph is just a list of pairs: a node & its outgoing arcs. *)
6
-type 'a graph = (id * 'a out_arcs) list
7
-
8
-exception Graph_error of string
9
-
10
-let empty_graph = []
11
-
12
-let node_exists gr id = List.mem_assoc id gr
13
-
14
-let out_arcs gr id =
15
-  try List.assoc id gr
16
-  with Not_found -> raise (Graph_error ("Node " ^ string_of_int id ^ " does not exist in this graph."))
17
-
18
-let find_arc gr id1 id2 =
19
-  let out = out_arcs gr id1 in
20
-  try Some (List.assoc id2 out)
21
-  with Not_found -> None
22
-
23
-let new_node gr id =
24
-  if node_exists gr id then raise (Graph_error ("Node " ^ string_of_int id ^ " already exists in the graph."))
25
-  else (id, []) :: gr
26
-
27
-let new_arc gr id1 id2 lbl =
28
-
29
-  (* Existing out-arcs *)
30
-  let outa = out_arcs gr id1 in
31
-
32
-  (* Update out-arcs.
33
-   * remove_assoc does not fail if id2 is not bound.  *)
34
-  let outb = (id2, lbl) :: List.remove_assoc id2 outa in
35
-
36
-  (* Replace out-arcs in the graph. *)
37
-  let gr2 = List.remove_assoc id1 gr in
38
-  (id1, outb) :: gr2
39
-
40
-let n_iter gr f = List.iter (fun (id, _) -> f id) gr
41
-
42
-let n_iter_sorted gr f = n_iter (List.sort compare gr) f
43
-
44
-let n_fold gr f acu = List.fold_left (fun acu (id, _) -> f acu id) acu gr
45
-
46
-let e_iter gr f = List.iter (fun (id1, out) -> List.iter (fun (id2, x) -> f id1 id2 x) out) gr
47
-
48
-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
49
-

+ 0
- 63
acceptable_project/src/graph.mli View File

@@ -1,63 +0,0 @@
1
-
2
-(* Type of a directed graph in which arcs have labels of type 'a. *)
3
-type 'a graph
4
-
5
-(* Each node has a unique identifier (a number). *)
6
-type id = int
7
-
8
-exception Graph_error of string
9
-
10
-
11
-(**************  CONSTRUCTORS  **************)
12
-
13
-(* The empty graph. *)
14
-val empty_graph: 'a graph
15
-
16
-(* Add a new node with the given identifier.
17
- * @raise Graph_error if the id already exists. *)
18
-val new_node: 'a graph -> id -> 'a graph
19
-
20
-(* new_arc gr id1 id2 lbl  : adds an arc from node id1 to node id2 with label lbl
21
- * Both nodes must already exist in the graph.
22
- * If the arc already exists, its label is replaced by lbl. 
23
- * @raise Graph_error if node id1 or id2 does not exist in the graph. *)
24
-val new_arc: 'a graph -> id -> id -> 'a -> 'a graph
25
-
26
-
27
-(**************  GETTERS  *****************)
28
-
29
-(* node_exists gr id  indicates if the node with identifier id exists in graph gr. *)
30
-val node_exists: 'a graph -> id -> bool
31
-
32
-(* Type of lists of outgoing arcs of a node. 
33
- * An arc is represented by a pair of the destination identifier and the arc label. *)
34
-type 'a out_arcs = (id * 'a) list
35
-
36
-(* Find the out_arcs of a node.
37
- * @raise Graph_error if the id is unknown in the graph. *)
38
-val out_arcs: 'a graph -> id -> 'a out_arcs
39
-
40
-(* find_arc gr id1 id2  finds an arc between id1 and id2 and returns its label. Returns None if the arc does not exist. 
41
- * @raise Graph_error if id1 is unknown. *)
42
-val find_arc: 'a graph -> id -> id -> 'a option
43
-
44
-
45
-(**************  COMBINATORS, ITERATORS  **************)
46
-
47
-(* Iterate on all nodes, in no special order. *)
48
-val n_iter: 'a graph -> (id -> unit) -> unit
49
-
50
-(* Like n_iter, but the nodes are sorted. *)
51
-val n_iter_sorted: 'a graph -> (id -> unit) -> unit
52
-
53
-(* Fold on all (unsorted) nodes. You must remember what List.fold_left does. *)
54
-val n_fold: 'a graph -> ('b -> id -> 'b) -> 'b -> 'b
55
-
56
-
57
-(* Iter on all arcs (edges) *)
58
-val e_iter: 'a graph -> (id -> id -> 'a -> unit) -> unit
59
-
60
-(* Fold on all arcs (edges) *)
61
-val e_fold: 'a graph -> ('b -> id -> id -> 'a -> 'b) -> 'b -> 'b
62
-
63
-

+ 0
- 19
acceptable_project/src/tool.ml View File

@@ -1,19 +0,0 @@
1
-(* Yes, we have to repeat open Graph. *)
2
-open Graph
3
-
4
-(* assert false is of type ∀α.α, so the type-checker is happy. *)
5
-
6
-
7
-let clone_nodes gr = n_fold gr new_node empty_graph 
8
-
9
-
10
-(* Clone the nodes first then clone every arc but change their label by applying f*)
11
-let gmap gr f = 
12
-  let new_graph = clone_nodes gr in
13
-  e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph 
14
-
15
-let add_arc g id1 id2 n =
16
-    let f = find_arc g id1 id2  in
17
-    match f with
18
-    |None->new_arc g id1 id2 n
19
-    |Some x->new_arc g id1 id2 (n+x)

+ 0
- 9
acceptable_project/src/tool.mli View File

@@ -1,9 +0,0 @@
1
-open Graph
2
-
3
-(* Clone a graph by keeping only its nodes *)
4
-val clone_nodes: 'a graph -> 'b graph
5
-
6
-(* Apply a function f to every label of the graph's arcs *)
7
-val gmap: 'a graph -> ('a -> 'b) -> 'b graph
8
-
9
-val add_arc: int graph -> id -> id -> int -> int graph

+ 0
- 21
medium_project/Makefile View File

@@ -1,21 +0,0 @@
1
-
2
-build:
3
-	@echo "\n==== COMPILING ====\n"
4
-	#ocamlbuild ftest.native#
5
-	ocamlbuild MSftest.native
6
-
7
-format:
8
-	ocp-indent --inplace src/*
9
-
10
-edit:
11
-	code . -n
12
-
13
-demo: build
14
-	@echo "\n==== EXECUTING ====\n"
15
-	./ftest.native graphs/graph1 1 2 outfile
16
-	@echo "\n==== RESULT ==== (content of outfile) \n"
17
-	@cat outfile
18
-
19
-clean:
20
-	-rm -rf _build/
21
-	-rm MSftest.native

+ 0
- 21
medium_project/README.md View File

@@ -1,21 +0,0 @@
1
-Base project for Ocaml project on Ford-Fulkerson. This project contains some simple configuration files to facilitate editing Ocaml in VSCode.
2
-
3
-To use, you should install the *OCaml* extension in VSCode. Other extensions might work as well but make sure there is only one installed.
4
-Then open VSCode in the root directory of this repository (command line: `code path/to/ocaml-maxflow-project`).
5
-
6
-Features :
7
- - full compilation as VSCode build task (Ctrl+Shift+b)
8
- - highlights of compilation errors as you type
9
- - code completion
10
- - automatic indentation on file save
11
-
12
-
13
-A makefile provides some useful commands:
14
- - `make build` to compile. This creates an ftest.native executable
15
- - `make demo` to run the `ftest` program with some arguments
16
- - `make format` to indent the entire project
17
- - `make edit` to open the project in VSCode
18
- - `make clean` to remove build artifacts
19
-
20
-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`).
21
-

+ 0
- 3
medium_project/_tags View File

@@ -1,3 +0,0 @@
1
-<src/**>: include
2
-
3
-

+ 0
- 24
medium_project/graphs/graph1 View File

@@ -1,24 +0,0 @@
1
-%% Test graph #1
2
-
3
-%% Nodes
4
-
5
-n 88 209     % This is node #0, with its coordinates (which are not used by the algorithms).
6
-n 408 183
7
-n 269 491
8
-n 261 297
9
-n 401 394
10
-n 535 294    % This is node #5.
11
-
12
-
13
-%% Edges
14
-
15
-e 3 1 11     % An edge from 3 to 1, labeled "11".
16
-e 3 2 2
17
-e 1 5 21
18
-e 4 5 14
19
-e 1 4 1
20
-e 0 1 7
21
-e 0 3 10
22
-e 3 4 5
23
-e 2 4 12
24
-e 0 2 8

+ 0
- 106
medium_project/graphs/graph1.svg View File

@@ -1,106 +0,0 @@
1
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
2
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"
3
- "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd" [
4
- <!ATTLIST svg xmlns:xlink CDATA #FIXED "http://www.w3.org/1999/xlink">
5
-]>
6
-<!-- Generated by dot version 2.7.20060111.0540 (Fri Sep  3 08:16:42 UTC 2010)
7
-     For user: (lebotlan) D. Le Botlan,,, -->
8
-<!-- Title: finite_state_machine Pages: 1 -->
9
-<svg width="689px" height="302px"
10
- viewBox = "0 0 517 227"
11
- xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
12
-<g id="graph0" class="graph" style="font-family:Times-Roman;font-size:14.00;">
13
-<title>finite_state_machine</title>
14
-<polygon style="fill:white;stroke:white;" points="0,227 0,-11 528,-11 528,227 0,227"/>
15
-<!-- 0 -->
16
-<g id="node1" class="node"><title>0</title>
17
-<ellipse style="fill:none;stroke:black;" cx="29" cy="112" rx="18" ry="18"/>
18
-<text text-anchor="middle" x="29" y="119">0</text>
19
-</g>
20
-<!-- 2 -->
21
-<g id="node3" class="node"><title>2</title>
22
-<ellipse style="fill:none;stroke:black;" cx="259" cy="43" rx="18" ry="18"/>
23
-<text text-anchor="middle" x="259" y="50">2</text>
24
-</g>
25
-<!-- 0&#45;&gt;2 -->
26
-<g id="edge2" class="edge"><title>0&#45;&gt;2</title>
27
-<path style="fill:none;stroke:black;" d="M51,100C59,95 68,90 77,86 127,64 140,59 192,48 201,47 212,46 221,44"/>
28
-<polygon style="fill:black;stroke:black;" points="221,39 235,44 221,48 221,39"/>
29
-<text text-anchor="middle" x="144" y="52">8</text>
30
-</g>
31
-<!-- 3 -->
32
-<g id="node5" class="node"><title>3</title>
33
-<ellipse style="fill:none;stroke:black;" cx="144" cy="112" rx="18" ry="18"/>
34
-<text text-anchor="middle" x="144" y="119">3</text>
35
-</g>
36
-<!-- 0&#45;&gt;3 -->
37
-<g id="edge4" class="edge"><title>0&#45;&gt;3</title>
38
-<path style="fill:none;stroke:black;" d="M53,112C69,112 89,112 107,112"/>
39
-<polygon style="fill:black;stroke:black;" points="107,107 120,112 107,116 107,107"/>
40
-<text text-anchor="middle" x="87" y="108">10</text>
41
-</g>
42
-<!-- 1 -->
43
-<g id="node7" class="node"><title>1</title>
44
-<ellipse style="fill:none;stroke:black;" cx="259" cy="191" rx="18" ry="18"/>
45
-<text text-anchor="middle" x="259" y="198">1</text>
46
-</g>
47
-<!-- 0&#45;&gt;1 -->
48
-<g id="edge6" class="edge"><title>0&#45;&gt;1</title>
49
-<path style="fill:none;stroke:black;" d="M48,127C65,142 93,160 120,170 153,182 192,187 221,188"/>
50
-<polygon style="fill:black;stroke:black;" points="221,184 235,190 221,192 221,184"/>
51
-<text text-anchor="middle" x="144" y="162">7</text>
52
-</g>
53
-<!-- 4 -->
54
-<g id="node9" class="node"><title>4</title>
55
-<ellipse style="fill:none;stroke:black;" cx="373" cy="120" rx="18" ry="18"/>
56
-<text text-anchor="middle" x="373" y="127">4</text>
57
-</g>
58
-<!-- 2&#45;&gt;4 -->
59
-<g id="edge8" class="edge"><title>2&#45;&gt;4</title>
60
-<path style="fill:none;stroke:black;" d="M279,56C296,68 321,86 343,99"/>
61
-<polygon style="fill:black;stroke:black;" points="345,95 353,107 340,103 345,95"/>
62
-<text text-anchor="middle" x="316" y="72">12</text>
63
-</g>
64
-<!-- 3&#45;&gt;2 -->
65
-<g id="edge12" class="edge"><title>3&#45;&gt;2</title>
66
-<path style="fill:none;stroke:black;" d="M165,99C183,90 207,75 225,63"/>
67
-<polygon style="fill:black;stroke:black;" points="224,59 237,55 229,66 224,59"/>
68
-<text text-anchor="middle" x="201" y="71">2</text>
69
-</g>
70
-<!-- 3&#45;&gt;1 -->
71
-<g id="edge14" class="edge"><title>3&#45;&gt;1</title>
72
-<path style="fill:none;stroke:black;" d="M161,128C171,136 181,146 192,152 203,159 215,167 225,172"/>
73
-<polygon style="fill:black;stroke:black;" points="228,168 237,179 224,176 228,168"/>
74
-<text text-anchor="middle" x="201" y="148">11</text>
75
-</g>
76
-<!-- 3&#45;&gt;4 -->
77
-<g id="edge10" class="edge"><title>3&#45;&gt;4</title>
78
-<path style="fill:none;stroke:black;" d="M168,114C208,115 288,118 336,119"/>
79
-<polygon style="fill:black;stroke:black;" points="336,114 349,119 336,123 336,114"/>
80
-<text text-anchor="middle" x="259" y="114">5</text>
81
-</g>
82
-<!-- 1&#45;&gt;4 -->
83
-<g id="edge16" class="edge"><title>1&#45;&gt;4</title>
84
-<path style="fill:none;stroke:black;" d="M280,179C293,171 311,162 325,152 331,150 336,146 343,142"/>
85
-<polygon style="fill:black;stroke:black;" points="340,138 353,135 344,146 340,138"/>
86
-<text text-anchor="middle" x="316" y="148">1</text>
87
-</g>
88
-<!-- 5 -->
89
-<g id="node15" class="node"><title>5</title>
90
-<ellipse style="fill:none;stroke:black;" cx="488" cy="168" rx="18" ry="18"/>
91
-<text text-anchor="middle" x="488" y="175">5</text>
92
-</g>
93
-<!-- 1&#45;&gt;5 -->
94
-<g id="edge18" class="edge"><title>1&#45;&gt;5</title>
95
-<path style="fill:none;stroke:black;" d="M283,188C311,186 357,182 397,178 415,175 433,174 451,172"/>
96
-<polygon style="fill:black;stroke:black;" points="451,168 464,171 451,176 451,168"/>
97
-<text text-anchor="middle" x="373" y="174">21</text>
98
-</g>
99
-<!-- 4&#45;&gt;5 -->
100
-<g id="edge20" class="edge"><title>4&#45;&gt;5</title>
101
-<path style="fill:none;stroke:black;" d="M396,130C412,138 435,147 453,154"/>
102
-<polygon style="fill:black;stroke:black;" points="455,150 465,159 451,158 455,150"/>
103
-<text text-anchor="middle" x="431" y="138">14</text>
104
-</g>
105
-</g>
106
-</svg>

+ 0
- 50
medium_project/src/BLF.ml View File

@@ -1,50 +0,0 @@
1
-open Graph
2
-
3
-type path = id list
4
-
5
-(*type record avec id noeud et son cout*)
6
-type t_cost={
7
-    mutable cout:float;
8
-    mutable father:int 
9
-    }
10
-
11
-let blf gr id_src id_dest=
12
-    (*je compte le nb de noeuds dans le graphe pour instancier mon tableau*)
13
-    let nb_n=n_fold gr (fun acu id->acu+1) 0 in
14
-    
15
-    let cost ={cout=max_float; father=(-1)} in
16
-
17
-    let acu =Array.make nb_n cost in
18
-    (*je fais un fold_left pour pouvoir individualiser au niveau de la mémoire les cases de la table*)
19
-    let blf_tab=n_fold gr (fun acu id->acu.(id)<-{cout=max_float; father=(-1)}; acu ) acu in
20
-    blf_tab.(id_src).cout<-0.0;
21
-    let file_id=[id_src] in
22
-    let file_marque =[] in
23
-
24
-    let rec blf_rec gr file_id file_marque= match file_id with
25
-        |[]-> blf_tab
26
-        |a::b-> 
27
-        let l_out_arc=out_arcs gr a in
28
-            let rec loop_suc l_out_arc blf_tab file =
29
-                match l_out_arc with
30
-                |[]-> blf_rec gr file (a::file_marque)
31
-                |(id,label)::d-> 
32
-                    if label != 0.0 && (Float.add blf_tab.(a).cout label)<(blf_tab.(id).cout) then
33
-                    begin
34
-                        blf_tab.(id).cout<-(Float.add blf_tab.(a).cout label);
35
-                        blf_tab.(id).father<-a; 
36
-                        if not (List.mem id file_marque) then loop_suc d blf_tab (id::file) else loop_suc d blf_tab file
37
-                    end
38
-                    else loop_suc d blf_tab file in
39
-        loop_suc l_out_arc blf_tab b in
40
-    blf_rec gr file_id file_marque 
41
-
42
-(*avec blf_tab, on retrace chemin avec les pères*)
43
-let get_path gr id_src id_dest=
44
-    let blf_tab=blf gr id_src id_dest in
45
-    let path=[id_dest] in
46
-    let rec loop path blf_tab id_src id_dest= 
47
-        let father_id=blf_tab.(id_dest).father in match father_id with
48
-           |(-1)->None 
49
-           |a->if a == id_src then Some (id_src::path) else loop (a::path) blf_tab id_src a in
50
-    loop path blf_tab id_src id_dest

+ 0
- 12
medium_project/src/BLF.mli View File

@@ -1,12 +0,0 @@
1
-open Graph
2
-
3
-type path = id list
4
-
5
-type t_cost={
6
-    mutable cout:float;
7
-    mutable father:int 
8
-    }
9
-
10
-val blf: float graph -> id -> id -> t_cost array
11
-
12
-val get_path: float graph -> id -> id -> path option

+ 0
- 137
medium_project/src/FFAlgorithm.ml View File

@@ -1,137 +0,0 @@
1
-open Graph
2
-open Tool
3
-open BLF
4
-
5
-let g_to_string gr = gmap gr string_of_float
6
-let g_to_float gr = gmap gr float_of_string
7
-
8
-
9
-(* Create a list of pairs (origin,end) from a list of nodes *)
10
-let rec create_arcs_from_nodes = function
11
-  | [] -> []
12
-  | a :: [] -> []
13
-  | a :: b :: rest -> (a,b) :: (create_arcs_from_nodes (b :: rest))
14
-  
15
-
16
-
17
-(* Return the minimum value of a path's edge*)
18
-let get_min_label_from_path (graph : float graph) (path : (id * id) list) =
19
-  let min = Some 999.0 in
20
-  let min = List.fold_left
21
-    (
22
-      fun acu (id1, id2) -> 
23
-        let label = find_arc graph id1 id2 in 
24
-        if label < acu then label else acu
25
-    ) min path in
26
-    match min with
27
-    |None -> 999.0
28
-    |Some x -> x
29
-
30
-
31
-(* Add a value to every egde of a path *)
32
-let add_value_to_arcs (graph : float graph) (path : (id * id) list) (value : float) = 
33
-  List.fold_left 
34
-    (
35
-      fun acu (id1, id2) -> 
36
-        add_arc acu id1 id2 value    
37
-    ) 
38
-    graph path
39
- 
40
-
41
-(* Reverse a path and its edges 
42
-   ex :[(a, b);(b, c)] -> [(b,a);(c, b)] *)
43
-let rev_arcs (path : (id * id) list) =
44
-  List.map (fun (id1, id2) -> (id2, id1)) path
45
-
46
-  
47
-(* Removes the edges whose label = 0 *)
48
-let remove_zeroes (graph : float graph) = 
49
-  let initGraph = clone_nodes graph in
50
-  e_fold graph
51
-  (
52
-    fun acu id1 id2 x ->
53
-    if x = 0.0 then acu else new_arc acu id1 id2 x  
54
-  ) initGraph
55
-
56
-(* Remove bi-directional edges between 2 nodes*)
57
-let only_one_edge (graph : float graph) = 
58
-  let graphWithZeroes = e_fold graph 
59
-  (
60
-    fun acu id1 id2 x -> 
61
-    let path = [(id1,id2);(id2,id1)] in
62
-    
63
-    let label_rev = (match find_arc graph id2 id1 with
64
-    |None -> 0.0
65
-    |Some x -> x) in
66
-    let mini = min x label_rev in
67
-    let gr = add_value_to_arcs graph path (Float.neg mini) in
68
-    if x = 0.0 || mini = 0.0 then acu else gr
69
-  )
70
-  graph in
71
-  let graphWithoutZeroes = remove_zeroes graphWithZeroes in
72
-  graphWithoutZeroes
73
-
74
-
75
-(* Get the final graph after the FFalgorithm 
76
-  The label of every arc becomes "x/max_capacity" where x 
77
-  is the value of the opposite arc on the residual graph*)
78
-let get_final_graph (initGraph : float graph) (residualGraph : float graph) =
79
-  
80
-  (* First get the initial and residual graph as string graphs *)
81
-  let initGraphString = g_to_string initGraph in
82
-  let residualGraphString = g_to_string residualGraph in
83
-  let finalGraph = clone_nodes initGraph in
84
-  
85
-  (* For every arc in the initial graph, we get its label (aka max_capacity)
86
-    then, we get the label of the opposite arc in the residual graph. 
87
-    If it exists then the arc of the final graph gets the label "x/max_capacity",
88
-    "0.0/max_capacity" otherwise*)
89
-  e_fold initGraph
90
-  (
91
-    fun acu id1 id2 x ->
92
-    let label_arc = (match find_arc initGraphString id1 id2 with
93
-    |None -> "-1"
94
-    |Some x -> x) in
95
-    let label_rev_arc = find_arc residualGraphString id2 id1 in
96
-    match label_rev_arc with
97
-    |None -> new_arc acu id1 id2 ("0/"^label_arc) 
98
-    |Some x -> new_arc acu id1 id2 (""^x^"/"^label_arc)  
99
-  )
100
-  finalGraph
101
-
102
-let ford_fulk_algorithm (graph : float graph) (origin : id) (sink : id) = 
103
-  let flow = 0.0 in
104
-
105
-  let graph = only_one_edge graph in 
106
-  let initGraph = graph in
107
-  let rec boucle graph origin sink flow = 
108
-    
109
-    let path = get_path graph origin sink in
110
-    match path with
111
-      |None -> (flow, graph)
112
-      |Some x ->
113
-        (let path = x in 
114
-        let arcs = create_arcs_from_nodes path in
115
-        
116
-        (*let () = printf "dans boucle\n" in*)
117
-        
118
-        (* Find the min value of the path *)
119
-        let min = get_min_label_from_path graph arcs in
120
-    
121
-        (* Substract the min to every arc of the path *)
122
-        let graph = add_value_to_arcs graph arcs (Float.neg min) in
123
-
124
-
125
-        (* Get the reverse path *)
126
-        let reverse = rev_arcs arcs in
127
-    
128
-        (* Add the min to every arc of the reverse path *)
129
-        let graph = add_value_to_arcs graph reverse min in
130
-    
131
-        (* Add the min to the flow *) 
132
-        let flow = Float.add flow min in
133
-        boucle graph origin sink flow) in
134
-  let (maxFlow, residualGraph) = boucle graph origin sink flow in
135
-  let finalGraph = get_final_graph initGraph residualGraph in 
136
-  (maxFlow, finalGraph) 
137
-  

+ 0
- 20
medium_project/src/FFAlgorithm.mli View File

@@ -1,20 +0,0 @@
1
-open Graph
2
-open Tool
3
-open BLF
4
-
5
-
6
-val g_to_float: string graph -> float graph
7
-
8
-val ford_fulk_algorithm : float graph -> id -> id -> (float * string graph)
9
-
10
-(* val g_to_string: float graph -> string graph *)
11
-
12
-(* val only_one_edge: float graph -> float graph *)
13
-
14
-(* for testing purpose *)
15
-
16
-(* val rev_arcs: (id * id) list -> (id * id) list
17
-
18
-val add_value_to_arcs: float graph -> (id * id) list -> float -> float graph
19
-
20
-val get_final_graph: float graph -> float graph -> string graph *)

+ 0
- 48
medium_project/src/MSftest.ml View File

@@ -1,48 +0,0 @@
1
-open MSgfile
2
-open Tool
3
-open FFAlgorithm
4
-open BLF
5
-open Format
6
-open Sys
7
-
8
-let () =
9
- 
10
-  (*/!\ Format de la commande pour lancer le test : 
11
-        ./ftest.native [nom_fichier_lecture] [id_source] [id_dest] [nom_fichier_ecriture]
12
-   ex : ./ftest.native graphs/graph1 0 5 graphs/graph3 *)
13
-
14
-  (* Check the number of command-line arguments *)
15
-  if Array.length Sys.argv <> 5 then
16
-    begin
17
-      Printf.printf "\nUsage: %s infile source sink outfile\n\n%!" Sys.argv.(0) ;
18
-      exit 0
19
-    end ;
20
-
21
-
22
-  (* Arguments are : infile(1) source-id(2) sink-id(3) outfile(4) *)
23
-
24
-  let infile = Sys.argv.(1)
25
-  and outfile = Sys.argv.(4)
26
-
27
-  (* These command-line arguments are not used for the moment. *)
28
-  and _source = int_of_string Sys.argv.(2)
29
-  and _sink = int_of_string Sys.argv.(3)
30
-  in
31
-
32
-  (* Open file *)
33
-  let (graph, l_id) = from_file infile in
34
-  let initGraph = graph in
35
-
36
-  (* Rewrite the graph that has been read. *)
37
- 
38
-  let (flow,finalGraph) = ford_fulk_algorithm initGraph _source _sink in
39
-  let () = printf "max flow = %f\n" flow in
40
-  let () = write_file outfile finalGraph l_id in
41
-  let () = export outfile finalGraph in
42
-  (* let () = export infile graph in *)
43
-
44
-  
45
-  (*Uncomment the following line if you have graphviz installed  *)
46
-  (*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in*)
47
-  ()
48
-

+ 0
- 113
medium_project/src/MSgfile.ml View File

@@ -1,113 +0,0 @@
1
-open Graph
2
-open Printf
3
-open MoneySharing
4
-
5
-type path = string
6
-
7
-(* Format of text files:
8
-   % Welcome to MoneySharing, your favorite tool to ease your reimbursements !
9
-
10
-   % Please, type the name of all users of your group:
11
-   u Gaby
12
-   u Flo
13
-   u Macha
14
-
15
-   % You can now enter your payements as it follows: p userWhoPaid [forWhichUser1; forWhichUser2 ..] amount
16
-   p Flo Gaby,Flo,Macha 11.0
17
-   p Gaby Flo 8.5
18
-
19
-*)
20
-
21
-
22
-let write_file path graph l_id=
23
-
24
-  (* Open a write-file. *)
25
-  let ff = open_out path in
26
-
27
-  (* Write in this file. *)
28
-  fprintf ff "%% Here is your MoneySharing graph.\n\n" ;
29
-
30
-  (* Write all users *)
31
-  n_iter_sorted graph (fun id -> fprintf ff "u %s\n" (get_user id l_id)) ;
32
-  fprintf ff "\n" ;
33
-
34
-  fprintf ff "%% Here are the reimbursements to be made.\n\n" ;
35
-
36
-  (* Write all arcs *)
37
-  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) ;
38
-
39
-  fprintf ff "\n%% End of reimbursements\n" ;
40
-
41
-  close_out ff ;
42
-  ()
43
-
44
-let read_comment graph line l_id=
45
-  try Scanf.sscanf line " %%" (graph, l_id)
46
-  with _ ->
47
-    Printf.printf "Unknown line:\n%s\n%!" line ;
48
-    failwith "from_file"
49
-
50
-(* Reads a line with a user. *)
51
-let read_user id graph l_id line =
52
-  try Scanf.sscanf line "u %s" (fun user -> init_node graph user id l_id )
53
-  with e ->
54
-    Printf.printf "Cannot read node in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
55
-    failwith "from_file"
56
-
57
-(* Reads a line with a payement. *)
58
-let read_payement graph l_id line =
59
-  try Scanf.sscanf line "p %s %s %f"
60
-        (fun user l_user label -> paiement graph user (String.split_on_char ',' l_user) label l_id)
61
-  with e ->
62
-    Printf.printf "Cannot read arc in line - %s:\n%s\n%!" (Printexc.to_string e) line ;
63
-    failwith "from_file"
64
-
65
-let from_file path =
66
-
67
-  let infile = open_in path in
68
-
69
-  (* Read all lines until end of file. 
70
-   * n is the current node counter. *)
71
-  let rec loop n graph l_id=
72
-    try
73
-      let line = input_line infile in 
74
-
75
-      (* Remove leading and trailing spaces. *)
76
-      let line = String.trim line in
77
-
78
-      let (n2, (graph2, l2)) =
79
-        (* Ignore empty lines *)
80
-        if line = "" then (n, (graph, l_id))
81
-
82
-        (* The first character of a line determines its content : u or p. *)
83
-        else match line.[0] with
84
-          | 'u' -> (n+1, read_user n graph l_id line)
85
-          | 'p' -> (n, read_payement graph l_id line)
86
-
87
-          (* It should be a comment, otherwise we complain. *)
88
-          | _ -> (n, read_comment graph line l_id)
89
-      in      
90
-      loop n2 graph2 l2
91
-
92
-    with End_of_file -> (graph, l_id) (* Done *)
93
-  in
94
-  let final_graph_lid= loop 0 empty_graph [] in
95
-
96
-  close_in infile ;
97
-  final_graph_lid
98
-
99
-(* Write the graph in a .dot file*)
100
-let export path graph =
101
-  (* Open a write-file. *)
102
-  let ff = open_out (path^".dot") in
103
-
104
-  (* Write in this file. *)
105
-  fprintf ff "digraph graphique1 {\n\tsize=\"20\"\n\tnode [shape = circle];\n";
106
-
107
-  (* Write all arcs *)
108
-  e_iter graph (fun id1 id2 lbl -> fprintf ff "\t%d -> %d [ label = \"%s\" ];\n" id1 id2 lbl) ;
109
-
110
-  fprintf ff "}\n" ;
111
-
112
-  close_out ff ;
113
-  ()

+ 0
- 10
medium_project/src/MSgfile.mli View File

@@ -1,10 +0,0 @@
1
-open Graph
2
-
3
-type path = string
4
-
5
-val from_file: path -> (float graph * (string * id * float) list)
6
-
7
-val write_file: path -> string graph -> (string * id * float) list -> unit
8
-
9
-val export: path -> string graph -> unit
10
-

+ 0
- 49
medium_project/src/graph.ml View File

@@ -1,49 +0,0 @@
1
-type id = int
2
-
3
-type 'a out_arcs = (id * 'a) list
4
-
5
-(* A graph is just a list of pairs: a node & its outgoing arcs. *)
6
-type 'a graph = (id * 'a out_arcs) list
7
-
8
-exception Graph_error of string
9
-
10
-let empty_graph = []
11
-
12
-let node_exists gr id = List.mem_assoc id gr
13
-
14
-let out_arcs gr id =
15
-  try List.assoc id gr
16
-  with Not_found -> raise (Graph_error ("Node " ^ string_of_int id ^ " does not exist in this graph."))
17
-
18
-let find_arc gr id1 id2 =
19
-  let out = out_arcs gr id1 in
20
-  try Some (List.assoc id2 out)
21
-  with Not_found -> None
22
-
23
-let new_node gr id =
24
-  if node_exists gr id then raise (Graph_error ("Node " ^ string_of_int id ^ " already exists in the graph."))
25
-  else (id, []) :: gr
26
-
27
-let new_arc gr id1 id2 lbl =
28
-
29
-  (* Existing out-arcs *)
30
-  let outa = out_arcs gr id1 in
31
-
32
-  (* Update out-arcs.
33
-   * remove_assoc does not fail if id2 is not bound.  *)
34
-  let outb = (id2, lbl) :: List.remove_assoc id2 outa in
35
-
36
-  (* Replace out-arcs in the graph. *)
37
-  let gr2 = List.remove_assoc id1 gr in
38
-  (id1, outb) :: gr2
39
-
40
-let n_iter gr f = List.iter (fun (id, _) -> f id) gr
41
-
42
-let n_iter_sorted gr f = n_iter (List.sort compare gr) f
43
-
44
-let n_fold gr f acu = List.fold_left (fun acu (id, _) -> f acu id) acu gr
45
-
46
-let e_iter gr f = List.iter (fun (id1, out) -> List.iter (fun (id2, x) -> f id1 id2 x) out) gr
47
-
48
-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
49
-

+ 0
- 63
medium_project/src/graph.mli View File

@@ -1,63 +0,0 @@
1
-
2
-(* Type of a directed graph in which arcs have labels of type 'a. *)
3
-type 'a graph
4
-
5
-(* Each node has a unique identifier (a number). *)
6
-type id = int
7
-
8
-exception Graph_error of string
9
-
10
-
11
-(**************  CONSTRUCTORS  **************)
12
-
13
-(* The empty graph. *)
14
-val empty_graph: 'a graph
15
-
16
-(* Add a new node with the given identifier.
17
- * @raise Graph_error if the id already exists. *)
18
-val new_node: 'a graph -> id -> 'a graph
19
-
20
-(* new_arc gr id1 id2 lbl  : adds an arc from node id1 to node id2 with label lbl
21
- * Both nodes must already exist in the graph.
22
- * If the arc already exists, its label is replaced by lbl. 
23
- * @raise Graph_error if node id1 or id2 does not exist in the graph. *)
24
-val new_arc: 'a graph -> id -> id -> 'a -> 'a graph
25
-
26
-
27
-(**************  GETTERS  *****************)
28
-
29
-(* node_exists gr id  indicates if the node with identifier id exists in graph gr. *)
30
-val node_exists: 'a graph -> id -> bool
31
-
32
-(* Type of lists of outgoing arcs of a node. 
33
- * An arc is represented by a pair of the destination identifier and the arc label. *)
34
-type 'a out_arcs = (id * 'a) list
35
-
36
-(* Find the out_arcs of a node.
37
- * @raise Graph_error if the id is unknown in the graph. *)
38
-val out_arcs: 'a graph -> id -> 'a out_arcs
39
-
40
-(* find_arc gr id1 id2  finds an arc between id1 and id2 and returns its label. Returns None if the arc does not exist. 
41
- * @raise Graph_error if id1 is unknown. *)
42
-val find_arc: 'a graph -> id -> id -> 'a option
43
-
44
-
45
-(**************  COMBINATORS, ITERATORS  **************)
46
-
47
-(* Iterate on all nodes, in no special order. *)
48
-val n_iter: 'a graph -> (id -> unit) -> unit
49
-
50
-(* Like n_iter, but the nodes are sorted. *)
51
-val n_iter_sorted: 'a graph -> (id -> unit) -> unit
52
-
53
-(* Fold on all (unsorted) nodes. You must remember what List.fold_left does. *)
54
-val n_fold: 'a graph -> ('b -> id -> 'b) -> 'b -> 'b
55
-
56
-
57
-(* Iter on all arcs (edges) *)
58
-val e_iter: 'a graph -> (id -> id -> 'a -> unit) -> unit
59
-
60
-(* Fold on all arcs (edges) *)
61
-val e_fold: 'a graph -> ('b -> id -> id -> 'a -> 'b) -> 'b -> 'b
62
-
63
-

+ 0
- 41
medium_project/src/moneySharing.ml View File

@@ -1,41 +0,0 @@
1
-open Graph
2
-open Tool
3
-
4
-
5
-(*fonction qui créé le noeud associé à un utilisateur et rentre la correspondance dans la table des id*)
6
-let init_node g user id l_id=
7
-    ( (new_node g id), ((user,id,0.0)::l_id) )
8
-
9
-
10
-(*fonction qui renvoie l'id d'un utilisateur*)   
11
-let rec get_id utilisateur l_id= match l_id with   
12
-    |[]-> raise Not_found
13
-    |(a,id1,value)::b-> if a=utilisateur then id1 else get_id utilisateur b
14
-
15
-(*fonction qui renvoie le nom correspondant à un id*)   
16
-let rec get_user id1 l_id= match l_id with   
17
-    |[]-> raise Not_found
18
-    |(nom,a,value)::b-> if a=id1 then nom else get_user id1 b
19
-
20
-let set_val_du a l_id montant l_utilisateurs=
21
-    List.map (fun (nom,id,value)-> if nom=a 
22
-                                 then (nom,id,(Float.sub value (Float.div montant (Float.of_int(List.length l_utilisateurs)))))
23
-                                 else (nom,id,value)
24
-             ) l_id
25
-
26
-let set_val_pret utilisateur montant l_id= 
27
-    List.map (fun (nom,id,value)-> if nom=utilisateur 
28
-                                 then (nom,id,(Float.add value montant))
29
-                                 else (nom,id,value)
30
-             ) l_id
31
-    
32
-(*fonction qui rentre les paiements réalisés*)
33
-let paiement g utilisateur l_utilisateurs montant l_id= 
34
-    let rec paye g utilisateur l_utilisateurs montant l_id=match l_utilisateurs with
35
-        |[]-> (g, l_id)
36
-        |a::b-> paye g utilisateur b montant (set_val_du a l_id montant l_utilisateurs) in
37
-        let l_id= set_val_pret utilisateur montant l_id in
38
-            paye g utilisateur l_utilisateurs montant l_id
39
-
40
-
41
-

+ 0
- 13
medium_project/src/moneySharing.mli View File

@@ -1,13 +0,0 @@
1
-open Graph
2
-
3
-val paiement: float graph -> string -> string list -> float -> (string * id * float) list -> (float graph * (string * id * float) list)
4
-
5
-val init_node: float graph -> string -> id -> (string * id * float) list-> (float graph * (string * id * float) list)
6
-
7
-val get_id: string -> (string * id * float) list -> id
8
-
9
-val get_user: id -> (string * id * float) list -> string
10
-
11
-val set_val_du: string -> (string * id * float) list -> float -> string list -> (string * id * float) list
12
-
13
-val set_val_pret: string -> float -> (string * id * float) list -> (string * id * float) list

+ 0
- 19
medium_project/src/tool.ml View File

@@ -1,19 +0,0 @@
1
-(* Yes, we have to repeat open Graph. *)
2
-open Graph
3
-
4
-(* assert false is of type ∀α.α, so the type-checker is happy. *)
5
-
6
-
7
-let clone_nodes gr = n_fold gr new_node empty_graph 
8
-
9
-
10
-(* Clone the nodes first then clone every arc but change their label by applying f*)
11
-let gmap gr f = 
12
-  let new_graph = clone_nodes gr in
13
-  e_fold gr (fun acu id1 id2 x -> new_arc acu id1 id2 (f x)) new_graph 
14
-
15
-let add_arc g id1 id2 n =
16
-    let f = find_arc g id1 id2  in
17
-    match f with
18
-    |None->new_arc g id1 id2 n
19
-    |Some x->new_arc g id1 id2 (Float.add n x)

+ 0
- 9
medium_project/src/tool.mli View File

@@ -1,9 +0,0 @@
1
-open Graph
2
-
3
-(* Clone a graph by keeping only its nodes *)
4
-val clone_nodes: 'a graph -> 'b graph
5
-
6
-(* Apply a function f to every label of the graph's arcs *)
7
-val gmap: 'a graph -> ('a -> 'b) -> 'b graph
8
-
9
-val add_arc: float graph -> id -> id -> float -> float graph

Loading…
Cancel
Save