From 9086cfea82d3483105d98f6ae80b5c8ebdcc5070 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 18 Jan 2023 16:54:23 +0100
Subject: [PATCH] feat: add the possibility to generate chain with gg
---
test/Makefile.dot | 10 ++++++++-
tools/gg/classicGraph.ml | 46 +++++++++++++++++++++++++++------------
tools/gg/classicGraph.mli | 18 ++++++++-------
tools/gg/graphGen.ml | 1 +
tools/gg/graphGen_arg.ml | 21 +++++++++---------
5 files changed, 63 insertions(+), 33 deletions(-)
diff --git a/test/Makefile.dot b/test/Makefile.dot
index 18f2db37..c5f16311 100644
--- a/test/Makefile.dot
+++ b/test/Makefile.dot
@@ -1,4 +1,4 @@
-# Time-stamp: <modified the 16/01/2023 (at 15:45) by Erwan Jahier>
+# Time-stamp: <modified the 18/01/2023 (at 16:52) by Erwan Jahier>
# Rules to generate various dot files.
# The DECO_PATTERN variable should be defined
@@ -30,6 +30,14 @@ qudg%.dot:
gg QUDG -n $* -w 10 -o $@ $(SEED)
gg-deco $(DECO_PATTERN) $@ -o $@
+chain%.dot:
+ gg chain -n $* -o $@ $(SEED)
+ gg-deco $(DECO_PATTERN) $@ -o $@
+
+dichain%.dot:
+ gg chain -dir -n $* -o $@ $(SEED)
+ gg-deco $(DECO_PATTERN) $@ -o $@
+
ring%.dot:
gg ring -n $* -o $@ $(SEED)
gg-deco $(DECO_PATTERN) $@ -o $@
diff --git a/tools/gg/classicGraph.ml b/tools/gg/classicGraph.ml
index 6b6d40c0..b35bc59a 100644
--- a/tools/gg/classicGraph.ml
+++ b/tools/gg/classicGraph.ml
@@ -63,7 +63,7 @@ let (gen_star: bool -> int -> Topology.t) =
List.iter (fun n -> Hashtbl.add node_succ "root" n) nodes;
List.iter (fun n -> Hashtbl.add node_pred n (1,"root")) nodes;
- update_tbl directed node_succ node_pred;
+ update_tbl directed node_succ node_pred;
let nl = id_to_empty_nodes ("root"::nodes) in
{
nodes = nl;
@@ -74,14 +74,16 @@ let (gen_star: bool -> int -> Topology.t) =
attributes = []
}
-let neighbours_ring dir nodes =
- let nb = length nodes in
+let neighbours_ring_chain dir chain nodes =
+ let nb = length nodes in
let node_succ:node_succ_t = Hashtbl.create nb in
let (node_pred:node_pred_t) = Hashtbl.create nb in
let nodes2 = match nodes with
- | n1::t -> t@[n1]
+ | n1::t -> t@[n1] (* circular permutation *)
| _ -> assert false
in
+ let nodes = if chain then List.tl nodes else nodes
+ and nodes2 = if chain then List.tl nodes2 else nodes2 in (* cut the ring to get a chain *)
List.iter2 (fun n1 n2 ->
Hashtbl.add node_succ n1 n2;
Hashtbl.add node_pred n2 (1,n1)
@@ -91,11 +93,27 @@ let neighbours_ring dir nodes =
(fun n -> Hashtbl.find_all node_succ n),
(fun n -> Hashtbl.find_all node_pred n)
+
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
- let succ, pred = neighbours_ring directed nodes in
+ let succ, pred = neighbours_ring_chain directed false nodes in
+ {
+ nodes = nl;
+ succ = succ;
+ pred = pred;
+ of_id = get_of_id nl;
+ directed = directed;
+ attributes = []
+ }
+
+
+let (gen_chain: bool -> int -> Topology.t) =
+ fun directed nb ->
+ let nodes = (create_nodes "p" (0,nb)) in
+ let nl = id_to_empty_nodes nodes in
+ let succ, pred = neighbours_ring_chain directed true nodes in
{
nodes = nl;
succ = succ;
@@ -107,7 +125,7 @@ let (gen_ring: bool -> int -> Topology.t) =
let (gen_grid: bool -> int -> int -> Topology.t) =
- fun directed length width ->
+ fun directed length width ->
Printf.eprintf "Computing a %ix%i grid...\n" length width;
flush stderr;
let nb = length*width in
@@ -148,13 +166,13 @@ let (gen_grid: bool -> int -> int -> Topology.t) =
let rec link_hypercube_nodes :
(node_id array -> node_succ_t -> node_pred_t -> unit) =
- fun na n_s n_p ->
+ fun na n_s n_p ->
let len = Array.length na in
let mid = len / 2 in
- if len > 1 then
+ 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 n_p;
+ link_hypercube_nodes n1 n_s n_p;
link_hypercube_nodes n2 n_s n_p;
Array.iter2 (fun node1 node2 ->
if node1 < node2 then (
@@ -163,9 +181,9 @@ let rec link_hypercube_nodes :
) n1 n2
let (neighbours_hyper_cube : bool -> node_id list ->
- (node_id -> node_id list) * (node_id -> (int * node_id) list)) =
- fun dir nl ->
- let na = Array.of_list nl in
+ (node_id -> node_id list) * (node_id -> (int * node_id) list)) =
+ fun dir nl ->
+ let na = Array.of_list nl in
let (node_succ:node_succ_t) = Hashtbl.create (Array.length na) in
let (node_pred:node_pred_t) = Hashtbl.create (Array.length na) in
link_hypercube_nodes na node_succ node_pred;
@@ -173,8 +191,8 @@ let (neighbours_hyper_cube : bool -> node_id list ->
(fun n -> Hashtbl.find_all node_succ n),
(fun n -> Hashtbl.find_all node_pred n)
-let gen_hyper_cube : (bool -> int -> Topology.t) =
- fun directed 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
diff --git a/tools/gg/classicGraph.mli b/tools/gg/classicGraph.mli
index 075ede36..849ecf29 100644
--- a/tools/gg/classicGraph.mli
+++ b/tools/gg/classicGraph.mli
@@ -1,19 +1,21 @@
open Sasacore
-(** Generate a clique graph of n nodes; the bool states whether the
+(** Generate a clique 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 *)
+(** Generate a star of n nodes *)
val gen_star : bool -> int -> Topology.t
-
-(** Generate a ring graph of n nodes *)
+
+(** Generate a ring of n nodes *)
val gen_ring : bool -> int -> Topology.t
+(** Generate a chain of n nodes *)
+val gen_chain : bool -> int -> Topology.t
+
(** Take the two dimensions i,j of the grid and return a grid graph
- with these dimensions *)
+ 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 : bool -> 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/gg/graphGen.ml b/tools/gg/graphGen.ml
index 90e5a6e5..c39e8d9f 100644
--- a/tools/gg/graphGen.ml
+++ b/tools/gg/graphGen.ml
@@ -246,6 +246,7 @@ let () = (
| "clique" -> (gen_clique dir t.n)
| "star" -> (gen_star dir t.n)
| "ring" -> (gen_ring dir t.n)
+ | "chain" -> (gen_chain 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)
diff --git a/tools/gg/graphGen_arg.ml b/tools/gg/graphGen_arg.ml
index 3314a6c4..d0c8db1e 100644
--- a/tools/gg/graphGen_arg.ml
+++ b/tools/gg/graphGen_arg.ml
@@ -83,8 +83,8 @@ let (make_args : unit -> t) =
r1 = 2.;
p = 0.5;
};
-
- seed = None;
+
+ seed = None;
silent = false;
connected = false;
directed = false;
@@ -136,11 +136,12 @@ let help args tool = (
if (args.action = "void") then (
Printf.printf "where <graph-kind> can be:\n";
List.iter (printSpec args stdout "") [
- ("clique",[(["Generate a clique graph"],"")]);
- ("star",[(["Generate a star graph"],"")]);
- ("ring",[(["Generate a ring graph"],"")]);
- ("grid",[(["Generate a grid graph"],"")]);
- ("HC",[(["Generate a hyper-cube graph"],"")]);
+ ("clique",[(["Generate a clique"],"")]);
+ ("star",[(["Generate a star"],"")]);
+ ("ring",[(["Generate a ring"],"")]);
+ ("chain",[(["Generate a chain"],"")]);
+ ("grid",[(["Generate a grid"],"")]);
+ ("HC",[(["Generate a hyper-cube"],"")]);
("ER",[(["Generate a graph using the Erdos Renyi algo"],"")]);
("BA",[(["Generate a graph using the Barabasi–Albert algo"],"")]);
("tree",[(["Generate a tree"],"")]);
@@ -186,7 +187,7 @@ let (mkoptab : string array -> t -> unit) =
(Arg.Int (fun n -> match args.action with
| "grid" | "HC" | "void" -> unexpected "-n"
| _ -> args.n <- n ))
- [([msg],"clique");([msg],"star");([msg],"ring");
+ [([msg],"clique");([msg],"star");([msg],"ring");([msg],"chain");
([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG");([msg],"QUDG")];
mkopt args ["--in-tree"]
@@ -319,7 +320,7 @@ let (mkoptab : string array -> t -> unit) =
mkopt args ["--directed";"-dir"]
(Arg.Unit (fun () -> match args.action with
- | "ring" -> args.directed <- true
+ | "ring" | "chain" -> args.directed <- true
| _ -> unexpected "-dir/--directed" ))
[(["Generate a directed graph"],"ring")];
@@ -345,7 +346,7 @@ let parse argv = (
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"]
+ ["clique";"star";"ring";"chain";"grid";"HC";"ER";"BA";"tree";"UDG";"QUDG"]
in
(
if (List.mem argv.(1) possible_actions) then args.action <- argv.(1)
--
GitLab