graphGen.ml 8.68 KiB
(* 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:int option ref = ref None
let generate_du_dur graph plan_udg t : unit =
if (t.dotUDG <> "") then (
make_dot_udg_qudg graph plan_udg (t.qudg.width,t.qudg.height) (t.dotUDGrad));
if (t.dotUDGrad <> "") then (
make_dot_udg_qudg graph plan_udg (t.qudg.width,t.qudg.height) ~r0:(t.qudg.radius)
~r1:(t.qudg.r1) (t.dotUDGrad);
Printf.printf "%f -- %f" t.qudg.radius t.qudg.r1
)
let compute_attr : (Topology.t -> string list -> (string * string) list) =
fun g ->
List.map
(fun attr ->
Printf.eprintf "Computing %s\n" attr;
flush stderr;
attr,match attr with
| "min_deg" ->
string_of_int
(match !min_max with
| None -> (
let min, max = Topology.get_degree g in
min_max := Some (min, max);
min)
| Some x -> fst x)
| "mean_deg" ->
string_of_float (Topology.get_mean_degree g)
| "max_deg" ->
string_of_int (match !min_max with
| None -> (
let x = get_degree g in
min_max := Some x;
snd x)
| Some x -> snd x)
| "is_connected" ->
string_of_bool (
match !connected_cyclic with
| None -> (
let x = is_connected_and_cyclic g in
connected_cyclic := Some x;
fst x)
| Some x -> fst x )
| "is_cyclic" ->
string_of_bool
(match !connected_cyclic with
| None -> (
let x = is_connected_and_cyclic g in
connected_cyclic := Some x;
snd x)
| Some x -> snd x )
| "is_tree" ->
string_of_bool
(match !connected_cyclic with
| None -> (
let x = is_connected_and_cyclic g in
connected_cyclic := Some x; (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)
| 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 all_attr : (Topology.t -> (string * string) list) =
fun g ->
[ "min_deg", string_of_int
(match !min_max with
| None -> (
Printf.eprintf "Computing the min_degree...\n"; flush stderr;
let min, max = Topology.get_degree g in
min_max := Some (min, max);
min)
| Some x -> fst x);
"mean_deg", string_of_float (
Printf.eprintf "Computing the mean_degree...\n"; flush stderr;
Topology.get_mean_degree g);
"max_deg", string_of_int (match !min_max with
| None -> (
Printf.eprintf "Computing the max_degree...\n";
flush stderr;
let x = get_degree g in
min_max := Some x;
snd x)
| Some x -> snd x);
"is_connected", string_of_bool (
match !connected_cyclic with
| None -> (
Printf.eprintf "Computing the connection...\n";
flush stderr;
let x = is_connected_and_cyclic g in
connected_cyclic := Some x;
fst x)
| Some x -> fst x );
"is_cyclic", string_of_bool
(match !connected_cyclic with
| None -> (
Printf.eprintf "Computing the cyclicity...\n";
flush stderr;
let x = is_connected_and_cyclic g in
connected_cyclic := Some x;
snd x)
| Some x -> snd x );
"is_tree", string_of_bool
(match !connected_cyclic with
| None -> (
Printf.eprintf "Computing the tree-ness...\n";
flush stderr;
let x = is_connected_and_cyclic g in
connected_cyclic := Some x;
(fst x) && (snd x))
| Some x -> (fst x) && (snd x) );
"links_number", string_of_int (
Printf.eprintf "Computing the link_number...\n";
flush stderr;
get_nb_link g);
(*
"diameter", string_of_int (
Printf.eprintf "Computing the diameter...\n";
flush stderr;
Diameter.get g)
*)
]
let to_dot_string : (t -> string -> (string * string) list -> string) =
fun g name attrs ->
let attrs_to_string (an,av) = Printf.sprintf "%s=%s" an av in
let graph_attr =
if attrs = [] then "" else
Printf.sprintf "graph [%s]" (String.concat " " (List.map attrs_to_string attrs))
in
let node_to_node_string n =
Printf.sprintf " %s [algo=\"%s\"]\n" n.id n.file
in
let nodes = String.concat "" (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%s\n%s\n%s\n}\n" name graph_attr 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 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
let dot = to_dot_string t !name attrs 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
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)
then Printf.eprintf "Generating a %s graph...\n" t.action;
flush stderr;
let dir = t.directed in
let g = ( match t.action with
| "void" -> exit 0
| "clique" -> (gen_clique dir t.n)
| "star" -> (gen_star dir t.n)
| "ring" -> (gen_ring dir t.n)
| "grid" -> (gen_grid dir t.grid.height t.grid.width)
| "HC" -> (gen_hyper_cube dir t.n)
| "ER" -> (gen_ER dir t.n t.er)
| "BA" -> (gen_BA dir t.n t.ba)
| "tree" -> (rand_tree dir t.n)
| "UDG" ->
let (graph, plan) =
gen_udg dir 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 dir 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 (all_attr g );
if (t.outputFile <> "" && not t.silent)
then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile
)