Fix: gg BA --directed should not be possible

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 05/03/2020 (at 17:14) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/03/2020 (at 14:54) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -23,7 +23,11 @@ let node_info:node_info_t = Hashtbl.create 100
 
 type node_succ_t = (string, (int * node_id) list) Hashtbl.t
 let node_succ:node_succ_t = Hashtbl.create 100
-        
+
+let clean_tbl () = 
+  Hashtbl.clear node_info;
+  Hashtbl.clear node_succ
+    
 let (of_id:Dot_ast.id -> string) =
   function Ident str | Html str | Number str | String str -> str
 
@@ -120,6 +124,7 @@ let (do_stmt: bool -> node list -> Dot_ast.stmt -> node list) =
 
 
 let (read: string -> t) = fun f ->
+  clean_tbl ();
   let dot_file = Graph.Dot.parse_dot_ast f in
   assert (not dot_file.strict);
   let res = List.fold_left (do_stmt dot_file.digraph) [] dot_file.stmts in
@@ -167,28 +172,28 @@ let (get_mean_degree : t -> float) =
 
 let bfs : (t -> string -> bool * string list) = 
   fun t n ->
-    let q = Queue.create () in
-    let discovered = ref [n] and parent = ref (function _ -> "") in
-    let cyclic = ref false in
-    Queue.add n q;
-    while not (Queue.is_empty q) do
-      let node = Queue.take q in
-      parent := List.fold_left (fun parents (_,suc) -> 
-                  if List.for_all (fun disc -> disc <> suc) !discovered 
-                  then (
-                    Queue.add suc q;
-                    discovered := (suc)::!discovered;
-                    function a -> if a = suc then node else parents a
-                  ) else ((
-                    if suc <> (parents node) 
-                    then 
-                      cyclic := true);
-                    parents
-                  )
-                ) !parent (t.succ node)
-
-    done;
-    (!cyclic, !discovered)
+  let q = Queue.create () in
+  let discovered = ref [n] and parent = ref (function _ -> "") in
+  let cyclic = ref false in
+  Queue.add n q;
+  while not (Queue.is_empty q) do
+    let node = Queue.take q in
+    parent := List.fold_left (fun parents (_,suc) -> 
+        if List.for_all (fun disc -> disc <> suc) !discovered 
+        then (
+          Queue.add suc q;
+          discovered := (suc)::!discovered;
+          function a -> if a = suc then node else parents a
+        ) else ((
+            if suc <> (parents node) 
+            then 
+              cyclic := true);
+           parents
+          )
+      ) !parent (t.succ node)
+
+  done;
+  (!cyclic, !discovered)
 
 let is_connected_and_cyclic : t -> bool*bool = 
   fun t -> match t.nodes with

tools/graphgen/graphGen_arg.ml

@@ -252,13 +252,13 @@ let (mkoptab : string array -> t -> unit) =
         "When it transformed into a PDF that takes the positioning tags into account"; 
         "(like 'neato' command from GraphViz), each node is visible at the coordinates";
         "where they were placed during execution.\n"] in
-    mkopt args ["--dot_udg";"-du"]~arg:" <file>"
+    mkopt args ["--dot-udg";"-du"]~arg:" <file>"
       (Arg.String (fun f -> match args.action with
                             | "UDG" | "QUDG" -> args.dotUDG <- f
                             | _ -> unexpected "-du"))
       [(msg,"UDG");(msg,"QUDG")];
 
-    mkopt args ["--dot_udg_radius";"-dur"]~arg:" <file>"
+    mkopt args ["--dot-udg-radius";"-dur"]~arg:" <file>"
       (Arg.String (fun f -> match args.action with
                             | "UDG" | "QUDG" -> args.dotUDGrad <- f
                             | _ -> unexpected "-dur"))

tools/graphgen/randomGraph.ml

@@ -48,61 +48,72 @@ let rec init_m_nodes : (int -> node_succ_t -> node_id list -> node_id list) =
     else node::tail
   | _ -> assert false
 
-let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int * node_id) list)) =
+let (neighbours_BA : node_id list -> int -> node_succ_t ->
+     (node_id -> (int * node_id) list)) =
   fun nodes m node_succ ->
-    let d_tot = 2 * m and nodes = init_m_nodes m node_succ nodes in
-    match nodes with
-     | [] -> assert false
-     | head::nodes -> Hashtbl.replace node_succ head (
-         Hashtbl.fold
-           (fun n _ succ ->
-              Hashtbl.replace node_succ n [(1,head)];
-              (1,n)::succ) node_succ []
+  let d_tot = 2 * m in
+  let nodes = init_m_nodes m node_succ nodes in
+  match nodes with
+  | [] -> assert false
+  | head::nodes ->
+    Hashtbl.replace node_succ head
+      (Hashtbl.fold
+          (fun n _ succ ->
+             Hashtbl.replace node_succ n [(1,head)];
+             (1,n)::succ) node_succ []
+      );
+    (*init terminée. On a un graph connexe pour les m+1 premiers points,
+      nl ne contient que les points non ajoutés*)
+    ignore (
+      fold_left
+        (fun deg_tot node ->
+           let deg_temp = deg_tot in
+           let succ = ref [] in
+           let deg_temp = ref deg_temp in
+           for _ = 0 to m-1 do (*for each edge to create*)
+             let ran = Random.int !deg_temp in
+             ignore (
+               Hashtbl.fold
+                 (fun n_id n_succ r ->
+                    if r >= 0 && not (List.mem (1,n_id) !succ) then
+                      let r = r - (length n_succ) in 
+                      if r < 0 then (
+                        succ := (1,n_id)::!succ;
+                        Hashtbl.replace node_succ n_id
+                          ((1,node)::n_succ);
+                        deg_temp := !deg_temp - length n_succ
                       );
-    (*init terminée. On a un graph connexe pour les m+1 premiers points, nl ne contient que les points non ajoutés*)
-    ignore (fold_left (fun deg_tot node ->
-
-      let deg_temp = deg_tot and succ = ref [] in
-      let deg_temp = ref deg_temp in
-
-      for _ = 0 to m-1 do (*for each edge to create*)
-        let ran = Random.int !deg_temp in
-        ignore (Hashtbl.fold (fun n_id n_succ r ->
-          if r >= 0 && not (List.mem (1,n_id) !succ) then
-            let r = r - (length n_succ) in (
-              if r < 0 then
-                (succ := (1,n_id)::!succ;
-                Hashtbl.replace node_succ n_id
-                 ((1,node)::n_succ);
-                deg_temp := !deg_temp - length n_succ)
-            ); r
-          else r
-        ) node_succ ran);
-
-      done;
-
-
-      Hashtbl.replace node_succ node !succ;
-      (deg_tot + (2 * m))
-
-    ) d_tot nodes);
+                      r
+                    else r
+                 )
+                 node_succ ran);
+           done;
+           Hashtbl.replace node_succ node !succ;
+           (deg_tot + (2 * m))
+        )
+        d_tot
+        nodes
+    );
     (fun n -> try Hashtbl.find node_succ n with Not_found -> [])
 
-
-
-
-
 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 directed then (
+    Printf.eprintf "A Barabasi–Albert graph cannot be directed\n%!";
+    exit 2
+  );
+  let (node_succ:node_succ_t) = Hashtbl.create nb
+  and nodes = create_nodes "p" (0,nb) in
     if nb < m + 1 then 
-    failwith (
-       Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1));
-    
+     (Printf.eprintf
+        "Error: with -m %d, the node number needs to be at least %d (it is %d).\n%!"
+        m (m+1) nb;
+      exit 2
+    );
     let nl = id_to_empty_nodes nodes in
     {
       nodes = nl;
-      succ = neighbours_BA nodes m node_succ;
+      succ = neighbours_BA  nodes m node_succ;
       of_id = get_of_id nl;
       directed = directed
     }