Commit 21f3123d authored by Gwennan Eliezer's avatar Gwennan Eliezer
Browse files

Took into account Erwan's comments and changed Register module such that the...

Took into account Erwan's comments and changed Register module such that the properties are computed on first call (except height that is computed on each call because it depends on the chosen tree's root)
parent 09d950b8
Pipeline #26225 failed with stages
in 9 minutes and 4 seconds
......@@ -31,6 +31,7 @@ type 's to_register = {
copy_state: 's -> 's;
}
type node_id = string (* cf topology.mli *)
let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
fun n ->
......@@ -75,9 +76,9 @@ let (register : 's to_register -> unit) =
let card = Register.card
let degree_min = Register.degree_min
let min_degree = Register.min_degree
let mean_degree = Register.mean_degree
let degree_max = Register.degree_max
let max_degree = Register.max_degree
let is_cyclic = Register.is_cyclic
let is_connected = Register.is_connected
let is_tree = Register.is_tree
......
......@@ -41,19 +41,21 @@ type 's to_register = {
If one prepend a value with "some_id=", some_id will we used in
the simulation outputs. Otherwise, an id will be invented *)
type node_id = string (* cf topology.mli *)
(** To be called once *)
val register : 's to_register -> unit
(** Topological infos *)
val card : unit -> int
val degree_min : unit -> int
val min_degree : unit -> int
val mean_degree : unit -> float
val degree_max : unit -> int
val max_degree : unit -> int
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
val height : unit -> (string -> int) option
val height : unit -> (node_id -> int) option
val links_number : unit -> int
val diameter : unit -> int
(* val degree : unit -> int *)
......
(* take a string and the list of all node and return the position of the node in the list *)
(* 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 -> List.fold_right (fun lid i -> if (nid=lid.Topology.id) then 0 else i + 1 ) lid 0
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 return the Adjacency matrix of t *)
let (gtom: Topology.t -> int array array) =
(* take a graph t and returns the Adjacency matrix of t *)
let (graph_to_ajency: Topology.t -> int array array) =
fun t->
let taille = List.length t.nodes in
let mat = Array.make_matrix (taille) (taille) 0 in
......@@ -27,7 +28,7 @@ let (initFW: int array array -> int array array) =
m
(* Apply Floyd Warshall algorithm which give the matrix of all pairs shortest path *)
(* 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
......@@ -42,19 +43,20 @@ let (floydwarshall:int array array -> int array array) =
w
(* return the greatest int of a matrix *)
(* returns the greatest int of a matrix *)
let (max_mat: int array array -> int) =
fun m ->
let n = (Array.length m.(0)) in
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 (n - 1) do
maxi := max !maxi m.(i).(j)
for j=0 to (m - 1) do
maxi := max !maxi mat.(i).(j)
done;
done;
!maxi
(* take a graph t in argument and return the diameter *)
let (get: Topology.t -> unit -> int ) =
fun t () ->
(max_mat(floydwarshall (gtom t)))
\ No newline at end of file
(* takes a graph t in argument and returns the diameter *)
let (get: Topology.t -> int ) =
fun t ->
(max_mat(floydwarshall (graph_to_ajency t)))
\ No newline at end of file
val get : Topology.t -> unit -> int
val get : Topology.t -> int
......@@ -21,20 +21,34 @@ type 's internal_tables = {
value_to_string : (string, Obj.t) Hashtbl.t;
value_of_string : (string, Obj.t) Hashtbl.t;
copy_value : (string, Obj.t) Hashtbl.t;
mutable card : int;
mutable deg_min : int;
mutable mean_deg : float;
mutable deg_max : int;
mutable is_cyclic : bool;
mutable is_connected : bool;
mutable is_tree : bool;
mutable height : (string -> int) option;
mutable card : int;
mutable min_deg : int;
mutable mean_deg : float;
mutable max_deg : int;
mutable is_cyclic : bool option;
mutable is_connected : bool option;
mutable is_tree : bool option;
(* Caution : this option is not the same as the option in return of the function "height ()".
* If it is None, it is beacause it isn't calculated yet (like for the booleans) *)
mutable height : (string -> int) option;
mutable links_number : int;
mutable diameter : int option;
mutable diameter_fun : unit -> int
mutable diameter : int;
}
type properities_functions = {
mutable card : unit -> int;
mutable min_max : unit -> int*int;
mutable mean_deg : unit -> float;
mutable is_connected_cyclic : unit -> bool*bool;
mutable height : unit -> ((string -> int));
mutable links_number : unit -> int;
mutable diameter : unit -> int
}
type node_id = string (* cf topology.mli *)
let (tbls:'s internal_tables) = {
init_state = Hashtbl.create 1;
enable = Hashtbl.create 1;
......@@ -43,18 +57,27 @@ let (tbls:'s internal_tables) = {
value_to_string = Hashtbl.create 1;
value_of_string = Hashtbl.create 1;
copy_value = Hashtbl.create 1;
card = (-1);
deg_min = (-1);
card = (-1);
min_deg = (-1);
mean_deg = (-1.);
deg_max = (-1);
is_cyclic = false;
is_connected = false;
is_tree = false;
max_deg = (-1);
is_cyclic = None;
is_connected = None;
is_tree = None;
height = None;
links_number = (-1);
diameter = None;
diameter_fun = (fun () -> -1)
diameter = (-1)
}
let (prop_funs:properities_functions) = {
card = (fun () -> -1);
min_max = (fun () -> (-1,-1));
mean_deg = (fun () -> -1.);
is_connected_cyclic = (fun () -> (false,false));
height = (fun () _ -> -1);
links_number = (fun () -> -1);
diameter = (fun () -> -1)
}
let verbose_level = ref 0
......@@ -147,72 +170,102 @@ let (get_copy_value : unit -> ('s -> 's)) = fun () ->
raise (Unregistred ("copy_value", "_global"))
let set_min_max : (unit -> unit) =
fun () ->
let (x,y) = prop_funs.min_max () in
tbls.min_deg <- x;
tbls.max_deg <- y
let set_connec_cycl : (unit -> unit) =
fun () ->
let (x,y) = prop_funs.is_connected_cyclic () in
tbls.is_connected <- Some x;
tbls.is_cyclic <- Some y
let (card : unit -> int) =
fun () -> tbls.card
fun () -> match tbls.card with
| -1 -> (let c = prop_funs.card () in tbls.card <- c; c)
| c -> c
let (degree_min : unit -> int) =
fun () -> tbls.deg_min
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 () -> tbls.mean_deg
fun () -> match tbls.mean_deg with
| -1. -> (let m = prop_funs.mean_deg () in tbls.mean_deg <- m; m)
| m -> m
let (degree_max : unit -> int) =
fun () -> tbls.deg_max
let (max_degree : unit -> int) =
fun () -> match tbls.max_deg with
| -1 -> (set_min_max (); tbls.max_deg)
| m -> m
let (is_cyclic : unit -> bool) =
fun () -> tbls.is_cyclic
fun () -> match tbls.is_cyclic with
| None -> (set_connec_cycl ();
match tbls.is_cyclic with
| Some b -> b
| _ -> failwith "unexpected error in Register.is_cyclic")
| Some b -> b
let (is_connected : unit -> bool) =
fun () -> tbls.is_connected
fun () -> match tbls.is_connected with
| None -> (set_connec_cycl ();
match tbls.is_connected with
| Some b -> b
| _ -> failwith "unexpected error in Register.is_connected")
| Some b -> b
let (is_tree : unit -> bool) =
fun () -> tbls.is_tree
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.
* If height () = None, then the graph doesn't have a height (because it isn't a tree)*)
let height : (unit -> (string -> int) option) =
fun () -> tbls.height
fun () ->
if is_tree () then
tbls.height
else None
let (links_number : unit -> int) =
fun () -> tbls.links_number
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
| None -> (let d = (tbls.diameter_fun ()) in tbls.diameter <- Some d; d)
| Some d -> d
| -1 -> (let d = (prop_funs.diameter ()) in tbls.diameter <- d; d)
| d -> d
let (set_card : int -> unit) =
fun i ->
tbls.card <- i
let (set_degrees : int*int -> unit) =
fun (min,max) ->
tbls.deg_min <- min;
tbls.deg_max <- max
let (set_mean_deg : float -> unit) =
fun m ->
tbls.mean_deg <- m
let set_card : ((unit -> int) -> unit) =
fun f -> prop_funs.card <- f
let (set_is_cyclic : bool -> unit) =
fun b -> tbls.is_cyclic <- b
let set_degrees : ((unit -> int*int) -> unit) =
fun f -> prop_funs.min_max <- f
let (set_is_connected : bool -> unit) =
fun b -> tbls.is_connected <- b
let set_mean_deg : ((unit -> float) -> unit) =
fun f -> prop_funs.mean_deg <- f
let (set_is_tree : bool -> unit) =
fun b -> tbls.is_tree <- b
let set_is_connected_cyclic : ((unit -> bool*bool) -> unit) =
fun f -> prop_funs.is_connected_cyclic <- f
let set_height : ((string -> int) -> unit) =
fun f -> tbls.height <- Some f
let set_height : ((unit -> (node_id -> int)) -> unit) =
fun f -> tbls.height <- f
let (set_links_number : int -> unit) =
fun l_nb -> tbls.links_number <- l_nb
let set_links_number : ((unit -> int) -> unit) =
fun f -> prop_funs.links_number <- f
let set_diameter : ((unit -> int) -> unit) =
fun f -> tbls.diameter_fun <- f
fun f -> prop_funs.diameter <- f
let (to_string : 's -> string) =
......
......@@ -13,6 +13,7 @@ type action = string
type 's enable_fun = 's neighbor list -> 's -> action list
type 's step_fun = 's neighbor list -> 's -> action -> 's
type node_id = string (* cf topology.mli *)
val reg_init_state : algo_id -> (int -> 's) -> unit
val reg_enable : algo_id -> 's enable_fun -> unit
......@@ -31,31 +32,28 @@ val get_value_to_string : unit -> 's -> string
val get_value_of_string : unit -> (string -> 's) option
val get_copy_value : unit -> ('s -> 's)
val to_string : 's -> string
val set_card : int -> unit
val set_degrees : int*int -> unit
val set_mean_deg : float -> unit
val set_is_cyclic : bool -> unit
val set_is_connected : bool -> unit
val set_is_tree : bool -> unit
val set_height : (string -> int) -> unit
val set_links_number : int -> unit
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_height : (unit -> (node_id -> int)) -> unit
val set_links_number : (unit -> int) -> unit
val set_diameter : (unit -> int) -> unit
(* val set_degree : int -> unit *)
(* val set_diameter : int -> unit *)
val card : unit -> int
val degree_min : unit -> int
val min_degree : unit -> int
val mean_degree : unit -> float
val degree_max : unit -> int
val max_degree : unit -> int
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
(* If height () = None, then the graph doesn't have a height (because it isn't a tree)
Otherwise, height () = Some h.*)
val height : unit -> (string -> int) option
val links_number : unit -> int
val diameter : unit -> int
(* val degree : unit -> int *)
(* val diameter : unit -> int *)
val verbose_level: int ref
......@@ -147,9 +147,6 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
String.concat " "
(List.map (fun (base, tstr) -> Printf.sprintf "\"%s\":%s" base tstr) ssl)
(***********************************************************)
(********* Added by Gwennan and Nathan *********)
(***********************************************************)
let (get_degree:Topology.t -> int*int) =
fun t -> if t.nodes = [] then 0,0
......@@ -159,10 +156,10 @@ let (get_degree:Topology.t -> int*int) =
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 o (for know if the graph is oriented or not) and return the number of link in the graph *)
(* take a graph t and a boolean is_oriented and return the number of link in the graph *)
let (get_nb_link: Topology.t -> bool -> int) =
fun t o ->
if not o then (List.fold_left (fun acc n -> ((List.length (t.succ n.Topology.id))) + acc) (0) (t.nodes)) / 2
fun t is_oriented ->
if not is_oriented then (List.fold_left (fun acc n -> ((List.length (t.succ n.Topology.id))) + acc) (0) (t.nodes)) / 2
else (List.fold_left (fun acc n -> ((List.length (t.succ n.Topology.id))) + acc) (0) (t.nodes))
let (get_mean_degree : Topology.t -> float) =
......@@ -200,16 +197,14 @@ let is_connected_and_cyclic : Topology.t -> bool*bool =
| hd::_ -> let (cyclic,bfs_nodes) = (bfs t hd.Topology.id) in ((List.compare_lengths t.nodes bfs_nodes) = 0, cyclic)
let rec height : string list -> Topology.t -> string -> int =
fun p t n ->
fun parents t n ->
(List.fold_left (fun h (_,succ) ->
if List.exists (fun par -> par = succ) p then h else max h (height (n::p) t succ)) (-1) (t.succ n)) + 1
if List.mem succ parents then h else max h (height (n::parents) t succ)) (-1) (t.succ n)) + 1
let get_height : Topology.t -> string -> int =
fun t ->
height ([]) t
(***********************************************************)
(***********************************************************)
let (make : bool -> string array -> 'v t) =
fun dynlink argv ->
......@@ -231,19 +226,13 @@ let (make : bool -> string array -> 'v t) =
let nl = g.nodes in
let nidl = List.map (fun n -> n.Topology.id) nl in
let nstr = String.concat "," nidl in
Register.set_card (List.length nl);
(*****************************)
Register.set_degrees (get_degree g);
Register.set_mean_deg (get_mean_degree g);
let (connected, cyclic) = is_connected_and_cyclic g in
Register.set_is_cyclic cyclic;
Register.set_is_connected connected;
let is_tree = ((not cyclic) && connected) in
Register.set_is_tree is_tree;
if is_tree then Register.set_height (get_height g);
Register.set_links_number (get_nb_link g false);
Register.set_diameter (Diameter.get g);
(*****************************)
Register.set_card (fun () -> List.length nl);
Register.set_degrees (fun () -> get_degree g);
Register.set_mean_deg (fun () -> get_mean_degree g);
Register.set_is_connected_cyclic (fun () -> is_connected_and_cyclic g);
Register.set_height (fun () -> get_height g);
Register.set_links_number (fun () -> get_nb_link g false);
Register.set_diameter (fun () -> Diameter.get g);
Register.verbose_level := args.verbose;
Random.init args.seed;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment