modifications so that the code compiles

lib/sasacore/dune

-;; Time-stamp: <modified the 06/09/2019 (at 10:09) by Erwan Jahier>
+;; Time-stamp: <modified the 14/10/2019 (at 20:15) by Erwan Jahier>
 
 (library
  (name     sasacore)
  (public_name  sasacore)
- (libraries  ocamlgraph lutils)
+ (libraries dynlink ocamlgraph lutils)
 
   ;; 
 ; (wrapped false)

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 14/10/2019 (at 14:33) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/10/2019 (at 16:50) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -102,8 +102,10 @@ let (do_stmt: bool -> node list -> Dot_ast.stmt -> node list) =
                "Bad topology: %s can not ne a neighbor of itself!" n1);
         let pn1 = try Hashtbl.find node_succ n1 with Not_found -> [] in
         let pn2 = try Hashtbl.find node_succ n2 with Not_found -> [] in
-        Hashtbl.replace node_succ n1 ((weight,n2)::pn1);
-        if not directed then Hashtbl.replace node_succ n2 ((None,n1)::pn2);
+        if not (List.mem (weight,n2) pn1) then
+          Hashtbl.replace node_succ n1 ((weight,n2)::pn1);
+        if not directed && not (List.mem (None,n1) pn2) then
+          Hashtbl.replace node_succ n2  ((None,n1)::pn2);
         n2
       in
       ignore (List.fold_left add_edge node nodes);
@@ -127,54 +129,6 @@ let (read: string -> t) = fun f ->
       )
   }
 
-
-let make_links_dot : (t -> string) =
-  fun t ->
-    let links = List.flatten (
-      List.map (fun n ->
-            let l = t.succ n.id in
-            List.map (fun (w,neighbour) ->
-                (
-                  match w with
-                  | None -> if n.id < neighbour then
-                    Printf.sprintf ("  %s -- %s") n.id neighbour
-                  else
-                    Printf.sprintf ("  %s -- %s") neighbour n.id
-                  | Some x ->
-                    Printf.sprintf ("  %s -- %s [weight=%d]") n.id neighbour x
-                )
-
-              ) l
-      ) t.nodes
-    ) in
-    String.concat "\n" (List.sort_uniq compare links)
-
-let rec make_nodes_dot : (node list -> string) =
-  (*Create a string in the dot syntax from a node list*)
-  function
-  | [] -> ""
-  | (node)::tail -> (
-    Printf.sprintf "  %s [algo=\"%s\"]\n%s" node.id node.file) (make_nodes_dot tail)  
-                  
-let make_dot : (t -> string -> unit) =
-  (*Create a dot file from a graph*)
-  fun t file_name ->
-    let name = ref "graph0" in
-    let f = (if file_name = "" then stdout else
-      (
-        name := Filename.basename 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
-    Printf.fprintf f "%s" dot
-    (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*)
-
 let (to_adjency: t -> bool array array) =
   fun t ->
     let n = List.length t.nodes in
@@ -188,4 +142,73 @@ let (to_adjency: t -> bool array array) =
       )
       t.nodes;
     m
-
+let (get_degree:t -> int*int) =
+  fun t -> if t.nodes = [] then 0,0
+    else
+      let node_deg n = List.length (t.succ (n.id)) in
+      let d_start = node_deg ((List.hd t.nodes)) in
+      List.fold_left (fun (d_min,d_max) n ->
+          (min (node_deg n) d_min, max (node_deg n) d_max)
+      ) (d_start,d_start) (List.tl t.nodes)
+
+(* take a graph t and a boolean is_oriented and return the number of
+   link in the graph *)
+let (get_nb_link: t -> bool -> int) =
+  fun t is_oriented ->
+    if not is_oriented then
+      (List.fold_left
+         (fun acc n -> ((List.length (t.succ n.id))) + acc) (0) (t.nodes)) / 2
+    else
+      (List.fold_left
+         (fun acc n -> ((List.length (t.succ n.id))) + acc) (0) (t.nodes))
+
+let (get_mean_degree : t -> float) = 
+  fun t -> 
+    (float_of_int (get_nb_link t true)) /. (float_of_int (List.length t.nodes))
+
+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 is_connected_and_cyclic : t -> bool*bool = 
+  fun t -> match t.nodes with
+    | [] -> (false,false)
+    | hd::_ ->
+      let (cyclic,bfs_nodes) = (bfs t hd.id) in
+      ((List.compare_lengths t.nodes bfs_nodes) = 0, cyclic)
+
+let rec height : string list -> t -> string -> int = 
+  fun parents t n ->
+    (List.fold_left (fun h (_,succ) -> 
+         if List.mem succ parents then
+           h
+         else
+           max h (height (n::parents) t succ)) (-1) (t.succ n)) + 1
+
+let get_height : t -> string -> int = 
+  fun t -> 
+    height ([]) t
+
+(********************************************)
+  

lib/sasacore/topology.mli

-(* Time-stamp: <modified the 05/07/2019 (at 16:19) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/10/2019 (at 16:55) by Erwan Jahier> *)
 
 type node_id = string
 type node = {
@@ -17,17 +17,13 @@ type t = {
 (** Parse a sasa dot file *)
 val read: string -> t
 
-
-(** Create a string containing the links of the graph given in argument in a DOT syntax *)
-val make_links_dot : (t -> string)
-
-(** Create a string containing the nodes given in argument in a DOT syntax *)
-val make_nodes_dot : (node list -> string)
-
-(** Create a DOT file from a graph *)
-val make_dot : (t -> string -> unit)
+val to_adjency: t -> bool array array
+val get_degree: t -> int*int    
+val get_nb_link: t -> bool -> int
+val get_mean_degree : t -> float
+val is_connected_and_cyclic : t -> bool*bool
+val height : string list -> t -> string -> int
+val get_height : t -> string -> int
 
 
-val to_adjency: t -> bool array array
-    
 

test/rdbg-utils/dot.ml

@@ -123,7 +123,8 @@ let to_pdf engine par_var g f e =
             let enabled = if enabled = "" then "" else (enabled^"|") in
             let loc = String.concat "|"
                 (List.map (fun (n,v) ->
-                     Printf.sprintf "%s=%s" n (Data.val_to_string string_of_float v))
+                     Printf.sprintf "%s=%s" n
+                       (Data.val_to_string string_of_float v))
                     pid.vars
                 )
             in
@@ -161,7 +162,8 @@ let to_pdf engine par_var g f e =
   let trans_dir,trans_undir = List.partition is_directed trans in
   let trans_dir_str = String.concat "\n" trans_dir in
   let trans_undir_str = String.concat "\n" trans_undir in
-  let trans_undir_str = Str.global_replace (Str.regexp "--") "->" trans_undir_str in
+  let trans_undir_str =
+    Str.global_replace (Str.regexp "--") "->" trans_undir_str in
   let trans_str =
     (*     if trans_dir_str = "" then trans_undir_str else *)
     Printf.sprintf "subgraph dir {\n\t%s} 

tools/ggDeco/ggDeco.ml

+open GgDeco_Arg
 open Sasacore
 open Topology
 
-open GgDeco_Arg
 
 exception Crossover (* Two different intervals crossover each-other *)
 exception No_file_for of int
@@ -51,6 +51,62 @@ let deco : (Topology.t -> files_spec_t list -> Topology.t) =
       of_id = g.of_id;
     }
 
+    
+(**********************************************************)
+(* XXX duplicated from GraphGen !! *)
+let to_dot_string  : (t -> string -> string) =
+  fun g name ->
+  let node_to_node_string n =
+    Printf.sprintf "  %s [algo=\"%s\"]\n" n.id n.file
+  in
+  let nodes = String.concat "\n" (List.map node_to_node_string g.Topology.nodes) in
+
+  let node_to_link_string n =
+    let succ = g.succ n.id in
+    let links =
+      List.map
+        (fun (w,neighbour) ->
+          (match w with
+           | None ->
+              if n.id < neighbour then
+                Printf.sprintf ("  %s -- %s") n.id neighbour
+              else
+                Printf.sprintf ("  %s -- %s") neighbour n.id
+           | Some x ->
+              Printf.sprintf ("  %s -- %s [weight=%d]") n.id neighbour x
+          )
+        )
+        succ
+    in
+    links
+  in
+  let links = List.map node_to_link_string g.nodes in
+  let links = List.sort_uniq compare (List.flatten links) in 
+  let links = String.concat "\n" links in
+  Printf.sprintf "graph %s {\n\n%s\n%s\n}\n" name nodes links 
+
+                  
+let make_dot : (t -> string -> unit) =
+  (*Create a dot file from a graph*)
+  fun t file_name ->
+  let name = ref "graph0" in
+  let dot = to_dot_string t file_name in
+  let oc = if file_name = "" then stdout
+          else (
+            name := Filename.basename 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
+  Printf.fprintf oc "%s\n" dot
+    (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*)
+(**********************************************************)
+
 let () = (
     let args = parse Sys.argv in 
     let g = read args.dot_file in

tools/graphgen/graphGen.ml

-open Sasacore
-open Topology
 (* open GraphProp *)
 
 open ClassicGraph
 open RandomGraph
 open GraphGen_arg
 open UdgUtils
+open Sasacore
+open Topology
 
 exception Incorrect_attribute
 
 let min_max = ref None 
 let connected_cyclic = ref None  
-let height = ref None
+let height:int option ref = ref None
 
 let generate_du_dur graph plan_udg t : unit =
   
@@ -24,7 +24,7 @@ let generate_du_dur graph plan_udg t : unit =
   );
   ()
 
-let compute_attr : (Topology.t -> string list -> (string*string) list) =
+let compute_attr : (Topology.t -> string list -> (string * string) list) =
   fun g ->
   List.map
     (fun attr -> 
@@ -71,55 +71,105 @@ let compute_attr : (Topology.t -> string list -> (string*string) list) =
                    (fst x) && (snd x))
                  | Some x -> (fst x) && (snd x) )
            | "links_number" -> string_of_int (get_nb_link g false)
-           | "diameter" -> string_of_int (get_diameter 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 to_dot_string  : (t -> string -> string) =
+  fun g name ->
+  let node_to_node_string n =
+    Printf.sprintf "  %s [algo=\"%s\"]\n" n.id n.file
+  in
+  let nodes = String.concat "\n" (List.map node_to_node_string g.nodes) in
+
+  let node_to_link_string n =
+    let succ = g.succ n.id in
+    let links =
+      List.map
+        (fun (w,neighbour) ->
+          (match w with
+           | None ->
+              if n.id < neighbour then
+                Printf.sprintf ("  %s -- %s") n.id neighbour
+              else
+                Printf.sprintf ("  %s -- %s") neighbour n.id
+           | Some x ->
+              Printf.sprintf ("  %s -- %s [weight=%d]") n.id neighbour x
+          )
+        )
+        succ
+    in
+    links
+  in
+  let links = List.map node_to_link_string g.nodes in
+  let links = List.sort_uniq compare (List.flatten links) in 
+  let links = String.concat "\n" links in
+  Printf.sprintf "graph %s {\n\n%s\n%s\n}\n" name nodes links 
+
+                  
+let make_dot : (t -> string -> (string * string) list -> unit) =
+  (*Create a dot file from a graph*)
+  fun t file_name _attrs ->
+  let name = ref "graph0" in
+  let dot = to_dot_string t file_name in
+  let oc = if file_name = "" then stdout
+          else (
+            name := Filename.basename 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
+  Printf.fprintf oc "%s\n" dot
+    (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*)
 
 let () = (
-  let t = parse Sys.argv in
+    let t = parse Sys.argv in
 
-  if (t.n < 0) then (
-    let msg = match t.action with
-     | "void" | "grid" -> ""
-     | "HC" -> (
-                  t.n <- 3;
-                  "=========================================================================\n"^
-                  "Caution : the dimension is not defined or negative. It has been set to 3.\n"^
-                  "=========================================================================\n"
-               )
-     | _ -> (
-              t.n <- 10;
-              "=============================================================================\n"^
-              "Caution : the nodes number is not defined or negative. It has been set to 10.\n"^
+    if (t.n < 0) then (
+      let msg = match t.action with
+        | "void" | "grid" -> ""
+        | "HC" -> (          
+          t.n <- 3;
+          "=========================================================================\n"^
+            "Caution : the dimension is not defined or negative. It has been set to 3.\n"^
+              "=========================================================================\n"
+        )
+        | _ -> (
+          t.n <- 10;
+          "=============================================================================\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
-  );
-  if (t.outputFile <> "" && not t.silent) 
+        ) in
+      if (not t.silent) then Printf.fprintf stderr "%s" msg
+    );
+    if (t.outputFile <> "" && not t.silent) 
     then Printf.printf "Generating a %s graph...\n" t.action;
-  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)
-    | "UDG" -> (let (graph, plan) = gen_udg 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 t.qudg.r1 t.qudg.p in
-                generate_du_dur graph plan t; graph)
-    | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" 
-      (String.concat " " (Array.to_list Sys.argv)); assert false)
-  ) 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)
+              | "UDG" -> (let (graph, plan) = gen_udg 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 t.qudg.r1 t.qudg.p in
+                           generate_du_dur graph plan t; graph)
+              | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" 
+                        (String.concat " " (Array.to_list Sys.argv)); assert false)
+            ) in
     make_dot g t.outputFile (compute_attr g t.attr);
-  if (t.outputFile <> "" && not t.silent) 
+    if (t.outputFile <> "" && not t.silent) 
     then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile
-)
+  )

tools/graphgen/udgUtils.ml

@@ -33,42 +33,71 @@ let compute_mean_degree : (int -> float -> float -> float -> float) =
 (******************************************************************************)
 
 let rec make_nodes_dot_udg : (node_udg list -> float -> float -> string) =
-      (*Create a string in the dot syntax from a node list*)
-      fun nudg r0 r1 ->
-      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 (r0 > 0.) then
-           (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" 
-              node x y (2.*.r0) (2.*.r0) ) else "")^
-           if(r1 > r0) then
-           (Printf.sprintf "%srad2 [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"lightblue\"]\n" 
-              node x y (2.*.r1) (2.*.r1) ) else "" in
-         draw_rad^(make_nodes_dot_udg tail r0 r1)
+  (*Create a string in the dot syntax from a node list*)
+  fun nudg r0 r1 ->
+  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 (r0 > 0.) then
+                         (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" 
+                            node x y (2.*.r0) (2.*.r0) ) else "")^
+                        if(r1 > r0) then
+                          (Printf.sprintf "%srad2 [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"lightblue\"]\n" 
+                             node x y (2.*.r1) (2.*.r1) ) else "" in
+       draw_rad^(make_nodes_dot_udg tail r0 r1)
 
-let make_dot_udg_qudg : (Topology.t -> plan_udg -> (float*float) -> ?r0:float  -> ?r1:float  -> string -> unit) =
-           (*Create a dot file from a graph*)
-           fun t plan dim ?(r0 = 0.) ?(r1 = 0.) 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". *)
+(* XXX duplicates GraphGen.to_dot_string *)
+let make_links_dot g =
+  let node_to_link_string n =
+    let succ = g.succ n.id in
+    let links =
+      List.map
+        (fun (w,neighbour) ->
+          (match w with
+           | None ->
+              if n.id < neighbour then
+                Printf.sprintf ("  %s -- %s") n.id neighbour
+              else
+                Printf.sprintf ("  %s -- %s") neighbour n.id
+           | Some x ->
+              Printf.sprintf ("  %s -- %s [weight=%d]") n.id neighbour x
+          )
+        )
+        succ
+    in
+    links
+  in
+  let links = List.map node_to_link_string g.nodes in
+  let links = List.sort_uniq compare (List.flatten links) in 
+  let links = String.concat "\n" links in
+  links
+
+       
+let make_dot_udg_qudg : (Topology.t -> plan_udg -> (float*float) ->
+                         ?r0:float  -> ?r1:float  -> string -> unit) =
+  (*Create a dot file from a graph*)
+  fun t plan dim ?(r0 = 0.) ?(r1 = 0.) 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(r0 > 0. || r1 > 0.) 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) 
+               open_out file_name
+             )
+          ) in
+  let (w,l) = dim in
+  let mpos = if(r0 > 0. || r1 > 0.) 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 r0 r1) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in
-             Printf.fprintf f "%s" dot;
-             flush f;
-             close_out f
+  let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos
+            ^(make_nodes_dot_udg plan r0 r1) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in
+  Printf.fprintf f "%s" dot;
+  flush f;
+  close_out f