From 9bb45f3e10c15c3409b646bc52ce797d5ea2de65 Mon Sep 17 00:00:00 2001
From: Gwennan Eliezer <gwennan.eliezer@etu.univ-grenoble-alpes.fr>
Date: Fri, 5 Jul 2019 15:34:39 +0200
Subject: [PATCH] Debugged, renamed CommomGraph ClassicGraph, placed all the
UDG utils from RandomGraph into a new module, enhanced "gg <command> -s" such
that is has effect on warnings, removed "rand" function
---
.../{commonGraph.ml => classicGraph.ml} | 23 +++---
.../{commonGraph.mli => classicGraph.mli} | 0
tools/graphgen/ggcore.ml | 15 ++--
tools/graphgen/ggcore.mli | 3 -
tools/graphgen/graphGen.ml | 78 ++++++++++---------
tools/graphgen/graphGen_arg.ml | 42 +++++-----
tools/graphgen/graphGen_arg.mli | 2 +-
tools/graphgen/randomGraph.ml | 67 ----------------
tools/graphgen/randomGraph.mli | 35 ---------
tools/graphgen/udgUtils.ml | 70 +++++++++++++++++
tools/graphgen/udgUtils.mli | 42 ++++++++++
11 files changed, 196 insertions(+), 181 deletions(-)
rename tools/graphgen/{commonGraph.ml => classicGraph.ml} (90%)
rename tools/graphgen/{commonGraph.mli => classicGraph.mli} (100%)
create mode 100644 tools/graphgen/udgUtils.ml
create mode 100644 tools/graphgen/udgUtils.mli
diff --git a/tools/graphgen/commonGraph.ml b/tools/graphgen/classicGraph.ml
similarity index 90%
rename from tools/graphgen/commonGraph.ml
rename to tools/graphgen/classicGraph.ml
index 39e077c1..6001554e 100644
--- a/tools/graphgen/commonGraph.ml
+++ b/tools/graphgen/classicGraph.ml
@@ -33,16 +33,19 @@ let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem
let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list)) =
fun li ->
let node_succ:node_succ_t = Hashtbl.create (length li) in
- let (_,ret) = fold_right (fun elem ((first,prev),accu) -> (* have to change it, to use a fold_left *)
- if first = "" then
- ((elem,elem),[[""; prev]])
- else
- (
- match accu with
- | [_;x]::tl -> ((first,elem),[first;prev]::([elem;x]::tl))
- | _ -> assert false
- )
- ) li (("",(hd li)),[]) in
+ let ((_,last),ret) = fold_left (fun ((first,prev),accu) elem ->
+ if first = "" then
+ ((elem,elem),[[""; ""]])
+ else
+ (
+ match accu with
+ | [x;_]::tl -> ((first,elem),[prev;first]::([x;elem]::tl))
+ | _ -> assert false
+ )
+ ) (("",""),[]) li in let ret = rev ret in
+ let ret = (match ret with
+ | ["";x]::tail -> [last;x]::tail
+ | _ -> assert false) in
iter2 (fun neighbours elem -> Hashtbl.replace node_succ elem (add_weight neighbours)) ret li ;
(fun n -> try Hashtbl.find node_succ n with Not_found -> [])
diff --git a/tools/graphgen/commonGraph.mli b/tools/graphgen/classicGraph.mli
similarity index 100%
rename from tools/graphgen/commonGraph.mli
rename to tools/graphgen/classicGraph.mli
diff --git a/tools/graphgen/ggcore.ml b/tools/graphgen/ggcore.ml
index 143837fa..e3fb5611 100644
--- a/tools/graphgen/ggcore.ml
+++ b/tools/graphgen/ggcore.ml
@@ -6,10 +6,6 @@ type topology = {
succ: node_id -> (int option * node_id) list
}
-let rand : (int -> int -> int) =
- (* Makes a random number between the two arguments *)
- fun min max -> min + Random.int (max-min)
-
let rec create_nodes : (string -> int*int -> node_id list) =
(* Create names from a generic name *)
fun name (start,finish) ->
@@ -51,10 +47,13 @@ let make_dot : (topology -> string -> unit) =
let name = ref "graph0" in
let f = (if file_name = "" then stdout else
(
- name := Filename.remove_extension file_name;
- (*if Filename.extension file_name <> ".dot" then
- (open_out (file_name ^".dot"))
- else*) open_out file_name
+ name := file_name;
+ (try ( (* remove all extensions. So if name = ref "tt.dot.dot" at the beginning, at the end name = ref "tt". *)
+ while true do
+ name := Filename.chop_extension !name;
+ done;
+ ) with Invalid_argument _ -> ());
+ open_out file_name
)
) in
let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in
diff --git a/tools/graphgen/ggcore.mli b/tools/graphgen/ggcore.mli
index 0178c099..a6cdc4b3 100644
--- a/tools/graphgen/ggcore.mli
+++ b/tools/graphgen/ggcore.mli
@@ -6,9 +6,6 @@ type topology = {
succ: node_id -> (int option * node_id) list
}
-(** Gives a random int between the two arguments. Useful to have a random nodes number *)
-val rand : (int -> int -> int)
-
(** Create a name (i.d. node ID) list from a generic name *)
val create_nodes : (string -> int*int -> node_id list)
diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml
index 81494a17..b297095a 100644
--- a/tools/graphgen/graphGen.ml
+++ b/tools/graphgen/graphGen.ml
@@ -1,26 +1,28 @@
open Ggcore
-open CommonGraph
+open ClassicGraph
open RandomGraph
open GraphGen_arg
+open UdgUtils
let () = (
let t = parse Sys.argv in
if (t.n < 0) then (
- match t.action with
- | "void" | "grid" -> ()
+ let msg = match t.action with
+ | "void" | "grid" -> ""
| "HC" -> (
t.n <- 3;
- Printf.fprintf stderr "=========================================================================\n";
- Printf.fprintf stderr "Caution : the dimension is not defined or negative. It has been set to 3.\n";
- Printf.fprintf stderr "=========================================================================\n"
+ "=========================================================================\n"^
+ "Caution : the dimension is not defined or negative. It has been set to 3.\n"^
+ "=========================================================================\n"
)
| _ -> (
t.n <- 10;
- Printf.fprintf stderr "=============================================================================\n";
- Printf.fprintf stderr "Caution : the nodes number is not defined or negative. It has been set to 10.\n";
- Printf.fprintf stderr "=============================================================================\n"
- )
+ "=============================================================================\n"^
+ "Caution : the nodes number is not defined or negative. It has been set to 10.\n"^
+ "=============================================================================\n"
+ ) in
+ if (not t.silent) then Printf.fprintf stderr "%s" msg
);
let args_msg = ref "" in
let g = ( match t.action with
@@ -28,36 +30,42 @@ let () = (
| "clique" -> (gen_clique t.n)
| "star" -> (gen_star t.n)
| "ring" -> (gen_ring t.n)
- | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; gen_grid t.grid.height t.grid.width)
+ | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width;
+ gen_grid t.grid.height t.grid.width)
| "HC" -> (gen_hyper_cube t.n)
| "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er)
| "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba)
| "tree" -> (rand_tree t.n)
| "UDG" -> (
- args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius;
- let prob_func = (match t.udg.proba with
- | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; (proba_from_constant c))
- | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; (proba_from_list l t.udg.radius))
- | LinearP -> (
- args_msg := Printf.sprintf "%s and a probability proportionnal to to the distance" !args_msg;
- (linear_prob t.udg.radius)
- )
- ) in
- let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in
- if (t.dotUDG <> "") then (
- make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot");
- ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG ))
- );
- if (t.dotUDGrad <> "") then (
- make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot");
- ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad ))
- );
- graph
- )
- | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv));
- assert false)
+ args_msg := Printf.sprintf " with w=%f l=%f r=%f"
+ t.udg.width t.udg.height t.udg.radius;
+ let prob_func = (match t.udg.proba with
+ | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c;
+ (prob_from_constant c))
+ | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg;
+ (prob_from_list l t.udg.radius))
+ | LinearP -> (
+ args_msg := Printf.sprintf "%s and a linear edge probability" !args_msg;
+ (linear_prob t.udg.radius)
+ )
+ ) in
+ let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in
+ if (t.dotUDG <> "") then (
+ make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot");
+ ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG))
+ );
+ if (t.dotUDGrad <> "") then (
+ make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot");
+ ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad ))
+ );
+ graph
+ )
+ | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n"
+ (String.concat " " (Array.to_list Sys.argv)); assert false)
) in
- if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg;
+ if (t.outputFile <> "" && not t.silent)
+ then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg;
make_dot g t.outputFile;
- if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile
+ if (t.outputFile <> "" && not t.silent)
+ then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile
)
diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml
index 1805a413..6fc6f13e 100644
--- a/tools/graphgen/graphGen_arg.ml
+++ b/tools/graphgen/graphGen_arg.ml
@@ -4,7 +4,7 @@ type action = string
type udg_proba =
| ConstP of float
| LstP of float list
- | ProgP
+ | LinearP
type grid_arg = {
mutable width: int;
@@ -73,9 +73,9 @@ let (make_args : unit -> t) =
er = 0.3;
ba = 2;
udg = {
- width = 0.;
- height = 0.;
- radius = 0.;
+ width = 10.;
+ height = 10.;
+ radius = 2.;
proba = ConstP 1.;
};
@@ -207,7 +207,7 @@ let (mkoptab : string array -> t -> unit) =
| "UDG" -> args.udg.width <- w
| _ -> unexpected "-w" ))
[(["Set the grid's width to the value (integer)\n"],"grid");
- (["Set the UDG's terrain width to the value (float)\n"],"UDG")];
+ (["Set the UDG's terrain width to the value (float)";"10 by default.\n"],"UDG")];
mkopt args ["--height";"-he"] ~arg:" <float>"
(Arg.Float (fun h -> match args.action with
@@ -215,7 +215,7 @@ let (mkoptab : string array -> t -> unit) =
| "UDG" -> args.udg.height <- h
| _ -> unexpected "-he"))
[(["Set the grid's height to the value (integer)\n"],"grid");
- (["Set the UDG's terrain height to the value (float)\n"],"UDG")];
+ (["Set the UDG's terrain height to the value (float)";"10 by default.\n"],"UDG")];
mkopt args ["--edge-probability";"-p"]~arg:" <float>"
@@ -237,7 +237,7 @@ let (mkoptab : string array -> t -> unit) =
(Arg.Float (fun r -> match args.action with
| "UDG" -> args.udg.radius <- r
| _ -> unexpected "-r"))
- [(["Set the Unit Disc's radius around a node to the given value.\n"],"UDG")];
+ [(["Set the Unit Disc's radius around a node to the given value.";"3 by default.\n"],"UDG")];
mkopt args ["--prob-from-constant";"-pc"] ~arg:" <float>"
(Arg.Float (fun i -> args.udg.proba <- ConstP i))
@@ -256,28 +256,26 @@ let (mkoptab : string array -> t -> unit) =
], "UDG")];
mkopt args ["--progressive-prob";"-pp"]
- (Arg.Unit (fun () -> args.udg.proba <- ProgP))
+ (Arg.Unit (fun () -> args.udg.proba <- LinearP))
[(["...";"...";"...\n"], "UDG")];
- mkopt args ["--proba_from_couple_list";"-pcl"]
- (Arg.Unit (fun () -> args.udg.proba <- CplLstP []))
- [(["...";"...";"...\n"], "UDG")];
-
- mkopt args ["--dot_udg";"-du"]~arg:" <file>"
+ mkopt args ["--dot_udg";"-du"]~arg:" <file-base-name>"
(Arg.String (fun f -> match args.action with
| "UDG" -> args.dotUDG <- f
| _ -> unexpected "-mdudg"))
- [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")];
+ [(["Create a DOT file to visualize the UDG plan.";
+ "The extension .dot will be added to the file base-name.\n"],"UDG")];
- mkopt args ["--dot_udg_radius";"-dur"]~arg:" <file>"
+ mkopt args ["--dot_udg_radius";"-dur"]~arg:" <file-base-name>"
(Arg.String (fun f -> match args.action with
| "UDG" -> args.dotUDGrad <- f
| _ -> unexpected "-mdudg"))
- [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")];
+ [(["Create a DOT file to visualize the UDG plan.";
+ "The extension .dot will be added to the file base-name.\n"],"UDG")];
-(* mkopt args ["--silent";"-s"]
+ mkopt args ["--silent";"-s"]
(Arg.Unit (fun () -> args.silent <- true))
- [(["Remove all outputs, except ones made by other options.\n"],"all")];*)
+ [(["Remove all outputs, except ones made by other options.\n"],"all")];
mkopt args ["--help";"-h"]
(Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then ""
@@ -295,6 +293,7 @@ let current = ref 1;;
let parse argv = (
let save_current = !current in
let args = make_args () in
+ mkoptab argv args;
try (
(if (Array.length argv) = 1 then help args (argv.(0)));
let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in
@@ -305,23 +304,22 @@ let parse argv = (
(Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n" (argv.(0)) (argv.(1));
(print_usage stderr true argv.(0)); exit 2)
);
- mkoptab argv args;
Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1)));
current := save_current;
(List.iter
(fun f ->
- if (String.sub f 0 1 = "-") then
+ if (String.sub f 0 1 = "-") then (
unexpected f
- else
+ ) else (
match args.action with
| "UDG" -> (
match args.udg.proba with
| LstP l -> args.udg.proba <- LstP ((float_of_string f)::l)
| _ -> unexpected f
)
- )
| _ -> unexpected f
+ )
) (List.rev args._others)
);
args
diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli
index bf12aeed..70d476ef 100644
--- a/tools/graphgen/graphGen_arg.mli
+++ b/tools/graphgen/graphGen_arg.mli
@@ -1,6 +1,6 @@
type action = string
-type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list
+type udg_proba = | ConstP of float | LstP of float list | LinearP
type grid_arg = {
mutable width: int;
mutable height: int;
diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml
index 28dca952..8e0a45e5 100644
--- a/tools/graphgen/randomGraph.ml
+++ b/tools/graphgen/randomGraph.ml
@@ -109,37 +109,6 @@ type node_udg = node_id*float*float
type plan_udg = node_udg list
type prob_udg = (float -> float)
-(* utils for UDG : *)
-
-let prob_from_list : (float list -> float -> prob_udg) =
- fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d)))
-
-let linear_prob : (float -> prob_udg) =
- fun r -> (fun d -> d/r)
-
-
- ) cpl (d,0)) in let (_,p) = (List.nth cpl tmp) in p
-
-let prob_from_constant : (float -> prob_udg) =
- fun x _ -> x
-
-let recommend_radius : (int -> float -> (float * float) -> float) =
- fun mean_deg nb_node (h,w) ->
- if(mean_deg > nb_node) then
- failwith "Error : the number of node should be greater or equal than mean degree"
- else
- sqrt ((h*.w)*.mean_deg/.(Float.pi*.(float_of_int nb_node)))
-
-let reccomend_nb_node : (float -> float -> (float * float) -> int) =
- fun radius mean_deg (h,w) ->
- (int_of_float ((mean_deg*.h*.w)/.((radius**2.)*.Float.pi)))+1
-
-let compute_mean_degree : (int -> float -> (float * float) -> float) =
- fun radius nb_node (h,w) ->
- ((radius**2.)*.Float.pi*.(float_of_int nb_node))/.(h*.w)
-
-(* UDG implementation : *)
-
let (make_plan_udg: node_id list -> float -> float -> plan_udg) =
fun nodes x y ->
List.map (fun elem -> (elem,(Random.float x),(Random.float y))) (nodes)
@@ -176,39 +145,3 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (topology * plan_
nodes = nodes ;
succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> []));
},pl
-
-(***************************************************************)
-
-let rec make_nodes_dot_udg : (node_udg list -> float -> string) =
- (*Create a string in the dot syntax from a node list*)
- fun nudg r ->
- match nudg with
- | [] -> ""
- | head::tail ->
- let (node,x,y) = head in
- (*(Printf.sprintf "%s [algo=\"%s\",pos=\"%f,%f!\"]\n" node.id node.file x y )^*)
- (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^
- let draw_rad = if(r <> -1.) then
- (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in
- draw_rad^(make_nodes_dot_udg tail r)
-
-let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) =
- (*Create a dot file from a graph*)
- fun t plan dim ?(r = -1.) file_name ->
- let name = ref "graph0" in
- let f = (if file_name = "" then stdout else
- (
- name := Filename.remove_extension file_name;
- open_out file_name
- )
- ) in
- let (w,l) = dim in
- let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in
- let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos
-
-
- ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in
- Printf.fprintf f "%s" dot;
- flush f;
- close_out f
- (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*)
diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli
index 4cd31460..140c7acb 100644
--- a/tools/graphgen/randomGraph.mli
+++ b/tools/graphgen/randomGraph.mli
@@ -29,38 +29,3 @@ val rand_tree: (int -> topology)
p will be run to obtain the probability of an edge appearing between these nodes.
p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*)
val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg))
-
-(** create a probability function for UDG that always return the same probability *)
-val prob_from_constant: (float -> prob_udg)
-
-(** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance.
- It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on.
- For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on.
- Note that r must be equal to the radius of the Unit Disc *)
-val prob_from_list: (float list -> float -> prob_udg)
-
-(** [linear_proba r] gives a function that, for an input d (distance) outputs d/r.
- If r is the Unit Disc radius and d the distance between two points,
- it outputs a probability that is higher for a low d and lower for a high d. *)
-val linear_prob: (float -> prob_udg)
-
-(** [recommend_radius n mean_deg h w] returns the recommended radius to give to UDG
- in order to get a mean degree approximately equal to mean_deg,
- knowing there's n nodes and the UDG is applied in an area of height h and width w. *)
-val recommend_radius : (int -> float -> float -> float -> float)
-
-(** [reccomend_nb_node r mean_deg h w] returns the recommended number of nodes
- to give to UDG in order to get a mean degree approximately equal to mean_deg,
- knowing the radius is r and the UDG is applied in an area of height h and width w. *)
-val reccomend_nb_node : (float -> float -> float -> float -> int)
-
-(** [compute_mean_degree n r h w] computes and return the approximative mean degree of
- an UDG graph with the same arguments. *)
-val compute_mean_degree : (int -> float -> float -> float -> float)
-
-(** [make_dot_udg ~r=r g p (h,w) f] Creates a DOT file to represent the UDG area,
- r being the radius, g being the graph, p being the UDG area,
- and (h,w) being the dimensions of the plan.
- If no radius is given, they won't appear on the pdf.
- If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *)
-val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit)
diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml
new file mode 100644
index 00000000..ea769743
--- /dev/null
+++ b/tools/graphgen/udgUtils.ml
@@ -0,0 +1,70 @@
+open Ggcore
+type probability = float (*between 0 and 1*)
+type prob_udg = (float -> probability)
+
+type node_udg = node_id*float*float
+type plan_udg = node_udg list
+
+let prob_from_list : (float list -> float -> prob_udg) =
+ fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d)))
+
+let linear_prob : (float -> prob_udg) =
+ fun r -> (fun d -> d/.r)
+
+let prob_from_constant : (float -> prob_udg) =
+ fun x _ -> x
+
+let recommend_radius : (int -> float -> float -> float -> float) =
+ fun nb_node mean_deg h w ->
+ if(mean_deg > float_of_int nb_node) then
+ failwith "Error : the number of node should be greater or equal than mean degree"
+ else
+ sqrt ((h*.w)*.mean_deg/.(Float.pi*.(float_of_int nb_node)))
+
+let recommend_nb_node : (float -> float -> float -> float -> int) =
+ fun radius mean_deg h w ->
+ (int_of_float ((mean_deg*.h*.w)/.((radius**2.)*.Float.pi)))+1
+
+let compute_mean_degree : (int -> float -> float -> float -> float) =
+ fun nb_node radius h w ->
+ ((radius**2.)*.Float.pi*.(float_of_int nb_node))/.(h*.w)
+
+(******************************************************************************)
+
+let rec make_nodes_dot_udg : (node_udg list -> float -> string) =
+ (*Create a string in the dot syntax from a node list*)
+ fun nudg r ->
+ match nudg with
+ | [] -> ""
+ | head::tail ->
+ let (node,x,y) = head in
+ (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^
+ let draw_rad = if(r <> -1.) then
+ (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in
+ draw_rad^(make_nodes_dot_udg tail r)
+
+let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) =
+ (*Create a dot file from a graph*)
+ fun t plan dim ?(r = -1.) file_name ->
+ let name = ref "graph0" in (* default name *)
+ let f = (if file_name = "" then stdout else
+ (
+ name := file_name;
+ (try ( (* remove all extensions. So if name = ref "tt.dot.dot" at the beginning, at the end name = ref "tt". *)
+ while true do
+ name := Filename.chop_extension !name;
+ done;
+ ) with Invalid_argument _ -> ());
+ open_out file_name
+ )
+ ) in
+ let (w,l) = dim in
+ let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in
+ let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos
+
+
+ ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in
+ Printf.fprintf f "%s" dot;
+ flush f;
+ close_out f
+ (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*)
diff --git a/tools/graphgen/udgUtils.mli b/tools/graphgen/udgUtils.mli
new file mode 100644
index 00000000..aad176e2
--- /dev/null
+++ b/tools/graphgen/udgUtils.mli
@@ -0,0 +1,42 @@
+open Ggcore
+type probability = float (*between 0 and 1*)
+type prob_udg = (float -> probability)
+
+type node_udg = node_id*float*float
+type plan_udg = node_udg list
+
+
+(** create a probability function for UDG that always return the same probability *)
+val prob_from_constant: (float -> prob_udg)
+
+(** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance.
+ It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on.
+ For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on.
+ Note that r must be equal to the radius of the Unit Disc *)
+val prob_from_list: (float list -> float -> prob_udg)
+
+(** [linear_proba r] gives a function that, for an input d (distance) outputs d/r.
+ If r is the Unit Disc radius and d the distance between two points,
+ it outputs a probability that is higher for a low d and lower for a high d. *)
+val linear_prob: (float -> prob_udg)
+
+(** [recommend_radius n mean_deg h w] returns the recommended radius to give to UDG
+ in order to get a mean degree approximately equal to mean_deg,
+ knowing there's n nodes and the UDG is applied in an area of height h and width w. *)
+val recommend_radius : (int -> float -> float -> float -> float)
+
+(** [reccomend_nb_node r mean_deg h w] returns the recommended number of nodes
+ to give to UDG in order to get a mean degree approximately equal to mean_deg,
+ knowing the radius is r and the UDG is applied in an area of height h and width w. *)
+val recommend_nb_node : (float -> float -> float -> float -> int)
+
+(** [compute_mean_degree n r h w] computes and return the approximative mean degree of
+ an UDG graph with the same arguments. *)
+val compute_mean_degree : (int -> float -> float -> float -> float)
+
+(** [make_dot_udg g p (h,w) ~r=r f] Creates a DOT file to represent the UDG area,
+ r being the radius, g being the graph, p being the UDG area,
+ and (h,w) being the dimensions of the plan.
+ If no radius is given, they won't appear on the pdf.
+ If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *)
+val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit)
\ No newline at end of file
--
GitLab