diff --git a/lib/algo/algo.ml b/lib/algo/algo.ml
index f79c668e96d746397b784717128cf7907a69df49..995a0ff8136f84bf1153e220b4f59be66f27541e 100644
--- a/lib/algo/algo.ml
+++ b/lib/algo/algo.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/10/2019 (at 15:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/10/2019 (at 21:09) by Erwan Jahier> *)
open Sasacore
(* Process programmer API *)
@@ -105,6 +105,7 @@ let mean_degree = Register.mean_degree
let max_degree = Register.max_degree
let is_cyclic = Register.is_cyclic
let is_connected = Register.is_connected
+let is_directed = Register.is_directed
let is_tree = Register.is_tree
let height = Register.height
let links_number = Register.links_number
diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index 01438a437167c4a6ee4c7fd88ffd61ef05a0338f..c1b8053fe6facd98bac653e139eaf8de4b9ac5de 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/10/2019 (at 14:35) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/10/2019 (at 21:08) by Erwan Jahier> *)
(** The Algorithm programming Interface.
A SASA process is an instance of an algorithm defined via this
@@ -64,6 +64,7 @@ val card : unit -> int
val min_degree : unit -> int
val mean_degree : unit -> float
val max_degree : unit -> int
+val is_directed : unit -> bool
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index fcbdf4cedd669b85ea37bb9d7a9d0d1f1a871f44..5b33bb4e86fc8f6657cccdb2880f3f935ad8fe10 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/10/2019 (at 10:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/10/2019 (at 21:08) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
@@ -29,6 +29,7 @@ type 's internal_tables = {
mutable is_cyclic : bool option;
mutable is_connected : bool option;
mutable is_tree : bool option;
+ mutable is_directed : bool option;
mutable height : (string -> int);
mutable links_number : int;
mutable diameter : int;
@@ -39,6 +40,7 @@ type properties_functions = {
mutable min_max : unit -> int*int;
mutable mean_deg : unit -> float;
mutable is_connected_cyclic : unit -> bool*bool;
+ mutable is_directed : unit -> bool;
mutable links_number : unit -> int;
mutable diameter : unit -> int
}
@@ -61,6 +63,7 @@ let (tbls:'s internal_tables) = {
is_cyclic = None;
is_connected = None;
is_tree = None;
+ is_directed = None;
height = (fun _ -> -1);
links_number = (-1);
diameter = (-1)
@@ -71,6 +74,7 @@ let (prop_funs:properties_functions) = {
min_max = (fun () -> (-1,-1));
mean_deg = (fun () -> -1.);
is_connected_cyclic = (fun () -> (false,false));
+ is_directed = (fun () -> false);
links_number = (fun () -> -1);
diameter = (fun () -> -1)
}
@@ -177,20 +181,33 @@ let set_connec_cycl : (unit -> unit) =
tbls.is_connected <- Some x;
tbls.is_cyclic <- Some y
-
-let (card : unit -> int) =
- fun () -> match tbls.card with
- | -1 -> (let c = prop_funs.card () in tbls.card <- c; c)
+let (card : unit -> int) = fun () ->
+ match tbls.card with
+ | -1 ->
+ let c = prop_funs.card () in
+ tbls.card <- c;
+ c
| c -> c
+let (is_directed : unit -> bool) = fun () ->
+ match tbls.is_directed with
+ | None ->
+ let c = prop_funs.is_directed () in
+ tbls.is_directed <- Some c;
+ c
+ | Some c -> c
+
let (min_degree : unit -> int) =
fun () -> match tbls.min_deg with
| -1 -> (set_min_max (); tbls.min_deg)
| m -> m
-let (mean_degree : unit -> float) =
- fun () -> match tbls.mean_deg with
- | -1. -> (let m = prop_funs.mean_deg () in tbls.mean_deg <- m; m)
+let (mean_degree : unit -> float) = fun () ->
+ match tbls.mean_deg with
+ | -1. ->
+ let m = prop_funs.mean_deg () in
+ tbls.mean_deg <- m;
+ m
| m -> m
let (max_degree : unit -> int) =
@@ -198,25 +215,30 @@ let (max_degree : unit -> int) =
| -1 -> (set_min_max (); tbls.max_deg)
| m -> m
-let (is_cyclic : unit -> bool) =
- fun () -> match tbls.is_cyclic with
- | None -> (set_connec_cycl ();
- match tbls.is_cyclic with
- | Some b -> b
- | _ -> assert false)
+let (is_cyclic : unit -> bool) = fun () ->
+ match tbls.is_cyclic with
+ | None ->
+ set_connec_cycl ();
+ (match tbls.is_cyclic with
+ | Some b -> b
+ | _ -> assert false)
| Some b -> b
-let (is_connected : unit -> bool) =
- fun () -> match tbls.is_connected with
- | None -> (set_connec_cycl ();
- match tbls.is_connected with
- | Some b -> b
- | _ -> assert false)
+let (is_connected : unit -> bool) = fun () ->
+ match tbls.is_connected with
+ | None -> (
+ set_connec_cycl ();
+ match tbls.is_connected with
+ | Some b -> b
+ | _ -> assert false)
| Some b -> b
-let (is_tree : unit -> bool) =
- fun () -> match tbls.is_tree with
- | None -> (let b = (not (is_cyclic ()) && (is_connected ())) in tbls.is_tree <- Some b; b)
+let (is_tree : unit -> bool) = fun () ->
+ match tbls.is_tree with
+ | None ->
+ let b = (not (is_cyclic ()) && (is_connected ())) in
+ tbls.is_tree <- Some b;
+ b
| Some b -> b
(* Caution : this option is not the same as the option in the type tbls.height.
@@ -229,14 +251,21 @@ let height : (unit -> (string -> int) option) =
let (links_number : unit -> int) =
- fun () -> match tbls.links_number with
- | -1 -> (let n = prop_funs.links_number () in tbls.links_number <- n; n)
+ fun () ->
+ match tbls.links_number with
+ | -1 ->
+ let n = prop_funs.links_number () in
+ tbls.links_number <- n;
+ n
| n -> n
let (diameter : unit -> int) =
fun () ->
match tbls.diameter with
- | -1 -> (let d = (prop_funs.diameter ()) in tbls.diameter <- d; d)
+ | -1 ->
+ let d = (prop_funs.diameter ()) in
+ tbls.diameter <- d;
+ d
| d -> d
@@ -244,6 +273,9 @@ let (diameter : unit -> int) =
let set_card : ((unit -> int) -> unit) =
fun f -> prop_funs.card <- f
+let set_is_directed : ((unit -> bool) -> unit) =
+ fun f -> prop_funs.is_directed <- f
+
let set_degrees : ((unit -> int*int) -> unit) =
fun f -> prop_funs.min_max <- f
diff --git a/lib/sasacore/register.mli b/lib/sasacore/register.mli
index c8dd828db5d1db0b1f735932b25759e59981dea5..9c349fe5c901aa3e3631fafdb235eafee30eb4fa 100644
--- a/lib/sasacore/register.mli
+++ b/lib/sasacore/register.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/10/2019 (at 10:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/10/2019 (at 20:45) by Erwan Jahier> *)
(** This module duplicates and extends the Algo module with get_*
functions.
@@ -37,6 +37,7 @@ val max_degree : unit -> int
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
+val is_directed : unit -> bool
(** If height () = None, then the graph doesn't have a height (because it isn't a tree)
Otherwise, height () = Some h.*)
@@ -67,6 +68,7 @@ val set_card : (unit -> int) -> unit
val set_degrees : (unit -> int*int) -> unit
val set_mean_deg : (unit -> float) -> unit
val set_is_connected_cyclic : (unit -> bool*bool) -> unit
+val set_is_directed : (unit -> bool) -> unit
type node_id = string (* cf topology.mli *)
val set_height : (node_id -> int) -> unit
val set_links_number : (unit -> int) -> unit