Commit 09d950b8 authored by Gwennan Eliezer's avatar Gwennan Eliezer
Browse files

Added everything (graph, degree...), and put diameter in its own module.

parent 7ecdeca2
Pipeline #26017 passed with stages
in 8 minutes and 38 seconds
......@@ -75,3 +75,12 @@ let (register : 's to_register -> unit) =
let card = Register.card
let degree_min = Register.degree_min
let mean_degree = Register.mean_degree
let degree_max = Register.degree_max
let is_cyclic = Register.is_cyclic
let is_connected = Register.is_connected
let is_tree = Register.is_tree
let height = Register.height
let links_number = Register.links_number
let diameter = Register.diameter
\ No newline at end of file
......@@ -47,5 +47,14 @@ val register : 's to_register -> unit
(** Topological infos *)
val card : unit -> int
val degree_min : unit -> int
val mean_degree : unit -> float
val degree_max : unit -> int
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
val height : unit -> (string -> int) option
val links_number : unit -> int
val diameter : unit -> int
(* val degree : unit -> int *)
(* val diameter : unit -> int *)
(* take a string and the list of all node and return 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
(* take a graph t and return the Adjacency matrix of t *)
let (gtom: 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 give 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
(* return the greatest int of a matrix *)
let (max_mat: int array array -> int) =
fun m ->
let n = (Array.length m.(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)
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
val get : Topology.t -> unit -> int
......@@ -21,8 +21,19 @@ 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 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 links_number : int;
mutable diameter : int option;
mutable diameter_fun : unit -> int
}
let (tbls:'s internal_tables) = {
init_state = Hashtbl.create 1;
......@@ -32,7 +43,18 @@ let (tbls:'s internal_tables) = {
value_to_string = Hashtbl.create 1;
value_of_string = Hashtbl.create 1;
copy_value = Hashtbl.create 1;
card = (-1)
card = (-1);
deg_min = (-1);
mean_deg = (-1.);
deg_max = (-1);
is_cyclic = false;
is_connected = false;
is_tree = false;
height = None;
links_number = (-1);
diameter = None;
diameter_fun = (fun () -> -1)
}
let verbose_level = ref 0
......@@ -127,11 +149,72 @@ let (get_copy_value : unit -> ('s -> 's)) = fun () ->
let (card : unit -> int) =
fun () -> tbls.card
let (degree_min : unit -> int) =
fun () -> tbls.deg_min
let (mean_degree : unit -> float) =
fun () -> tbls.mean_deg
let (degree_max : unit -> int) =
fun () -> tbls.deg_max
let (is_cyclic : unit -> bool) =
fun () -> tbls.is_cyclic
let (is_connected : unit -> bool) =
fun () -> tbls.is_connected
let (is_tree : unit -> bool) =
fun () -> tbls.is_tree
let height : (unit -> (string -> int) option) =
fun () -> tbls.height
let (links_number : unit -> int) =
fun () -> tbls.links_number
let (diameter : unit -> int) =
fun () ->
match tbls.diameter with
| None -> (let d = (tbls.diameter_fun ()) in tbls.diameter <- Some d; d)
| Some 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_is_cyclic : bool -> unit) =
fun b -> tbls.is_cyclic <- b
let (set_is_connected : bool -> unit) =
fun b -> tbls.is_connected <- b
let (set_is_tree : bool -> unit) =
fun b -> tbls.is_tree <- b
let set_height : ((string -> int) -> unit) =
fun f -> tbls.height <- Some f
let (set_links_number : int -> unit) =
fun l_nb -> tbls.links_number <- l_nb
let set_diameter : ((unit -> int) -> unit) =
fun f -> tbls.diameter_fun <- f
let (to_string : 's -> string) =
fun v ->
(get_value_to_string ()) v
......@@ -32,10 +32,29 @@ 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_diameter : (unit -> int) -> unit
(* val set_degree : int -> unit *)
(* val set_diameter : int -> unit *)
val card : unit -> int
val degree_min : unit -> int
val mean_degree : unit -> float
val degree_max : unit -> int
val is_cyclic : unit -> bool
val is_connected : unit -> bool
val is_tree : unit -> bool
val height : unit -> (string -> int) option
val links_number : unit -> int
val diameter : unit -> int
(* val degree : unit -> int *)
(* val diameter : unit -> int *)
......
......@@ -146,7 +146,71 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
let ssl = get_outputs_rif_decl args pl in
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
else
let node_deg n = List.length (t.succ (n.Topology.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 o (for know if the graph is oriented or not) 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
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) =
fun t ->
(float_of_int (get_nb_link t true)) /. (float_of_int (List.length t.nodes))
let bfs : (Topology.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 : Topology.t -> bool*bool =
fun t -> match t.nodes with
| [] -> (false,false)
| 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 ->
(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
let get_height : Topology.t -> string -> int =
fun t ->
height ([]) t
(***********************************************************)
(***********************************************************)
let (make : bool -> string array -> 'v t) =
fun dynlink argv ->
let args =
......@@ -168,6 +232,19 @@ let (make : bool -> string array -> 'v t) =
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.verbose_level := args.verbose;
Random.init args.seed;
if !Register.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;
......
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