Compute the distance using the Floyd-Marshall algorithm

(which was actualy already there for the diameter)

lib/sasacore/diameter.ml

-
-(* take a string and the list of all node and returns the position of the node in the list *)                          
-let (pos:string -> Topology.node list -> int) =
-  fun nid lid -> 
-  fst (List.fold_left (fun (found_i,i) lid -> if (nid=lid.Topology.id) then (i,i+1) else (found_i,i+1) ) (-1, 0) lid)
-
-(* take a graph t and returns the Adjacency matrix of t *)                                 
-let (graph_to_adjency: Topology.t -> int array array) =
-  fun t->
-  let taille = List.length t.nodes in
-  let mat = Array.make_matrix (taille) (taille) 0 in
-  List.iter (fun n ->
-      (List.iter (fun (m) ->  mat.(pos n.Topology.id t.nodes).(pos m t.nodes) <- 1 )
-         (t.succ n.Topology.id) ) ) (t.nodes);
-  mat
-
-    
-(* Initialize the Adjacency matrix for Floyd Warshall algorithm *)
-let (initFW: int array array -> int array array) =
-  fun m ->
-  let n = (Array.length m.(0)) in
-  for i=0 to (n - 1) do
-    for j=0 to (n - 1) do
-      if (i<>j) then
-        (if (m.(i).(j)=1) then m.(i).(j) <- 1 else m.(i).(j) <- n+1)
-          else m.(i).(j) <- 0
-      done;
-  done;
-  m
-
-
-(* Apply Floyd Warshall algorithm which gives the matrix of all pairs shortest path *)
-let (floydwarshall:int array array -> int array array) =
-  fun m ->
-  let w = initFW m in 
-  let n = (Array.length m.(0)) in
-  for k=0 to (n - 1) do
-    for i=0 to (n - 1) do
-      for j=0 to (n - 1) do
-        w.(i).(j) <- (min (w.(i).(j)) (w.(i).(k) + w.(k).(j)))
-        done;
-      done;
-  done;
-  w
-
-
-(* returns the greatest int of a matrix *)
-let (max_mat: int array array -> int) =
-  fun mat ->
-  let n = (Array.length mat) and m = (Array.length mat.(0)) in
-  let maxi = ref (-1) in
-  for i=0 to (n - 1) do
-    for j=0 to (m - 1) do
-      maxi := max !maxi mat.(i).(j)
-    done;
-  done;
-  !maxi
-
-(* takes a graph t in argument and returns the diameter *)
-let (get: Topology.t -> int ) =
-  fun t ->
-  let d = (max_mat(floydwarshall (graph_to_adjency t))) in
-  Printf.eprintf " ====> The Graph Diameter is %d \n%!" d;
-  d

lib/sasacore/diameter.mli

-
-(** Watch out, computing the diameter can be very expensive *)
-
-val get : Topology.t -> int

lib/sasacore/register.ml

-(* Time-stamp: <modified the 11/10/2021 (at 14:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 21/02/2024 (at 09:44) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;
@@ -340,7 +340,7 @@ let (diameter : unit -> int) =
   match tbls.diameter with
   | Some x -> x
   | None ->
-    let x = Diameter.get (get_topology ()) in
+    let x = Topology.diameter (get_topology ()) in
     tbls.diameter <- Some x;
     x
 

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 20/06/2023 (at 22:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 21/02/2024 (at 10:00) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -90,27 +90,92 @@ let rec (get_weight: Dot_ast.attr -> int) =
 
 type attrs = (string * string) list
 
-(* compute the distance between 2 nodes in g denoted by their position in g.nodes *)
-module StrSet = Set.Make(String)
+(**********************************************************************************)
+(* compute the distance between 2 nodes in g denoted by their position in g.nodes
+   using the Floyd Warshall algorithm
+*)
+(* take a string and the list of all node and returns the position of the node in the list *)
+let (pos:string -> node list -> int) =
+  fun nid lid ->
+  fst (List.fold_left (fun (found_i,i) lid -> if (nid=lid.id) then (i,i+1) else (found_i,i+1) ) (-1, 0) lid)
+
+(* take a graph t and returns the Adjacency matrix of t *)
+let (graph_to_adjency: t -> int array array) =
+  fun t->
+  let taille = List.length t.nodes in
+  let mat = Array.make_matrix (taille) (taille) 0 in
+  List.iter (fun n ->
+      (List.iter (fun (m) ->  mat.(pos n.id t.nodes).(pos m t.nodes) <- 1 )
+         (t.succ n.id) ) ) (t.nodes);
+  mat
+
+
+(* Initialize the Adjacency matrix for Floyd Warshall algorithm *)
+let (initFW: int array array -> int array array) =
+  fun m ->
+  let n = (Array.length m.(0)) in
+  for i=0 to (n - 1) do
+    for j=0 to (n - 1) do
+      if (i<>j) then
+        (if (m.(i).(j)=1) then m.(i).(j) <- 1 else m.(i).(j) <- n+1)
+          else m.(i).(j) <- 0
+      done;
+  done;
+  m
+
+
+(* Apply Floyd Warshall algorithm which gives the matrix of all pairs shortest path *)
+let (floydwarshall:int array array -> int array array) =
+  fun m ->
+  let w = initFW m in
+  let n = (Array.length m.(0)) in
+  for k=0 to (n - 1) do
+    for i=0 to (n - 1) do
+      for j=0 to (n - 1) do
+        w.(i).(j) <- (min (w.(i).(j)) (w.(i).(k) + w.(k).(j)))
+        done;
+      done;
+  done;
+  w
+
+(* tabulate everything that is expensive to compute *)
+let distance_tbl = Hashtbl.create 1
+let diameter_tbl = Hashtbl.create 1
+
+let to_distance t =
+  match Hashtbl.find_opt distance_tbl t with
+  | Some d -> d
+  | None ->
+    let d = floydwarshall (graph_to_adjency t) in
+    Hashtbl.add distance_tbl t d;
+    d
+
+(**********************************************************************************)
+(* returns the greatest int of a matrix *)
+let (max_mat: int array array -> int) =
+  fun mat ->
+  let n = (Array.length mat) and m = (Array.length mat.(0)) in
+  let maxi = ref (-1) in
+  for i=0 to (n - 1) do
+    for j=0 to (m - 1) do
+      maxi := max !maxi mat.(i).(j)
+    done;
+  done;
+  !maxi
 
-let (distance : t -> int -> int -> int) =
-  fun g i j ->
-  assert( 0 <= i && i<=j && j < List.length g.nodes);
-  let ni = List.nth g.nodes i in
-  let nj = List.nth g.nodes j in
-  let (get_succ : node_id -> StrSet.t) =
-    fun n -> g.succ n |> List.to_seq |> StrSet.of_seq
-  in
-  let rec aux n succ cpt =
-    if StrSet.mem n.id succ then cpt else
-      let succ =
-        StrSet.fold (fun  n acc -> StrSet.union acc (get_succ n)) succ succ
-      in
-      aux n succ (cpt+1)
-  in
-  aux ni (StrSet.singleton nj.id) 0
+(* takes a graph t in argument and returns the diameter *)
+let (diameter : t -> int ) =
+  fun t ->
+  match Hashtbl.find_opt diameter_tbl t with
+  | Some d -> d
+  | None ->
+    let d = (max_mat(to_distance t)) in
+    Printf.eprintf " ====> The Graph Diameter is %d \n%!" d;
+    Hashtbl.add diameter_tbl t d;
+    d
 
 
+(**********************************************************************************)
 let (do_graph_attr : attrs -> (Dot_ast.id * Dot_ast.id option) list -> attrs) =
   fun acc l ->
     let f acc = function
@@ -208,17 +273,6 @@ let (to_adjacency: t -> bool array array) =
       t.nodes;
     m
 
-let (to_distance : t -> int array array) =
-  fun t ->
-    let n = List.length t.nodes in
-    let m = Array.make_matrix n n 0 in
-    for i = 0 to n-1 do
-      for j = i to n-1 do
-        m.(i).(j) <- distance t i j;
-        m.(j).(i) <- m.(i).(j);
-      done
-    done;
-    m
 
 let (get_degree: t -> int*int) =
   fun t ->

lib/sasacore/topology.mli

-(* Time-stamp: <modified the 24/01/2024 (at 16:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 21/02/2024 (at 09:40) by Erwan Jahier> *)
 
 (** {1 Topology: internal representation of Graphs } *)
 
@@ -31,6 +31,8 @@ val to_adjacency: t -> bool array array
 *)
 
 val to_distance: t -> int array array
+val diameter: t -> int
+
 val get_nb_link: t -> int
 val get_mean_degree : t -> float
 val is_connected : t -> bool

salut/lib/utils.lus

@@ -35,7 +35,7 @@ function nary_xor_alt<<const N:int>>(s : bool^N) returns (y : bool);
 let
 	y = with N=1 then s[0]
             else if s[0] then boolnone<<N-1>>(s[1..N-1])
-                         else nary_xor<<N-1>>(s[1..N-1]);
+                         else nary_xor_alt<<N-1>>(s[1..N-1]);
 tel;
 function nary_xor_old<<const N:int>>(s : bool^N) returns (y : bool);
 let
@@ -160,6 +160,12 @@ let
               else nary_xor<<n-1>>(s[1..n-1]);
 tel
 
+function count <<const n:int>>(s:bool^n) returns (o:int);
+let
+  o = with n=1 then (if s[0] then 1 else 0) else
+      (if s[0] then 1 else 0) + count<<n-1>>(s[1..n-1]);
+tel
+
 function nary_not <<const n:int>>(s:bool^n) returns (o:bool);
 let
   o = with n=1 then not s[0]

salut/src/dot2lus.ml

@@ -9,6 +9,10 @@ let action_type = "action"
 let action_number = "actions_number"
 let action_of_int = "action_of_int"
 
+let quiet = ref false
+let pverbose msg = if not !quiet then  Printf.printf "%s\n%!" msg
+
+
 (* global setting, parsed from command-line options *)
 let clock = ref false
 
@@ -19,72 +23,83 @@ let output_prelude lustre_topology lustre_const (graph : Topology.t) =
   Printf.fprintf lustre_topology "-- automatically generated by salut \n";
   Printf.fprintf lustre_const "-- automatically generated by salut \n";
 
- (* include Lustre algos *)
- graph.nodes
- |> List.map algo_name
- |> List.sort_uniq String.compare
- |> List.iter (Printf.fprintf lustre_topology "include \"%s.lus\"\n");
-
- (* define graph constants *)
- output_string lustre_topology "\n";
- Printf.fprintf lustre_const "const card = %d;\n" (List.length graph.nodes);
- Printf.fprintf lustre_const "const links_number = %d;\n" (Topology.get_nb_link graph);
- let dmin, dmax = Topology.get_degree graph in
- Printf.fprintf lustre_const "const max_degree = %d;\n" dmax;
- Printf.fprintf lustre_const "const min_degree = %d;\n" dmin;
- Printf.fprintf lustre_const "const mean_degree = %f;\n" (Topology.get_mean_degree graph);
- Printf.fprintf lustre_const "const diameter = %d;\n" (Diameter.get graph);
- Printf.fprintf lustre_const "const is_directed = %b;\n" graph.directed;
- Printf.fprintf lustre_const "const is_cyclic = %b;\n" (Topology.is_cyclic graph);
- Printf.fprintf lustre_const "const is_connected = %b;\n" (Topology.is_connected graph);
- let neigh_list = graph.nodes |> List.map (fun (n:Topology.node) -> graph.pred n.id) in
- let nb_neigh_list = neigh_list |> List.map (fun n -> string_of_int (List.length n)) in
- Printf.fprintf lustre_const "const nb_neighbors = %s;\n" ("["^(String.concat "," (nb_neigh_list))^"]");
-
- (* dot attributes *)
- let already_defined = function
-  | "card"
-  | "links_number"
-  | "max_degree"
-  | "min_degree"
-  | "mean_degree"
-  | "diameter"
-  | "is_directed"
-  | "is_cyclic"
-  | "is_connected"
-  | "f"
-  | "t"
-  | "adjacency"  -> true
-  | _ -> false in
- List.iter
-  (fun (name, value) ->
-   if not (already_defined name)
-   then Printf.fprintf lustre_const "const %s = %s;\n" name value)
-  graph.attributes;
-
- (* adjacency matrix *)
- output_string lustre_const "const t = true;\n";
- output_string lustre_const "const f = false;\n";
- (* NOTE: b2s, array_to_string and matrix_to_string copied from genOracle.ml *)
- let b2s b = if b then "t" else "f" in
- Printf.fprintf lustre_const
-  "const adjacency = %s;\n"
-  (graph |> Topology.to_adjacency |> (StringOf.matrix_lv6 b2s));
-
- Printf.fprintf lustre_const
-  "const distance = %s;\n"
-  (graph |> Topology.to_distance |> (StringOf.matrix_lv6 string_of_int));
-
- (* State.lus File *)
- output_string lustre_topology"
+  (* include Lustre algos *)
+  graph.nodes
+  |> List.map algo_name
+  |> List.sort_uniq String.compare
+  |> List.iter (Printf.fprintf lustre_topology "include \"%s.lus\"\n");
+
+  (* define graph constants *)
+  output_string lustre_topology "\n";
+  pverbose "compute card";
+  Printf.fprintf lustre_const "const card = %d;\n" (List.length graph.nodes);
+  pverbose "compute link nb";
+  Printf.fprintf lustre_const "const links_number = %d;\n" (Topology.get_nb_link graph);
+  pverbose "compute degree";
+  let dmin, dmax = Topology.get_degree graph in
+  Printf.fprintf lustre_const "const max_degree = %d;\n" dmax;
+  Printf.fprintf lustre_const "const min_degree = %d;\n" dmin;
+  pverbose "compute mean degree";
+  Printf.fprintf lustre_const "const mean_degree = %f;\n" (Topology.get_mean_degree graph);
+  pverbose "compute diameter";
+  Printf.fprintf lustre_const "const diameter = %d;\n" (Topology.diameter graph);
+  Printf.fprintf lustre_const "const is_directed = %b;\n" graph.directed;
+  pverbose "compute if cyclic";
+  Printf.fprintf lustre_const "const is_cyclic = %b;\n" (Topology.is_cyclic graph);
+  pverbose "compute if connected";
+  Printf.fprintf lustre_const "const is_connected = %b;\n" (Topology.is_connected graph);
+  pverbose "compute if connected: done";
+  let neigh_list = graph.nodes |> List.map (fun (n:Topology.node) -> graph.pred n.id) in
+  let nb_neigh_list = neigh_list |> List.map (fun n -> string_of_int (List.length n)) in
+  Printf.fprintf lustre_const "const nb_neighbors = %s;\n" ("["^(String.concat "," (nb_neigh_list))^"]");
+
+  (* dot attributes *)
+  let already_defined = function
+    | "card"
+    | "links_number"
+    | "max_degree"
+    | "min_degree"
+    | "mean_degree"
+    | "diameter"
+    | "is_directed"
+    | "is_cyclic"
+    | "is_connected"
+    | "f"
+    | "t"
+    | "adjacency"  -> true
+    | _ -> false in
+  List.iter
+    (fun (name, value) ->
+       if not (already_defined name)
+       then Printf.fprintf lustre_const "const %s = %s;\n" name value)
+    graph.attributes;
+
+  (* adjacency matrix *)
+  output_string lustre_const "const t = true;\n";
+  output_string lustre_const "const f = false;\n";
+  (* NOTE: b2s, array_to_string and matrix_to_string copied from genOracle.ml *)
+  let b2s b = if b then "t" else "f" in
+  pverbose "compute adjacency";
+  Printf.fprintf lustre_const
+    "const adjacency = %s;\n"
+    (graph |> Topology.to_adjacency |> (StringOf.matrix_lv6 b2s));
+
+  pverbose "compute distance";
+  Printf.fprintf lustre_const
+    "const distance = %s;\n"
+    (graph |> Topology.to_distance |> (StringOf.matrix_lv6 string_of_int));
+  pverbose "compute distance: done";
+
+  (* State.lus File *)
+  output_string lustre_topology"
 include \"state.lus\"";
 
- (* Neighbors type *)
- output_string lustre_topology "
+  (* Neighbors type *)
+  output_string lustre_topology "
 type neigh = struct { state:state; reply:int; weight:int };\n";
 
- (* helper functions *)
- output_string lustre_topology "
+  (* helper functions *)
+  output_string lustre_topology "
 function dot2lus_first_set<<const N:int>>(s : bool^N) returns (x : int);
 var
   found : int;
@@ -97,7 +112,7 @@ let
     else if found < 0 then -1
          else found + 1;
 tel;\n";
- Printf.fprintf lustre_topology "
+  Printf.fprintf lustre_topology "
 function dot2lus_action_of_activation(activation : bool^%s) returns (action : %s);
 let
   action = %s(dot2lus_first_set<<%s>>(activation));
@@ -226,7 +241,9 @@ let _ =
   in
   let speclist =
     [ ("-o", Arg.Set_string lusfile, "Set output file (default is inferred from input file)");
-      ("--clock", Arg.Set clock, "Generate clocked code (default is unclocked)") ]
+      ("--clock", Arg.Set clock, "Generate clocked code (default is unclocked)");
+      ("--quiet", Arg.Set quiet, "Be more quiet<")
+    ]
   in
   Arg.parse speclist anon_parse usage;
   match !dotfile with

salut/test/dijkstra-ring/dune-project

-(lang dune 3.0)

salut/test/dijkstra-ring/dune-project

+../../../test/dune-project2copy
\ No newline at end of file

test/ghosh/util

+../../salut/test/ghosh/util/
\ No newline at end of file

tools/gg/graphGen.ml

@@ -75,7 +75,7 @@ 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)
-       | "diameter" -> string_of_int (Diameter.get g)
+       | "diameter" -> string_of_int (Topology.diameter 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))
@@ -142,7 +142,7 @@ let all_attr : bool -> bool -> (Topology.t -> (string * string) list) =
     ["diameter", string_of_int (
                     Printf.eprintf "Computing the diameter...\n";
                     flush stderr;
-                    Diameter.get g)
+                    Topology.diameter g)
   ])