basic and advanced bipartite matching working
This commit is contained in:
parent
e3d6967d6b
commit
33181d550a
22 changed files with 643 additions and 392 deletions
20
Makefile
20
Makefile
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
build:
|
||||
@echo "\n==== COMPILING ====\n"
|
||||
ocamlbuild MSftest.native
|
||||
ocamlbuild ftest_advanced.native
|
||||
|
||||
format:
|
||||
ocp-indent --inplace src/*
|
||||
|
|
@ -9,6 +9,14 @@ format:
|
|||
edit:
|
||||
code . -n
|
||||
|
||||
basic:
|
||||
@echo "\n==== COMPILING ====\n"
|
||||
ocamlbuild ftest_basic.native
|
||||
|
||||
advanced:
|
||||
@echo "\n==== COMPILING ====\n"
|
||||
ocamlbuild ftest_advanced.native
|
||||
|
||||
demo: build
|
||||
@echo "\n==== EXECUTING ====\n"
|
||||
./ftest.native graphs/graph1 1 2 outfile
|
||||
|
|
@ -17,4 +25,12 @@ demo: build
|
|||
|
||||
clean:
|
||||
-rm -rf _build/
|
||||
-rm MSftest.native
|
||||
-rm ftest_advanced.native
|
||||
|
||||
clean_basic:
|
||||
-rm -rf _build/
|
||||
-rm ftest_basic.native
|
||||
|
||||
clean_advanced:
|
||||
-rm -rf _build/
|
||||
-rm ftest_advanced.native
|
||||
|
|
|
|||
|
|
@ -2,11 +2,19 @@
|
|||
|
||||
%% Nodes
|
||||
|
||||
u Gaby
|
||||
u Flo
|
||||
u Macha
|
||||
n 1 1
|
||||
n 2 2
|
||||
n 3 3
|
||||
n 4 4
|
||||
n 5 5
|
||||
|
||||
%% format to test basic program :
|
||||
%% e id1 id2 cost capacity
|
||||
e 1 2 7 30
|
||||
e 1 3 6 20
|
||||
e 2 3 5 25
|
||||
e 2 4 4 10
|
||||
e 3 4 2 20
|
||||
e 3 5 2 25
|
||||
e 4 5 1 20
|
||||
|
||||
p Flo -> Gaby,Flo,Macha : 30.0€
|
||||
p Gaby -> Gaby,Flo : 20.0€
|
||||
p Macha -> Gaby,Macha : 20.0€
|
||||
17
graphs/graph2
Normal file
17
graphs/graph2
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
|
||||
%%
|
||||
|
||||
s a,b,c,d,e,f
|
||||
s j1,j2,j3,j4,j5,j6
|
||||
|
||||
%% preferences' format : p x -> y : pref n°Z
|
||||
%% (Z from 1 to size of the second set (|S2|) )
|
||||
|
||||
p a -> j2 : pref n°1
|
||||
p a -> j3 : pref n°2
|
||||
p c -> j1 : pref n°1
|
||||
p c -> j4 : pref n°2
|
||||
p d -> j3 : pref n°1
|
||||
p e -> j3 : pref n°1
|
||||
p e -> j4 : pref n°2
|
||||
p f -> j6 : pref n°1
|
||||
130
src/BGAlgorithm.ml
Normal file
130
src/BGAlgorithm.ml
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
open Graph
|
||||
open Tool
|
||||
open BLF
|
||||
|
||||
let g_to_string gr = gmap gr (fun (a,b) -> (string_of_int a, string_of_int b) )
|
||||
let g_to_int gr = gmap gr (fun (a,b) -> (int_of_string a, int_of_string b) )
|
||||
|
||||
|
||||
(* 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 capacity of a path's edge*)
|
||||
let get_min_capa_from_path (graph : (int * int) graph) (path : (id * id) list) =
|
||||
let min = 999999999 in
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
let label = ( match find_arc graph id1 id2 with
|
||||
|None -> 999999999
|
||||
|Some (_,capa) -> capa) in
|
||||
if label < acu then label else acu
|
||||
) min path
|
||||
|
||||
(* Return the total cost of a path in the graph*)
|
||||
let get_cost_from_path (graph : (int * int) graph) (path : (id * id) list) =
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
match find_arc graph id1 id2 with
|
||||
|None -> acu
|
||||
|Some (cost,_) -> acu + cost
|
||||
) 0 path
|
||||
|
||||
(* Add a value to the capacity of every egde of a path in the graph*)
|
||||
let add_capa_to_arcs (graph : (int * int) graph) (path : (id * id) list) (capa : int) =
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
add_capa acu id1 id2 capa
|
||||
)
|
||||
graph path
|
||||
|
||||
(* Add a value to every egde of a path *)
|
||||
let add_cost_to_arcs (graph : (int * int) graph) (path : (id * id) list) (min : int)=
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
let (cost,capa)=match find_arc graph id1 id2 with
|
||||
|None -> raise Not_found
|
||||
|Some (cost,capa)->(cost,capa) in
|
||||
new_arc acu id2 id1 (Int.neg cost,Int.add min capa)
|
||||
)
|
||||
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 "flow:x" where x
|
||||
is the value of the flow of the opposite arc in the residual graph*)
|
||||
let get_final_graph (initGraph : (int * int) graph) (residualGraph : (int * int) graph) =
|
||||
|
||||
(* First get the initial and residual graph as string graphs *)
|
||||
let finalGraph = clone_nodes initGraph in
|
||||
|
||||
(* For every arc in the initial graph 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 (cost,"flow:x"),
|
||||
(cost,"flow:0") otherwise*)
|
||||
e_fold initGraph
|
||||
(
|
||||
fun acu id1 id2 (cost_x,capa_x) ->
|
||||
let label_rev_arc = match find_arc residualGraph id2 id1 with
|
||||
|None -> 0
|
||||
|Some (cost_x,capa_x) -> (match find_arc initGraph id2 id1 with
|
||||
|None -> capa_x
|
||||
|Some (cost_y, capa_y) -> Int.sub capa_x capa_y ) in
|
||||
let label_rev_arc = if (label_rev_arc > 0) then "flow:"^(string_of_int label_rev_arc) else "flow:0" in
|
||||
new_arc acu id1 id2 ((string_of_int cost_x), label_rev_arc)
|
||||
)
|
||||
finalGraph
|
||||
|
||||
|
||||
let busacker_gowen_algorithm (graph : (int * int) graph) (origin : id) (sink : id) =
|
||||
let flow = 0 in
|
||||
let totalCost = 0 in
|
||||
|
||||
let initGraph = graph in
|
||||
let rec boucle graph origin sink flow totalCost =
|
||||
|
||||
let path = get_path graph origin sink in
|
||||
match path with
|
||||
|None -> (flow, totalCost, graph)
|
||||
|Some x -> begin
|
||||
let path = x in
|
||||
let arcs = create_arcs_from_nodes path in
|
||||
|
||||
(* Find the min capacity of the path *)
|
||||
let minPath = get_min_capa_from_path graph arcs in
|
||||
let costPath = get_cost_from_path graph arcs in
|
||||
|
||||
(* Substract the min capacity to every arc of the path *)
|
||||
let graph = add_capa_to_arcs graph arcs (Int.neg minPath) in
|
||||
|
||||
(* Get the reverse path *)
|
||||
|
||||
(* Add the cost to every arc of the reverse path *)
|
||||
(*blf prend chemin seulement si capa non saturé, donc dans tous les cas on met un arc inverse avec -cout et un arc normal avec +cout*)
|
||||
let graph = add_cost_to_arcs graph arcs minPath in
|
||||
|
||||
(* Add the min to the flow *)
|
||||
let flow = Int.add flow minPath in
|
||||
let totalCost = Int.add totalCost (costPath * minPath) in
|
||||
|
||||
boucle graph origin sink flow totalCost
|
||||
end in
|
||||
|
||||
let (maxFlow, totalCost, residualGraph) = boucle graph origin sink flow totalCost in
|
||||
|
||||
let finalGraph = get_final_graph initGraph residualGraph in
|
||||
(maxFlow, totalCost , finalGraph)
|
||||
9
src/BGAlgorithm.mli
Normal file
9
src/BGAlgorithm.mli
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
open Graph
|
||||
open Tool
|
||||
open BLF
|
||||
|
||||
(* Return a (int * int) graph from a (string * string) graph *)
|
||||
val g_to_int: (string * string) graph -> (int * int) graph
|
||||
|
||||
(* Return a (string * string) graph after applying the busacker-gowen algorithm on a (int * int) graph (cost, capacity)*)
|
||||
val busacker_gowen_algorithm : (int * int) graph -> id -> id -> (int * int * (string * string) graph)
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
open Graph
|
||||
open Printf
|
||||
|
||||
type path = id list
|
||||
|
||||
|
|
@ -8,6 +9,9 @@ type t_cost={
|
|||
mutable father:int
|
||||
}
|
||||
|
||||
let print_t_cost t_cost =
|
||||
printf "cout=%d, pere=%d\n" t_cost.cout t_cost.father
|
||||
|
||||
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
|
||||
|
|
@ -29,6 +33,7 @@ let blf gr id_src id_dest=
|
|||
match l_out_arc with
|
||||
|[]-> blf_rec gr file (a::file_marque)
|
||||
|(id,(lcout,lcapa))::d->
|
||||
(*let () = printf "id=%d, cout=%d, capacite=%d\n" id lcout lcapa in*)
|
||||
if lcapa <> 0 && (Int.add blf_tab.(a).cout lcout)<(blf_tab.(id).cout) then
|
||||
begin
|
||||
blf_tab.(id).cout<-(Int.add blf_tab.(a).cout lcout);
|
||||
|
|
@ -42,6 +47,7 @@ let blf gr id_src id_dest=
|
|||
(*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 () = Array.iter (print_t_cost) blf_tab 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
|
||||
|
|
|
|||
120
src/BPgfile.ml
Normal file
120
src/BPgfile.ml
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
open Graph
|
||||
open Printf
|
||||
open Bp
|
||||
open Str
|
||||
|
||||
type path = string
|
||||
|
||||
(* Format of text files:
|
||||
%
|
||||
|
||||
%
|
||||
s a,b,c,d,e,f
|
||||
s j1,j2,j3,j4,j5,j6
|
||||
|
||||
%
|
||||
p a -> j2 : pref n°1
|
||||
p a -> j3 : pref n°1
|
||||
p c -> j1 : pref n°1
|
||||
p c -> j4 : pref n°1
|
||||
p d -> j3 : pref n°1
|
||||
p e -> j3 : pref n°1
|
||||
p e -> j4 : pref n°1
|
||||
p f -> j6 : pref n°1
|
||||
|
||||
*)
|
||||
|
||||
|
||||
let write_file (path : path) (graph: 'a graph) (lId : (string * id * int) list) =
|
||||
|
||||
(* Open a write-file. *)
|
||||
let ff = open_out path in
|
||||
|
||||
fprintf ff "%% Matching results :\n\n" ;
|
||||
|
||||
(* Write all arcs *)
|
||||
e_iter graph (fun id1 id2 lbl -> fprintf ff " %s -> %s \n"(get_nodeName id1 lId) (get_nodeName id2 lId)) ;
|
||||
|
||||
close_out ff ;
|
||||
()
|
||||
|
||||
|
||||
let read_comment graph line =
|
||||
try Scanf.sscanf line " %%" graph
|
||||
with _ ->
|
||||
Printf.printf "Unknown line:\n%s\n%!" line ;
|
||||
failwith "from_file"
|
||||
|
||||
(* Reads a line with a user. *)
|
||||
let read_set graph id lId setNumber line =
|
||||
(* let regexSplit = Str.regexp "(\\[|,|\\])" in *)
|
||||
try Scanf.sscanf line "s %s" (fun set -> set_lNodes graph (String.split_on_char ',' set) id lId setNumber )
|
||||
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_preference graph lId line =
|
||||
try Scanf.sscanf line "p %s -> %s : pref n°%s"
|
||||
(fun nodeSet1 nodeSet2 weight -> set_preference graph nodeSet1 nodeSet2 weight lId)
|
||||
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 lId setNumber=
|
||||
try
|
||||
let line = input_line infile in
|
||||
|
||||
(* Remove leading and trailing spaces. *)
|
||||
let line = String.trim line in
|
||||
|
||||
let ((n2, graph2, l2) , setNumber2) =
|
||||
(* Ignore empty lines *)
|
||||
if line = "" then ((n, graph, lId), setNumber)
|
||||
|
||||
(* The first character of a line determines its content : u or p. *)
|
||||
else match line.[0] with
|
||||
| 's' -> (read_set graph n lId setNumber line, setNumber+1)
|
||||
| 'p' -> ((n, read_preference graph lId line, lId), 0)
|
||||
|
||||
(* It should be a comment, otherwise we complain. *)
|
||||
| _ -> ((n, read_comment graph line, lId), 1)
|
||||
in
|
||||
loop n2 graph2 l2 setNumber2
|
||||
|
||||
with End_of_file -> (graph, lId) (* Done *)
|
||||
in
|
||||
let (graph, lId) = loop 1 empty_graph [] 1 in
|
||||
|
||||
(* Users with negative balance linked to the origin
|
||||
Users with positive balance linked to sink *)
|
||||
let graph = create_source_sink_and_link graph lId in
|
||||
(* Link users between themselves with *)
|
||||
(*let graph = link_users graph lId in *)
|
||||
close_in infile ;
|
||||
(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 (cout,capa) -> fprintf ff "\t%d -> %d [ label = \"%s, %s\" ];\n" id1 id2 cout capa) ;
|
||||
|
||||
fprintf ff "}\n" ;
|
||||
|
||||
close_out ff ;
|
||||
()
|
||||
17
src/BPgfile.mli
Normal file
17
src/BPgfile.mli
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
open Graph
|
||||
open Printf
|
||||
open Bp
|
||||
open Str
|
||||
|
||||
type path = string
|
||||
|
||||
(* Read a (string * string) graph (cost,capacity) from a path.
|
||||
Return the graph and a (string * id * int) list (name, id, setNumber) *)
|
||||
val from_file: path -> ((string * string) graph * (string * id * int) list)
|
||||
|
||||
(* Write the matching results in the file "path" *)
|
||||
val write_file: path -> 'a graph -> (string * id * int) list -> unit
|
||||
|
||||
(* Export a (string * string) graph (cout,flow) in the file "path".dot *)
|
||||
val export: path -> (string * string) graph -> unit
|
||||
|
||||
|
|
@ -1,121 +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_capa_from_path (graph : (int * int) graph) (path : (id * id) list) =
|
||||
let min = 999999999 in
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
let label = ( match find_arc graph id1 id2 with
|
||||
|None -> 999999999
|
||||
|Some (cout,capa) -> capa) in
|
||||
if label < acu then label else acu
|
||||
) min path
|
||||
|
||||
|
||||
(* Add a value to every egde of a path *)
|
||||
let add_capa_to_arcs (graph : (int * int) graph) (path : (id * id) list) (value : int) =
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
add_arc acu id1 id2 value
|
||||
)
|
||||
graph path
|
||||
|
||||
(* Add a value to every egde of a path *)
|
||||
let add_cost_to_arcs (graph : (int * int) graph) (path : (id * id) list) (min : int)=
|
||||
List.fold_left
|
||||
(
|
||||
fun acu (id1, id2) ->
|
||||
let (cout,capa)=match find_arc graph id1 id2 with
|
||||
|None -> raise Not_Found
|
||||
|Some (cout,capa)->(cout,capa) in
|
||||
new_arc acu id2 id1 (Int.neg cout,Int.add min capa)
|
||||
)
|
||||
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" where x
|
||||
is the value of the opposite arc on the residual graph*)
|
||||
let get_final_graph (initGraph : (int * int) graph) (residualGraph : (int * 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 the label of
|
||||
the opposite arc in the residual graph.
|
||||
If it exists then the arc of the final graph gets the label "x",
|
||||
"0" otherwise*)
|
||||
e_fold initGraph
|
||||
(
|
||||
fun acu id1 id2 (cout_x,capa_x) ->
|
||||
let label_rev_arc = match find_arc residualGraphString id2 id1 with
|
||||
|None -> 0
|
||||
|Some (cout_x,capa_x) -> (match find_arc initGraphString id2 id1 with
|
||||
|None -> capa_x
|
||||
|Some (cout_y, capa_y) -> Int.sub capa_x capa_y ) in
|
||||
let label_rev_arc = if (label_rev_arc > 0) then (string_of_int label_rev_arc) else "capa:0" in
|
||||
new_arc acu id1 id2 ((string_of_int cout_x), label_rev_arc)
|
||||
)
|
||||
finalGraph
|
||||
|
||||
let get_cout_total (residualGraph : (int * int) graph) =
|
||||
e_fold residualGraph (fun acu id1 id2 (l_cout, l_capa) -> if l_cout > 0 then (Int.add acu (Int.mul l_capa l_cout) else acu) 0
|
||||
|
||||
(*ne pas oublier d'afficher le cout*)
|
||||
let ford_fulk_algorithm (graph : (int * 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
|
||||
|
||||
(* Find the min capacity of the path *)
|
||||
let min = get_min_capa_from_path graph arcs in
|
||||
|
||||
(* Substract the min capacity to every arc of the path *)
|
||||
let graph = add_capa_to_arcs graph arcs (Int.neg min) in
|
||||
|
||||
(* Get the reverse path *)
|
||||
(*let reverse = rev_arcs arcs in*)
|
||||
|
||||
(* Add the cost to every arc of the reverse path *)
|
||||
(*blf prend chemin seulement si capa non saturé, donc dans tous les cas on met un arc inverse avec -cout et un arc normal avec +cout*)
|
||||
let graph = add_cost_to_arcs graph arcs min in
|
||||
|
||||
(* Add the min to the flow *)
|
||||
let flow = Int.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
|
||||
let cout_total = get_cout_total residualGraph in
|
||||
(maxFlow, cout_total,finalGraph)
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
open Graph
|
||||
open Tool
|
||||
open BLF
|
||||
|
||||
|
||||
val g_to_int: string graph -> (int * int) graph
|
||||
|
||||
val ford_fulk_algorithm : (int * int) graph -> id -> id -> ((int * int) * string graph)
|
||||
|
||||
(* val only_one_edge: (int * int) graph -> (int * int) graph *)
|
||||
|
||||
(* for testing purpose *)
|
||||
|
||||
(* val rev_arcs: (id * id) list -> (id * id) list
|
||||
|
||||
val add_value_to_arcs: (int * int) graph -> (id * id) list -> (int * int) -> (int * int) graph
|
||||
|
||||
val get_final_graph: (int * int) graph -> (int * int) graph -> string graph *)
|
||||
119
src/MSgfile.ml
119
src/MSgfile.ml
|
|
@ -1,119 +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 (graph, l_id) = loop 1 empty_graph [] in
|
||||
|
||||
(* Users with negative balance linked to the origin
|
||||
Users with positive balance linked to sink *)
|
||||
let graph = set_sink_origin graph l_id in
|
||||
(* Link users between themselves with *)
|
||||
let graph = link_users graph l_id in
|
||||
close_in infile ;
|
||||
(graph, l_id)
|
||||
|
||||
|
||||
(* 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,12 +0,0 @@
|
|||
open Graph
|
||||
open Printf
|
||||
open MoneySharing
|
||||
|
||||
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
|
||||
|
||||
66
src/bp.ml
Normal file
66
src/bp.ml
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
open Graph
|
||||
open Tool
|
||||
|
||||
|
||||
let set_node_get_lId graph nodeName id lId setNumber =
|
||||
let graph = new_node graph id in
|
||||
(graph, (nodeName,id,setNumber)::lId)
|
||||
|
||||
|
||||
let rec set_lNodes graph (lNodes : string list) (id : int) lId setNumber = match lNodes with
|
||||
|[] -> (id, graph, lId)
|
||||
|nodeName :: rest ->
|
||||
begin
|
||||
let (graph, lId) = set_node_get_lId graph nodeName id lId setNumber in
|
||||
set_lNodes graph rest (id+1) lId setNumber
|
||||
end
|
||||
|
||||
|
||||
let rec get_id nodeName lId = match lId with
|
||||
|[]-> raise Not_found
|
||||
|(nom,id,_)::rest-> if nom = nodeName then id else get_id nodeName rest
|
||||
|
||||
|
||||
let rec get_nodeName idNode lId = match lId with
|
||||
|[]-> raise Not_found
|
||||
|(nom,id,_)::rest-> if id = idNode then nom else get_nodeName idNode rest
|
||||
|
||||
let set_preference graph (nodeNameSet1 : string) (nodeNameSet2 : string) (weight : string) (lId : (string * id * int) list) =
|
||||
let idS1 = get_id nodeNameSet1 lId in
|
||||
let idS2 = get_id nodeNameSet2 lId in
|
||||
new_arc graph idS1 idS2 (weight, "1")
|
||||
|
||||
|
||||
let link_node_to_set graph lId nodeId =
|
||||
List.fold_left (
|
||||
fun acu (_,id,setNumber) ->
|
||||
if setNumber = 1
|
||||
then new_arc acu nodeId id ("1", "1")
|
||||
else acu
|
||||
) graph lId
|
||||
|
||||
|
||||
let link_set_to_node graph lId nodeId =
|
||||
List.fold_left (
|
||||
fun acu (_,id,setNumber) ->
|
||||
if setNumber = 2
|
||||
then new_arc acu id nodeId ("1", "1")
|
||||
else acu
|
||||
) graph lId
|
||||
|
||||
|
||||
let create_source_sink_and_link graph lId =
|
||||
let graph = new_node graph 0 in
|
||||
let sinkId = (get_max_id graph)+1 in
|
||||
let graph = new_node graph sinkId in
|
||||
let graph = link_node_to_set graph lId 0 in
|
||||
link_set_to_node graph lId sinkId
|
||||
|
||||
let remove_source_sink_zeroes graph =
|
||||
let max_id = (get_max_id graph) in
|
||||
let trimedGraph = n_fold graph (fun acu id -> if id > 0 && id < max_id then new_node acu id else acu) empty_graph in
|
||||
e_fold graph ( fun acu id1 id2 (cout,capa) ->
|
||||
if capa <> "flow:0" && node_exists acu id1 && node_exists acu id2
|
||||
then new_arc acu id1 id2 (cout,capa)
|
||||
else acu
|
||||
) trimedGraph
|
||||
28
src/bp.mli
Normal file
28
src/bp.mli
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
open Graph
|
||||
open Tool
|
||||
|
||||
(*Context : Maximum bipartite matching. We are trying to match as many element as possible from a first set S1 to a second set S2.
|
||||
S2 elements have a limited capacity (i.e they can only be matched by n elements, most often n < |S1|).
|
||||
We have to take into account S1 elements' preferences. Each one will represent a certain cost so that we can use our max-flow min-cost algorithm*)
|
||||
|
||||
(* Retrieve the id corresponding to a certain nodeName in the (string * id * int) list*)
|
||||
val get_id: string -> (string * id * int) list -> id
|
||||
|
||||
(* Retrieve the nodeName corresponding to a certain id in the (string * id * int) list*)
|
||||
val get_nodeName: id -> (string * id * int) list -> string
|
||||
|
||||
(* Creates n nodes in a (string * string) graph from id to id+n-1.
|
||||
Store the correspondance (nodeName, id, setNumber) in a list.
|
||||
The setNumber will be later used to identify to which set a node belongs*)
|
||||
val set_lNodes : (string * string ) graph -> string list -> id -> (string * id * int) list -> int -> (int * (string * string ) graph * (string * id * int) list )
|
||||
|
||||
(* Creates an arc between two nodes with a certain weight (cost) and a capacity of 1 (weigth, 1) in a (string * string) graph *)
|
||||
val set_preference : (string * string ) graph -> string -> string -> string -> (string * id * int) list -> (string * string ) graph
|
||||
|
||||
(* Creates a source with id=0 and a sink with id=n+1, n number of nodes in the graph.
|
||||
Then creates an arc between the source and every node with setNumber=1
|
||||
and an arc between the sink and every node with setNumber=2*)
|
||||
val create_source_sink_and_link : (string * string ) graph -> (string * id * int) list -> (string * string ) graph
|
||||
|
||||
(* Create a new graph without : the source and its arcs, the sink and its arcs, every arc whose flow=0 *)
|
||||
val remove_source_sink_zeroes : (string * string) graph -> (string * string) graph
|
||||
54
src/ftest_advanced.ml
Normal file
54
src/ftest_advanced.ml
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
open BPgfile
|
||||
open Tool
|
||||
open BGAlgorithm
|
||||
open BLF
|
||||
open Format
|
||||
open Sys
|
||||
open Printf
|
||||
open Bp
|
||||
|
||||
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 <> 3 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)*)
|
||||
|
||||
|
||||
|
||||
let infile = Sys.argv.(1)
|
||||
and outfile = Sys.argv.(2)
|
||||
|
||||
in
|
||||
|
||||
let () = printf "debug args\n" in
|
||||
|
||||
(* These command-line arguments are not used for the moment. *)
|
||||
|
||||
(* Open file *)
|
||||
let (initGraph, lId) = from_file infile in
|
||||
let initGraph = g_to_int initGraph in
|
||||
let idMax = get_max_id initGraph in
|
||||
|
||||
|
||||
let (flow, cost, finalGraph) = busacker_gowen_algorithm initGraph 0 idMax in
|
||||
let finalGraph = remove_source_sink_zeroes finalGraph in
|
||||
let () = printf "max flow = %d, cost = %d\n" flow cost in
|
||||
|
||||
let () = write_file outfile finalGraph lId in
|
||||
let () = export outfile finalGraph in
|
||||
|
||||
|
||||
(*Uncomment the following line if you have graphviz installed *)
|
||||
(*let retour = command ("dot -Tsvg "^outfile^".dot > "^outfile^".svg") in *)
|
||||
()
|
||||
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
open MSgfile
|
||||
open Gfile
|
||||
open Tool
|
||||
open FFAlgorithm
|
||||
open BGAlgorithm
|
||||
open BLF
|
||||
open Format
|
||||
open Sys
|
||||
open MoneySharing
|
||||
open Printf
|
||||
open Bp
|
||||
|
||||
let () =
|
||||
|
||||
|
|
@ -14,7 +14,7 @@ let () =
|
|||
ex : ./ftest.native graphs/graph1 0 5 graphs/graph3 *)
|
||||
|
||||
(* Check the number of command-line arguments *)
|
||||
if Array.length Sys.argv <> 3 then
|
||||
if Array.length Sys.argv <> 5 then
|
||||
begin
|
||||
Printf.printf "\nUsage: %s infile source sink outfile\n\n%!" Sys.argv.(0) ;
|
||||
exit 0
|
||||
|
|
@ -23,23 +23,34 @@ let () =
|
|||
|
||||
(* Arguments are : infile(1) source-id(2) sink-id(3) outfile(4) *)
|
||||
|
||||
|
||||
|
||||
let infile = Sys.argv.(1)
|
||||
and outfile = Sys.argv.(2)
|
||||
|
||||
|
||||
and _source = int_of_string Sys.argv.(3)
|
||||
and _sink = int_of_string Sys.argv.(4)
|
||||
|
||||
in
|
||||
|
||||
let () = printf "debug args\n" in
|
||||
|
||||
(* These command-line arguments are not used for the moment. *)
|
||||
|
||||
(* Open file *)
|
||||
let (initGraph, l_id) = from_file infile in
|
||||
let max_id = get_max_id initGraph in
|
||||
(* let () = export outfile initGraph in *)
|
||||
let initGraph = from_file infile in
|
||||
let () = export outfile initGraph in
|
||||
let initGraph = g_to_int initGraph in
|
||||
|
||||
|
||||
(* Rewrite the graph that has been read. *)
|
||||
|
||||
let (flow,finalGraph) = ford_fulk_algorithm initGraph 0 max_id in
|
||||
let finalGraph = remove_ss_zeroes finalGraph in
|
||||
let () = printf "max flow = %f\n" flow in
|
||||
let () = write_file outfile finalGraph l_id in
|
||||
let (flow, cout, finalGraph) = busacker_gowen_algorithm initGraph _source _sink in
|
||||
(*let finalGraph = remove_ss_zeroes finalGraph in*)
|
||||
let () = printf "max flow = %d, cout = %d\n" flow cout in
|
||||
|
||||
let () = write_file outfile finalGraph in
|
||||
let () = export outfile finalGraph in
|
||||
(* let () = export infile graph in *)
|
||||
|
||||
119
src/gfile.ml
Normal file
119
src/gfile.ml
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
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 (a,b) -> fprintf ff "e %d %d %s %s\n" id1 id2 a b) ;
|
||||
|
||||
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 %s"
|
||||
(fun id1 id2 cout capa -> new_arc (ensure (ensure graph id1) id2) id1 id2 (cout,capa))
|
||||
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 (a,b) -> fprintf ff "\t%d -> %d [ label = \"%s, %s\" ];\n" id1 id2 a b) ;
|
||||
|
||||
fprintf ff "}\n" ;
|
||||
|
||||
close_out ff ;
|
||||
()
|
||||
19
src/gfile.mli
Normal file
19
src/gfile.mli
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
(* 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 * 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 * string) graph -> unit
|
||||
|
||||
val export: path -> (string * 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,80 +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 graph nom id l_id =
|
||||
( (new_node graph id), ((nom,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
|
||||
|(nom,id,_)::rest-> if nom = utilisateur then id else get_id utilisateur rest
|
||||
|
||||
(*fonction qui renvoie le nom correspondant à un id*)
|
||||
let rec get_user id1 l_id = match l_id with
|
||||
|[]-> raise Not_found
|
||||
|(nom,id,_)::rest-> if id = id1 then nom else get_user id1 rest
|
||||
|
||||
let set_val_du utilisateur l_id montant l_utilisateurs =
|
||||
let length = List.length l_utilisateurs in
|
||||
List.map (fun (nom,id,value)-> if nom = utilisateur
|
||||
then (nom,id,(Float.sub value (Float.div montant (Float.of_int(length)))))
|
||||
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 graph utilisateur l_utilisateurs montant l_id =
|
||||
let l_id = set_val_pret utilisateur montant l_id in
|
||||
let length = List.length l_utilisateurs in
|
||||
let l_id = List.map (fun (nom,id,value) -> if List.mem nom l_utilisateurs
|
||||
then (nom,id, (Float.sub value (Float.div montant (Float.of_int(length)))) )
|
||||
else (nom, id, value)
|
||||
) l_id in
|
||||
(graph, l_id)
|
||||
(* let rec paye graph utilisateur l_utilisateurs montant l_id = match l_utilisateurs with
|
||||
|[]-> (graph, l_id)
|
||||
|x::rest -> paye graph utilisateur rest montant (set_val_du x l_id montant l_utilisateurs) in
|
||||
paye graph utilisateur l_utilisateurs montant l_id *)
|
||||
|
||||
|
||||
let link_users_helper graph user_id l_id =
|
||||
List.fold_left (fun acu (nom, id, value) -> if id <> user_id then add_arc acu user_id id 999999999.0 else acu) graph l_id
|
||||
|
||||
let link_users graph l_id =
|
||||
List.fold_left (fun acu (_, id, _) -> (link_users_helper acu id l_id) ) graph l_id
|
||||
|
||||
let link_users_sink_origin graph l_id source sink =
|
||||
List.fold_left (
|
||||
fun acu (_,id,value) ->
|
||||
if value > 0.0 then
|
||||
add_arc acu id sink value
|
||||
else
|
||||
if value < 0.0 then
|
||||
add_arc acu source id (Float.neg value)
|
||||
else acu
|
||||
) graph l_id
|
||||
|
||||
|
||||
let set_sink_origin graph l_id =
|
||||
let graph = new_node graph 0 in
|
||||
let sink_id = (get_max_id graph)+1 in
|
||||
let graph = new_node graph sink_id in
|
||||
link_users_sink_origin graph l_id 0 sink_id
|
||||
|
||||
|
||||
let remove_ss_zeroes graph =
|
||||
let max_id = (get_max_id graph) in
|
||||
let trimedGraph = n_fold graph (fun acu id -> if id > 0 && id < max_id then new_node acu id else acu) empty_graph in
|
||||
e_fold graph ( fun acu id1 id2 label ->
|
||||
if label <> "0" && node_exists acu id1 && node_exists acu id2
|
||||
then new_arc acu id1 id2 label
|
||||
else acu
|
||||
) trimedGraph
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
open Graph
|
||||
open Tool
|
||||
|
||||
|
||||
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 *)
|
||||
|
||||
val link_users : float graph -> (string * id * float) list -> float graph
|
||||
|
||||
val set_sink_origin : float graph -> (string * id * float) list -> float graph
|
||||
|
||||
val remove_ss_zeroes : string graph -> string graph
|
||||
|
|
@ -15,8 +15,8 @@ let gmap gr f =
|
|||
let add_capa g id1 id2 capa =
|
||||
let f = find_arc g id1 id2 in
|
||||
match f with
|
||||
|None->raise Not_Found
|
||||
|None-> raise Not_found
|
||||
|Some (l_cout,l_capa)->new_arc g id1 id2 (l_cout,(Int.add capa l_capa))
|
||||
|
||||
let get_max_id graph =
|
||||
n_fold graph (fun acu id -> max id acu) 0
|
||||
n_fold graph (fun acu id -> max id acu) 0
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@ 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
|
||||
|
||||
(* Add a value to the capacity of the arc id1 id2 in the graph*)
|
||||
val add_capa: (int * int) graph -> id -> id -> int -> (int * int) graph
|
||||
|
||||
(* Return the highest id value in the graph*)
|
||||
val get_max_id : 'a graph -> id
|
||||
Loading…
Reference in a new issue