From a622266e1ba860a05bab5a9b3277c0e0ec9a8380 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 Feb 2020 14:05:25 +0100
Subject: [PATCH] Update: the merged code now compiles!
---
tools/ggDeco/ggDeco.ml | 6 +-
tools/graphgen/classicGraph.ml | 127 ++++++++++---------
tools/graphgen/classicGraph.mli | 18 +--
tools/graphgen/graphGen.ml | 213 ++++++++++++++++----------------
tools/graphgen/graphGen_arg.ml | 101 ++++++++-------
tools/graphgen/graphGen_arg.mli | 1 +
tools/graphgen/randomGraph.ml | 33 ++---
tools/graphgen/randomGraph.mli | 11 +-
8 files changed, 264 insertions(+), 246 deletions(-)
diff --git a/tools/ggDeco/ggDeco.ml b/tools/ggDeco/ggDeco.ml
index de4f6ea5..0cbdd3bb 100644
--- a/tools/ggDeco/ggDeco.ml
+++ b/tools/ggDeco/ggDeco.ml
@@ -52,11 +52,7 @@ let deco : (Topology.t -> files_spec_t list -> Topology.t) =
})::!newNodes
);
) g.nodes;
- {
- nodes = List.rev !newNodes;
- succ = g.succ;
- of_id = g.of_id;
- }
+ { g with nodes = List.rev !newNodes }
(**********************************************************)
diff --git a/tools/graphgen/classicGraph.ml b/tools/graphgen/classicGraph.ml
index 2fd99521..8ed75fe0 100644
--- a/tools/graphgen/classicGraph.ml
+++ b/tools/graphgen/classicGraph.ml
@@ -9,20 +9,25 @@ let nid_list_remove : (node_id list -> node_id -> (int option*node_id) list) =
fun l e -> rev (fold_left (fun acc elem -> if(elem <> e) then (None,elem)::acc else acc ) [] l)
-let (gen_clique: int -> Topology.t) =
- fun nb ->
- let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in
- List.iter (fun node_id -> Hashtbl.replace node_succ node_id (nid_list_remove nodes node_id)) nodes;
+let (gen_clique: bool -> int -> Topology.t) =
+ fun directed nb ->
+ let (node_succ:node_succ_t) = Hashtbl.create nb
+ and nodes = create_nodes "p" (0,nb)
+ in
+ List.iter
+ (fun node_id -> Hashtbl.replace node_succ node_id (nid_list_remove nodes node_id))
+ nodes;
let nl = id_to_empty_nodes nodes in
{
nodes = nl;
succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []);
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
}
-let (gen_star: int -> Topology.t) =
- fun nb ->
+let (gen_star: bool -> int -> Topology.t) =
+ fun directed nb ->
let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = "root"::(create_nodes "p" (1,nb)) in
let first = hd nodes in
List.iter (fun node -> Hashtbl.replace node_succ node (if node = first then nid_list_remove nodes node else [(None,first)])) nodes;
@@ -30,7 +35,8 @@ let (gen_star: int -> Topology.t) =
{
nodes = nl;
succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []);
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
}
let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem -> (None,elem)) li
@@ -54,61 +60,63 @@ let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list))
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 -> [])
- let (gen_ring: int -> Topology.t) =
- fun nb ->
- let nodes = (create_nodes "p" (0,nb)) in
- let nl = id_to_empty_nodes nodes in
- {
- nodes = nl;
- succ = neighbours_ring nodes;
- of_id = get_of_id nl
- }
+let (gen_ring: bool -> int -> Topology.t) =
+ fun directed nb ->
+ let nodes = (create_nodes "p" (0,nb)) in
+ let nl = id_to_empty_nodes nodes in
+ {
+ nodes = nl;
+ succ = neighbours_ring nodes;
+ of_id = get_of_id nl;
+ directed = directed
+ }
- let (gen_grid: int -> int -> Topology.t) =
- fun length width ->
- Printf.eprintf "Computing a %ix%i grid...\n" length width;
- flush stderr;
- let nb = length*width in
- let nodes = (create_nodes "p" (0,nb)) and table = Hashtbl.create nb in
- for i=0 to length-1 do
- for j=0 to width-1 do
- let n_id = (List.nth nodes (j*length + i)) in
- let bl = if(i=0) then 0 else -1 in
- let br = if(i=(length-1)) then 0 else 1 in
- let bup = if(j=0) then 0 else -1 in
- let bdown = if(j=(width-1)) then 0 else 1 in
- for ip=bl to br do
- for jp=bup to bdown do
- if not ((ip=0 && jp=0) || (ip=jp) || (ip = -jp)) then
- (Hashtbl.replace table n_id
- ((None,(List.nth nodes ((j+jp)*length + i+ip)))::(
- try Hashtbl.find table n_id with Not_found -> [])); ) else ()
- done;
+let (gen_grid: bool -> int -> int -> Topology.t) =
+ fun directed length width ->
+ Printf.eprintf "Computing a %ix%i grid...\n" length width;
+ flush stderr;
+ let nb = length*width in
+ let nodes = (create_nodes "p" (0,nb)) and table = Hashtbl.create nb in
+ for i=0 to length-1 do
+ for j=0 to width-1 do
+ let n_id = (List.nth nodes (j*length + i)) in
+ let bl = if(i=0) then 0 else -1 in
+ let br = if(i=(length-1)) then 0 else 1 in
+ let bup = if(j=0) then 0 else -1 in
+ let bdown = if(j=(width-1)) then 0 else 1 in
+ for ip=bl to br do
+ for jp=bup to bdown do
+ if not ((ip=0 && jp=0) || (ip=jp) || (ip = -jp)) then
+ (Hashtbl.replace table n_id
+ ((None,(List.nth nodes ((j+jp)*length + i+ip)))::(
+ try Hashtbl.find table n_id with Not_found -> [])); ) else ()
done;
done;
done;
- let nl = id_to_empty_nodes nodes in
- Printf.eprintf "Computing a %ix%i grid: Done!\n" length width;flush stderr;
- {
- nodes = nl;
- succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> []));
- of_id = get_of_id nl
- }
+ done;
+ let nl = id_to_empty_nodes nodes in
+ Printf.eprintf "Computing a %ix%i grid: Done!\n" length width;flush stderr;
+ {
+ nodes = nl;
+ succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> []));
+ of_id = get_of_id nl;
+ directed = directed
+ }
let rec link_hypercube_nodes : (node_id array -> node_succ_t -> unit) =
fun na n_s ->
- let len = Array.length na in let mid = len / 2 in
- if len > 1 then
- let n1 = (Array.sub na 0 mid) and n2 = (Array.sub na mid mid) in
- link_hypercube_nodes n1 n_s;
- link_hypercube_nodes n2 n_s;
- Array.iter2 (fun node1 node2 ->
- Hashtbl.replace n_s node1
- ((None,node2)::(try Hashtbl.find n_s node1 with Not_found -> []));
- Hashtbl.replace n_s node2
- ((None,node1)::(try Hashtbl.find n_s node2 with Not_found -> []))
- ) n1 n2
+ let len = Array.length na in let mid = len / 2 in
+ if len > 1 then
+ let n1 = (Array.sub na 0 mid) and n2 = (Array.sub na mid mid) in
+ link_hypercube_nodes n1 n_s;
+ link_hypercube_nodes n2 n_s;
+ Array.iter2 (fun node1 node2 ->
+ Hashtbl.replace n_s node1
+ ((None,node2)::(try Hashtbl.find n_s node1 with Not_found -> []));
+ Hashtbl.replace n_s node2
+ ((None,node1)::(try Hashtbl.find n_s node2 with Not_found -> []))
+ ) n1 n2
let neighbours_hyper_cube : (node_id list -> (node_id -> (int option * node_id) list)) =
fun nl ->
@@ -117,13 +125,14 @@ let neighbours_hyper_cube : (node_id list -> (node_id -> (int option * node_id)
link_hypercube_nodes na node_succ;
(fun n -> try Hashtbl.find node_succ n with Not_found -> [])
-let gen_hyper_cube : (int -> Topology.t) =
- fun dim ->
+let gen_hyper_cube : (bool -> int -> Topology.t) =
+ fun directed dim ->
let nb = int_of_float (2. ** (float_of_int dim)) in
let nodes = (create_nodes "p" (0,nb)) in
let nl = id_to_empty_nodes nodes in
{
nodes = nl;
succ = neighbours_hyper_cube nodes;
- of_id = get_of_id nl
- }
+ of_id = get_of_id nl;
+ directed = directed
+ }
diff --git a/tools/graphgen/classicGraph.mli b/tools/graphgen/classicGraph.mli
index bed633a6..075ede36 100644
--- a/tools/graphgen/classicGraph.mli
+++ b/tools/graphgen/classicGraph.mli
@@ -1,17 +1,19 @@
open Sasacore
-(** Generate a clique graph of n nodes *)
-val gen_clique : (int -> Topology.t)
+(** Generate a clique graph of n nodes; the bool states whether the
+ graph is directed *)
+val gen_clique : bool -> int -> Topology.t
(** Generate a star graph of n nodes *)
-val gen_star : (int -> Topology.t)
+val gen_star : bool -> int -> Topology.t
(** Generate a ring graph of n nodes *)
-val gen_ring :(int -> Topology.t)
+val gen_ring : bool -> int -> Topology.t
-(** take the two dimension i,j of the grid and return a grid graph whith these dimension *)
-val gen_grid : (int -> int -> Topology.t)
+(** Take the two dimensions i,j of the grid and return a grid graph
+ with these dimensions *)
+val gen_grid : bool -> int -> int -> Topology.t
-(** take a dimension and generate hyper cube graph of this dimension *)
-val gen_hyper_cube : (int -> Topology.t)
+(** Take a dimension and generate hyper cube graph of this dimension *)
+val gen_hyper_cube : bool -> int -> Topology.t
diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml
index 4af384b8..a12eddaf 100644
--- a/tools/graphgen/graphGen.ml
+++ b/tools/graphgen/graphGen.ml
@@ -14,124 +14,122 @@ let connected_cyclic = ref None
let height:int option ref = ref None
let generate_du_dur graph plan_udg t : unit =
-
if (t.dotUDG <> "") then (
make_dot_udg_qudg graph plan_udg (t.qudg.width,t.qudg.height) (t.dotUDGrad));
if (t.dotUDGrad <> "") then (
make_dot_udg_qudg graph plan_udg (t.qudg.width,t.qudg.height) ~r0:(t.qudg.radius)
~r1:(t.qudg.r1) (t.dotUDGrad);
Printf.printf "%f -- %f" t.qudg.radius t.qudg.r1
- );
- ()
+ )
let compute_attr : (Topology.t -> string list -> (string * string) list) =
fun g ->
List.map
(fun attr ->
- Printf.eprintf "Computing %s\n" attr;
- flush stderr;
- attr,match attr with
- | "min_deg" ->
- string_of_int
- (match !min_max with
- | None -> (
- let min, max = Topology.get_degree g in
- min_max := Some (min, max);
- min)
- | Some x -> fst x)
- | "mean_deg" ->
- string_of_float (Topology.get_mean_degree g)
- | "max_deg" ->
- string_of_int (match !min_max with
- | None -> (
- let x = get_degree g in
- min_max := Some x;
- snd x)
- | Some x -> snd x)
- | "is_connected" ->
- string_of_bool (
- match !connected_cyclic with
- | None -> (
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- fst x)
- | Some x -> fst x )
- | "is_cyclic" ->
- string_of_bool
- (match !connected_cyclic with
- | None -> (
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- snd x)
- | Some x -> snd x )
- | "is_tree" ->
- string_of_bool
- (match !connected_cyclic with
- | None -> (
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- (fst x) && (snd x))
- | Some x -> (fst x) && (snd x) )
- | "links_number" -> string_of_int (get_nb_link g false)
- | "diameter" -> string_of_int (Diameter.get g)
- | s -> string_of_int (let s = String.split_on_char ' ' s in
- if List.hd s = "height" && List.length s = 2 then
- get_height g (List.hd (List.tl s))
- else raise Incorrect_attribute)
+ Printf.eprintf "Computing %s\n" attr;
+ flush stderr;
+ attr,match attr with
+ | "min_deg" ->
+ string_of_int
+ (match !min_max with
+ | None -> (
+ let min, max = Topology.get_degree g in
+ min_max := Some (min, max);
+ min)
+ | Some x -> fst x)
+ | "mean_deg" ->
+ string_of_float (Topology.get_mean_degree g)
+ | "max_deg" ->
+ string_of_int (match !min_max with
+ | None -> (
+ let x = get_degree g in
+ min_max := Some x;
+ snd x)
+ | Some x -> snd x)
+ | "is_connected" ->
+ string_of_bool (
+ match !connected_cyclic with
+ | None -> (
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ fst x)
+ | Some x -> fst x )
+ | "is_cyclic" ->
+ string_of_bool
+ (match !connected_cyclic with
+ | None -> (
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ snd x)
+ | Some x -> snd x )
+ | "is_tree" ->
+ string_of_bool
+ (match !connected_cyclic with
+ | None -> (
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ (fst x) && (snd x))
+ | Some x -> (fst x) && (snd x) )
+ | "links_number" -> string_of_int (get_nb_link g)
+ | "diameter" -> string_of_int (Diameter.get g)
+ | s -> string_of_int (let s = String.split_on_char ' ' s in
+ if List.hd s = "height" && List.length s = 2 then
+ get_height g (List.hd (List.tl s))
+ else raise Incorrect_attribute)
)
let all_attr : (Topology.t -> (string * string) list) =
fun g ->
[ "min_deg", string_of_int
- (match !min_max with
- | None -> (
- Printf.eprintf "Computing the min_degree...\n"; flush stderr;
- let min, max = Topology.get_degree g in
- min_max := Some (min, max);
- min)
- | Some x -> fst x);
+ (match !min_max with
+ | None -> (
+ Printf.eprintf "Computing the min_degree...\n"; flush stderr;
+ let min, max = Topology.get_degree g in
+ min_max := Some (min, max);
+ min)
+ | Some x -> fst x);
"mean_deg", string_of_float (
- Printf.eprintf "Computing the mean_degree...\n"; flush stderr;
- Topology.get_mean_degree g);
+ Printf.eprintf "Computing the mean_degree...\n"; flush stderr;
+ Topology.get_mean_degree g);
"max_deg", string_of_int (match !min_max with
- | None -> (
- Printf.eprintf "Computing the max_degree...\n";
- flush stderr;
- let x = get_degree g in
- min_max := Some x;
- snd x)
- | Some x -> snd x);
+ | None -> (
+ Printf.eprintf "Computing the max_degree...\n";
+ flush stderr;
+ let x = get_degree g in
+ min_max := Some x;
+ snd x)
+ | Some x -> snd x);
"is_connected", string_of_bool (
- match !connected_cyclic with
- | None -> (
- Printf.eprintf "Computing the connection...\n";
- flush stderr;
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- fst x)
- | Some x -> fst x );
+ match !connected_cyclic with
+ | None -> (
+ Printf.eprintf "Computing the connection...\n";
+ flush stderr;
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ fst x)
+ | Some x -> fst x );
"is_cyclic", string_of_bool
- (match !connected_cyclic with
- | None -> (
- Printf.eprintf "Computing the cyclicity...\n";
- flush stderr;
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- snd x)
- | Some x -> snd x );
+ (match !connected_cyclic with
+ | None -> (
+ Printf.eprintf "Computing the cyclicity...\n";
+ flush stderr;
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ snd x)
+ | Some x -> snd x );
"is_tree", string_of_bool
- (match !connected_cyclic with
- | None -> (
- Printf.eprintf "Computing the tree-ness...\n";
- flush stderr;
- let x = is_connected_and_cyclic g in
- connected_cyclic := Some x;
- (fst x) && (snd x))
- | Some x -> (fst x) && (snd x) );
+ (match !connected_cyclic with
+ | None -> (
+ Printf.eprintf "Computing the tree-ness...\n";
+ flush stderr;
+ let x = is_connected_and_cyclic g in
+ connected_cyclic := Some x;
+ (fst x) && (snd x))
+ | Some x -> (fst x) && (snd x) );
"links_number", string_of_int (
- Printf.eprintf "Computing the link_number...\n";
- flush stderr;
- get_nb_link g false);
-(*
+ Printf.eprintf "Computing the link_number...\n";
+ flush stderr;
+ get_nb_link g);
+ (*
"diameter", string_of_int (
Printf.eprintf "Computing the diameter...\n";
flush stderr;
@@ -219,25 +217,26 @@ let () = (
if (t.outputFile <> "" && not t.silent)
then Printf.eprintf "Generating a %s graph...\n" t.action;
flush stderr;
+ let dir = t.directed in
let g = ( match t.action with
| "void" -> exit 0
- | "clique" -> (gen_clique t.n)
- | "star" -> (gen_star t.n)
- | "ring" -> (gen_ring t.n)
- | "grid" -> (gen_grid t.grid.height t.grid.width)
- | "HC" -> (gen_hyper_cube t.n)
- | "ER" -> (gen_ER t.n t.er)
- | "BA" -> (gen_BA t.n t.ba)
- | "tree" -> (rand_tree t.n)
+ | "clique" -> (gen_clique dir t.n)
+ | "star" -> (gen_star dir t.n)
+ | "ring" -> (gen_ring dir t.n)
+ | "grid" -> (gen_grid dir t.grid.height t.grid.width)
+ | "HC" -> (gen_hyper_cube dir t.n)
+ | "ER" -> (gen_ER dir t.n t.er)
+ | "BA" -> (gen_BA dir t.n t.ba)
+ | "tree" -> (rand_tree dir t.n)
| "UDG" ->
let (graph, plan) =
- gen_udg t.n t.qudg.width t.qudg.height t.qudg.radius
+ gen_udg dir t.n t.qudg.width t.qudg.height t.qudg.radius
in
generate_du_dur graph plan t;
graph
| "QUDG" ->
let (graph, plan) =
- gen_qudg t.n t.qudg.width t.qudg.height t.qudg.radius
+ gen_qudg dir t.n t.qudg.width t.qudg.height t.qudg.radius
t.qudg.r1 t.qudg.p
in
generate_du_dur graph plan t;
diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml
index 8327534e..5a6f7d5e 100644
--- a/tools/graphgen/graphGen_arg.ml
+++ b/tools/graphgen/graphGen_arg.ml
@@ -33,6 +33,7 @@ type t = {
mutable attr : string list;
mutable silent : bool;
+ mutable directed : bool;
mutable _args : (string * Arg.spec * string) list;
mutable _man : (string * (string list * action) list) list;
@@ -81,7 +82,7 @@ let (make_args : unit -> t) =
attr = [];
silent = false;
-
+ directed = false;
_args = [];
_man = [];
@@ -288,6 +289,10 @@ let (mkoptab : string array -> t -> unit) =
[(["Remove all outputs, except the dot output if it is on stdout,";
"and the error if one occurred.\n"],"void")];
+ mkopt args ["--directed";"-dir"]
+ (Arg.Unit (fun () -> args.directed <- true))
+ [(["Generate a directed graph.\n"],"void")];
+
args._man <- ("--attributes, -atr <attributes>...", [([
"Specify the given attributes of the graph to his DOT file.";
"the possible attributes are :";
@@ -309,51 +314,51 @@ let (add_other : t -> string -> unit) =
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 (
- print_usage stdout true argv.(0);
- exit 1 (* no command or invalid command *)));
- let possible_actions =
- ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG";"QUDG"]
- in
- (
- if (List.mem argv.(1) possible_actions) then args.action <- argv.(1)
- else
- if (List.mem argv.(1) ["-h";"--help";"-help"]) then help args (argv.(0)) else
- (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n"
- (argv.(0)) (argv.(1));
- (print_usage stderr true argv.(0));
- exit 1 (* no command or invalid command *))
- );
-
- Arg.parse_argv ~current:current argv args._args (add_other args)
- (usage_msg false (argv.(0)^argv.(1)));
- current := save_current;
- args._others <- List.rev args._others;
- let have_atr = ref false in
- (List.iter (fun o ->
- if !have_atr then (
- if (String.sub o 0 1) = "-" then
- unexpected o
- else
- args.attr <- o::args.attr
- ) else (
- if List.mem o ["--attributes";"-atr"] then
- have_atr := true
- else
- unexpected o
- )
- ) args._others);
- args
- )
- with
- | Arg.Bad msg ->
- Printf.fprintf stderr "*** Error when calling '%s': %s\n" (argv.(0))
- (first_line msg);
- (print_usage stderr true argv.(0)); exit 3 (* bad argument *);
- | Arg.Help _msg ->
- help args argv.(0)
+ let save_current = !current in
+ let args = make_args () in
+ mkoptab argv args;
+ try (
+ (if (Array.length argv) = 1 then (
+ print_usage stdout true argv.(0);
+ exit 1 (* no command or invalid command *)));
+ let possible_actions =
+ ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG";"QUDG"]
+ in
+ (
+ if (List.mem argv.(1) possible_actions) then args.action <- argv.(1)
+ else
+ if (List.mem argv.(1) ["-h";"--help";"-help"]) then help args (argv.(0)) else
+ (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n"
+ (argv.(0)) (argv.(1));
+ (print_usage stderr true argv.(0));
+ exit 1 (* no command or invalid command *))
+ );
+
+ Arg.parse_argv ~current:current argv args._args (add_other args)
+ (usage_msg false (argv.(0)^argv.(1)));
+ current := save_current;
+ args._others <- List.rev args._others;
+ let have_atr = ref false in
+ (List.iter (fun o ->
+ if !have_atr then (
+ if (String.sub o 0 1) = "-" then
+ unexpected o
+ else
+ args.attr <- o::args.attr
+ ) else (
+ if List.mem o ["--attributes";"-atr"] then
+ have_atr := true
+ else
+ unexpected o
+ )
+ ) args._others);
+ args
)
+ with
+ | Arg.Bad msg ->
+ Printf.fprintf stderr "*** Error when calling '%s': %s\n" (argv.(0))
+ (first_line msg);
+ (print_usage stderr true argv.(0)); exit 3 (* bad argument *);
+ | Arg.Help _msg ->
+ help args argv.(0)
+)
diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli
index 70eda6d0..e43518e7 100644
--- a/tools/graphgen/graphGen_arg.mli
+++ b/tools/graphgen/graphGen_arg.mli
@@ -31,6 +31,7 @@ type t = {
mutable attr : string list;
mutable silent : bool;
+ mutable directed : bool;
mutable _args : (string * Arg.spec * string) list;
mutable _man : (string * (string list * action) list) list;
diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml
index 1fb625ad..b87fa292 100644
--- a/tools/graphgen/randomGraph.ml
+++ b/tools/graphgen/randomGraph.ml
@@ -6,8 +6,8 @@ open List
type node_succ_t = (node_id, (int option * node_id) list) Hashtbl.t
type probability = float (*between 0 and 1*)
-let gen_ER : (int -> probability -> Topology.t) =
- fun nb p ->
+let gen_ER : (bool -> int -> probability -> Topology.t) =
+ fun directed nb p ->
let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in
iteri (fun i n ->
iteri (fun j m ->
@@ -22,7 +22,8 @@ let gen_ER : (int -> probability -> Topology.t) =
{
nodes = nl;
succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []);
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
}
@@ -77,8 +78,8 @@ let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int opti
-let gen_BA : (int -> int -> Topology.t) =
- fun nb m ->
+let gen_BA : (bool -> int -> int -> Topology.t) =
+ fun directed nb m ->
let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in
if nb < m + 1 then
failwith (
@@ -88,7 +89,8 @@ let gen_BA : (int -> int -> Topology.t) =
{
nodes = nl;
succ = neighbours_BA nodes m node_succ;
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
}
let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * node_id) list)) =
@@ -105,14 +107,15 @@ let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * no
) [h] (t));
(fun n -> try Hashtbl.find node_succ n with Not_found -> [])
-let (rand_tree: int -> Topology.t) =
- fun nb ->
+let (rand_tree: bool -> int -> Topology.t) =
+ fun directed nb ->
let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in
let nl = id_to_empty_nodes nodes in
{
nodes = nl;
succ = (pre_rand_tree node_succ nodes);
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
}
@@ -128,8 +131,9 @@ let (dist_udg: node_udg -> node_udg -> float) =
let (_,x1,y1) = n1 and (_,x2,y2) = n2 in
sqrt (((x1-.x2)**2.) +. ((y1 -. y2)**2.))
-let gen_qudg : (int -> float -> float -> float -> float -> float -> (Topology.t * plan_udg)) =
- fun nb x y r0 r1 p ->
+let gen_qudg : (bool -> int -> float -> float -> float -> float -> float ->
+ (Topology.t * plan_udg)) =
+ fun directed nb x y r0 r1 p ->
let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in
let pl = (make_plan_udg nodes x y) in
List.iter (fun n_udg ->
@@ -150,8 +154,9 @@ let gen_qudg : (int -> float -> float -> float -> float -> float -> (Topology.t
{
nodes = nl;
succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> []));
- of_id = get_of_id nl
+ of_id = get_of_id nl;
+ directed = directed
},pl
-let gen_udg : (int -> float -> float -> float -> (Topology.t * plan_udg)) =
- fun nb x y r -> (gen_qudg nb x y r 0. 0.)
\ No newline at end of file
+let gen_udg : (bool -> int -> float -> float -> float -> (Topology.t * plan_udg)) =
+ fun directed nb x y r -> (gen_qudg directed nb x y r 0. 0.)
diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli
index 85d6476a..c26f8418 100644
--- a/tools/graphgen/randomGraph.mli
+++ b/tools/graphgen/randomGraph.mli
@@ -7,23 +7,23 @@ type plan_udg = node_udg list
(** [gen_ER n p] generate a graph using Erdos Renyi model,
of n nodes and of probability p for each possible edge to appear. *)
-val gen_ER : (int -> probability -> Topology.t)
+val gen_ER : bool -> int -> probability -> Topology.t
(** [gen_BA n m] generate a graph using Barabasi–Albert model,
of n nodes and with m edges added for each new node.
m has to be lower than n.
The initialization is a star of m+1 nodes, with the (m+1)th node being the root.
Barabasi–Albert model is used for the remaining nodes *)
-val gen_BA : (int -> int -> Topology.t)
+val gen_BA : bool -> int -> int -> Topology.t
(** [rand_tree n] generate a random tree of n nodes *)
-val rand_tree: (int -> Topology.t)
+val rand_tree: bool -> int -> Topology.t
(** [gen_udg nb x y r] generate a graph using the Unit Disc Graph model, of n nodes.
w and h are the width and the height of the area in which the nodes are randomly disposed,
and r is the radius around each node, in which all the other nodes will be neighbors.
*)
-val gen_udg : (int -> float -> float -> float -> (Topology.t * plan_udg))
+val gen_udg : bool -> int -> float -> float -> float -> (Topology.t * plan_udg)
(** [gen_qudg nb x y r0 r1 p] generate a graph using the Quasi Unit Disc Graph model, of n nodes.
w and h are the width and the height of the area in which the nodes are randomly disposed.
@@ -31,4 +31,5 @@ val gen_udg : (int -> float -> float -> float -> (Topology.t * plan_udg))
are neighbors. If d <= r0, they are neighbors. Otherwise, if d <= r1,
they have a probability of p of being neighbors.
*)
-val gen_qudg: (int -> float -> float -> float -> float -> float -> (Topology.t * plan_udg))
+val gen_qudg: bool -> int -> float -> float -> float -> float -> float ->
+ (Topology.t * plan_udg)
--
GitLab