nettoyage
This commit is contained in:
джерело
d2f77bcfa2
коміт
4ba9d5239b
35 змінених файлів з 0 додано та 1473 видалено
|
|
@ -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
|
|
||||||
|
|
@ -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`).
|
|
||||||
|
|
||||||
|
|
@ -1,3 +0,0 @@
|
||||||
<src/**>: include
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -1,106 +0,0 @@
|
||||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
|
||||||
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"
|
|
||||||
"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd" [
|
|
||||||
<!ATTLIST svg xmlns:xlink CDATA #FIXED "http://www.w3.org/1999/xlink">
|
|
||||||
]>
|
|
||||||
<!-- Generated by dot version 2.7.20060111.0540 (Fri Sep 3 08:16:42 UTC 2010)
|
|
||||||
For user: (lebotlan) D. Le Botlan,,, -->
|
|
||||||
<!-- Title: finite_state_machine Pages: 1 -->
|
|
||||||
<svg width="689px" height="302px"
|
|
||||||
viewBox = "0 0 517 227"
|
|
||||||
xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
|
|
||||||
<g id="graph0" class="graph" style="font-family:Times-Roman;font-size:14.00;">
|
|
||||||
<title>finite_state_machine</title>
|
|
||||||
<polygon style="fill:white;stroke:white;" points="0,227 0,-11 528,-11 528,227 0,227"/>
|
|
||||||
<!-- 0 -->
|
|
||||||
<g id="node1" class="node"><title>0</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="29" cy="112" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="29" y="119">0</text>
|
|
||||||
</g>
|
|
||||||
<!-- 2 -->
|
|
||||||
<g id="node3" class="node"><title>2</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="259" cy="43" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="259" y="50">2</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->2 -->
|
|
||||||
<g id="edge2" class="edge"><title>0->2</title>
|
|
||||||
<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"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="221,39 235,44 221,48 221,39"/>
|
|
||||||
<text text-anchor="middle" x="144" y="52">8</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3 -->
|
|
||||||
<g id="node5" class="node"><title>3</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="144" cy="112" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="144" y="119">3</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->3 -->
|
|
||||||
<g id="edge4" class="edge"><title>0->3</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M53,112C69,112 89,112 107,112"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="107,107 120,112 107,116 107,107"/>
|
|
||||||
<text text-anchor="middle" x="87" y="108">10</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1 -->
|
|
||||||
<g id="node7" class="node"><title>1</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="259" cy="191" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="259" y="198">1</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->1 -->
|
|
||||||
<g id="edge6" class="edge"><title>0->1</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M48,127C65,142 93,160 120,170 153,182 192,187 221,188"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="221,184 235,190 221,192 221,184"/>
|
|
||||||
<text text-anchor="middle" x="144" y="162">7</text>
|
|
||||||
</g>
|
|
||||||
<!-- 4 -->
|
|
||||||
<g id="node9" class="node"><title>4</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="373" cy="120" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="373" y="127">4</text>
|
|
||||||
</g>
|
|
||||||
<!-- 2->4 -->
|
|
||||||
<g id="edge8" class="edge"><title>2->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M279,56C296,68 321,86 343,99"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="345,95 353,107 340,103 345,95"/>
|
|
||||||
<text text-anchor="middle" x="316" y="72">12</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->2 -->
|
|
||||||
<g id="edge12" class="edge"><title>3->2</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M165,99C183,90 207,75 225,63"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="224,59 237,55 229,66 224,59"/>
|
|
||||||
<text text-anchor="middle" x="201" y="71">2</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->1 -->
|
|
||||||
<g id="edge14" class="edge"><title>3->1</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M161,128C171,136 181,146 192,152 203,159 215,167 225,172"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="228,168 237,179 224,176 228,168"/>
|
|
||||||
<text text-anchor="middle" x="201" y="148">11</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->4 -->
|
|
||||||
<g id="edge10" class="edge"><title>3->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M168,114C208,115 288,118 336,119"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="336,114 349,119 336,123 336,114"/>
|
|
||||||
<text text-anchor="middle" x="259" y="114">5</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1->4 -->
|
|
||||||
<g id="edge16" class="edge"><title>1->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M280,179C293,171 311,162 325,152 331,150 336,146 343,142"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="340,138 353,135 344,146 340,138"/>
|
|
||||||
<text text-anchor="middle" x="316" y="148">1</text>
|
|
||||||
</g>
|
|
||||||
<!-- 5 -->
|
|
||||||
<g id="node15" class="node"><title>5</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="488" cy="168" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="488" y="175">5</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1->5 -->
|
|
||||||
<g id="edge18" class="edge"><title>1->5</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M283,188C311,186 357,182 397,178 415,175 433,174 451,172"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="451,168 464,171 451,176 451,168"/>
|
|
||||||
<text text-anchor="middle" x="373" y="174">21</text>
|
|
||||||
</g>
|
|
||||||
<!-- 4->5 -->
|
|
||||||
<g id="edge20" class="edge"><title>4->5</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M396,130C412,138 435,147 453,154"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="455,150 465,159 451,158 455,150"/>
|
|
||||||
<text text-anchor="middle" x="431" y="138">14</text>
|
|
||||||
</g>
|
|
||||||
</g>
|
|
||||||
</svg>
|
|
||||||
|
Перед Ширина: | Висота: | Розмір: 4,8 КіБ |
|
|
@ -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
|
|
||||||
|
|
@ -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)<blf_tab.(id).cout then
|
|
||||||
begin
|
|
||||||
blf_tab.(id).cout<-(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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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)
|
|
||||||
|
|
||||||
|
|
@ -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 *)
|
|
||||||
|
|
@ -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*)
|
|
||||||
()
|
|
||||||
|
|
||||||
|
|
@ -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 ;
|
|
||||||
()
|
|
||||||
|
|
@ -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
|
|
||||||
*)
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -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)
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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`).
|
|
||||||
|
|
||||||
|
|
@ -1,3 +0,0 @@
|
||||||
<src/**>: include
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -1,106 +0,0 @@
|
||||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
|
||||||
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"
|
|
||||||
"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd" [
|
|
||||||
<!ATTLIST svg xmlns:xlink CDATA #FIXED "http://www.w3.org/1999/xlink">
|
|
||||||
]>
|
|
||||||
<!-- Generated by dot version 2.7.20060111.0540 (Fri Sep 3 08:16:42 UTC 2010)
|
|
||||||
For user: (lebotlan) D. Le Botlan,,, -->
|
|
||||||
<!-- Title: finite_state_machine Pages: 1 -->
|
|
||||||
<svg width="689px" height="302px"
|
|
||||||
viewBox = "0 0 517 227"
|
|
||||||
xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
|
|
||||||
<g id="graph0" class="graph" style="font-family:Times-Roman;font-size:14.00;">
|
|
||||||
<title>finite_state_machine</title>
|
|
||||||
<polygon style="fill:white;stroke:white;" points="0,227 0,-11 528,-11 528,227 0,227"/>
|
|
||||||
<!-- 0 -->
|
|
||||||
<g id="node1" class="node"><title>0</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="29" cy="112" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="29" y="119">0</text>
|
|
||||||
</g>
|
|
||||||
<!-- 2 -->
|
|
||||||
<g id="node3" class="node"><title>2</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="259" cy="43" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="259" y="50">2</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->2 -->
|
|
||||||
<g id="edge2" class="edge"><title>0->2</title>
|
|
||||||
<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"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="221,39 235,44 221,48 221,39"/>
|
|
||||||
<text text-anchor="middle" x="144" y="52">8</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3 -->
|
|
||||||
<g id="node5" class="node"><title>3</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="144" cy="112" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="144" y="119">3</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->3 -->
|
|
||||||
<g id="edge4" class="edge"><title>0->3</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M53,112C69,112 89,112 107,112"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="107,107 120,112 107,116 107,107"/>
|
|
||||||
<text text-anchor="middle" x="87" y="108">10</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1 -->
|
|
||||||
<g id="node7" class="node"><title>1</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="259" cy="191" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="259" y="198">1</text>
|
|
||||||
</g>
|
|
||||||
<!-- 0->1 -->
|
|
||||||
<g id="edge6" class="edge"><title>0->1</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M48,127C65,142 93,160 120,170 153,182 192,187 221,188"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="221,184 235,190 221,192 221,184"/>
|
|
||||||
<text text-anchor="middle" x="144" y="162">7</text>
|
|
||||||
</g>
|
|
||||||
<!-- 4 -->
|
|
||||||
<g id="node9" class="node"><title>4</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="373" cy="120" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="373" y="127">4</text>
|
|
||||||
</g>
|
|
||||||
<!-- 2->4 -->
|
|
||||||
<g id="edge8" class="edge"><title>2->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M279,56C296,68 321,86 343,99"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="345,95 353,107 340,103 345,95"/>
|
|
||||||
<text text-anchor="middle" x="316" y="72">12</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->2 -->
|
|
||||||
<g id="edge12" class="edge"><title>3->2</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M165,99C183,90 207,75 225,63"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="224,59 237,55 229,66 224,59"/>
|
|
||||||
<text text-anchor="middle" x="201" y="71">2</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->1 -->
|
|
||||||
<g id="edge14" class="edge"><title>3->1</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M161,128C171,136 181,146 192,152 203,159 215,167 225,172"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="228,168 237,179 224,176 228,168"/>
|
|
||||||
<text text-anchor="middle" x="201" y="148">11</text>
|
|
||||||
</g>
|
|
||||||
<!-- 3->4 -->
|
|
||||||
<g id="edge10" class="edge"><title>3->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M168,114C208,115 288,118 336,119"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="336,114 349,119 336,123 336,114"/>
|
|
||||||
<text text-anchor="middle" x="259" y="114">5</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1->4 -->
|
|
||||||
<g id="edge16" class="edge"><title>1->4</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M280,179C293,171 311,162 325,152 331,150 336,146 343,142"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="340,138 353,135 344,146 340,138"/>
|
|
||||||
<text text-anchor="middle" x="316" y="148">1</text>
|
|
||||||
</g>
|
|
||||||
<!-- 5 -->
|
|
||||||
<g id="node15" class="node"><title>5</title>
|
|
||||||
<ellipse style="fill:none;stroke:black;" cx="488" cy="168" rx="18" ry="18"/>
|
|
||||||
<text text-anchor="middle" x="488" y="175">5</text>
|
|
||||||
</g>
|
|
||||||
<!-- 1->5 -->
|
|
||||||
<g id="edge18" class="edge"><title>1->5</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M283,188C311,186 357,182 397,178 415,175 433,174 451,172"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="451,168 464,171 451,176 451,168"/>
|
|
||||||
<text text-anchor="middle" x="373" y="174">21</text>
|
|
||||||
</g>
|
|
||||||
<!-- 4->5 -->
|
|
||||||
<g id="edge20" class="edge"><title>4->5</title>
|
|
||||||
<path style="fill:none;stroke:black;" d="M396,130C412,138 435,147 453,154"/>
|
|
||||||
<polygon style="fill:black;stroke:black;" points="455,150 465,159 451,158 455,150"/>
|
|
||||||
<text text-anchor="middle" x="431" y="138">14</text>
|
|
||||||
</g>
|
|
||||||
</g>
|
|
||||||
</svg>
|
|
||||||
|
Перед Ширина: | Висота: | Розмір: 4,8 КіБ |
|
|
@ -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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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)
|
|
||||||
|
|
||||||
|
|
@ -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 *)
|
|
||||||
|
|
@ -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*)
|
|
||||||
()
|
|
||||||
|
|
||||||
|
|
@ -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 ;
|
|
||||||
()
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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)
|
|
||||||
|
|
@ -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
|
|
||||||
Завантаження…
Посилання в новій задачі