From 30481377e689d9ede88c3921cfba5dc5c45367ae Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Tue, 2 Jul 2019 16:42:01 +0200 Subject: [PATCH 01/16] Added the tool genGraph, to create .dot graph files (random ones or not, depending on the graph type). --- tools/graphgen/communGraph.ml | 120 ++++++++++++ tools/graphgen/communGraph.mli | 18 ++ tools/graphgen/graphGen.ml | 63 +++++++ tools/graphgen/graphGen.mli | 18 ++ tools/graphgen/graphGen_arg.ml | 332 +++++++++++++++++++++++++++++++++ tools/graphgen/randomGraph.ml | 217 +++++++++++++++++++++ tools/graphgen/randomGraph.mli | 18 ++ 7 files changed, 786 insertions(+) create mode 100644 tools/graphgen/communGraph.ml create mode 100644 tools/graphgen/communGraph.mli create mode 100644 tools/graphgen/graphGen.ml create mode 100644 tools/graphgen/graphGen.mli create mode 100644 tools/graphgen/graphGen_arg.ml create mode 100644 tools/graphgen/randomGraph.ml create mode 100644 tools/graphgen/randomGraph.mli diff --git a/tools/graphgen/communGraph.ml b/tools/graphgen/communGraph.ml new file mode 100644 index 0000000..2f38299 --- /dev/null +++ b/tools/graphgen/communGraph.ml @@ -0,0 +1,120 @@ +open GraphGen +open List + +type node_succ_t = (string, (int option * string) list) Hashtbl.t +(*type node_by_i_t = (int, string) Hashtbl.t*) + +let nid_list_remove : (node_id list -> node_id -> (int option*node_id) list) = + fun l e -> fold_right (fun elem acc -> if(elem <> e) then (None,elem)::acc else acc ) l [] + + +let (gen_clique: int -> topology) = + fun nb -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + List.iter (fun node_id -> Hashtbl.replace node_succ node_id (nid_list_remove nodes node_id)) nodes; + { + nodes = nodes ; + succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + } + + +let (gen_star: int -> topology) = + fun nb -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = "root"::(create_nodes "p" (1,nb)) in + let first = hd nodes in + List.iter (fun node -> Hashtbl.replace node_succ node (if node = first then nid_list_remove nodes node else [(None,first)])) nodes; + { + nodes = nodes; + succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + } + +let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem -> (None,elem)) li + +let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list)) = + fun li -> + let node_succ:node_succ_t = Hashtbl.create (length li) in + let (_,ret) = fold_right (fun elem ((first,prev),accu) -> + let elem = elem in + if first = "" then + ((elem,elem),[[""; prev]]) + else + ( + match accu with + | [_;x]::tl -> ((first,elem),[first;prev]::([elem;x]::tl)) + | _ -> assert false + ) + ) li (("",(hd li)),[]) in + iter2 (fun neighbours elem -> Hashtbl.replace node_succ elem (add_weight neighbours)) ret li ; + (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + + let (gen_ring: int -> topology) = + fun nb -> + let nodes = (create_nodes "p" (0,nb)) in + { + nodes = nodes ; + succ = neighbours_ring nodes + } + + +let (gen_grid: int -> int -> topology) = + fun length width -> + let nb = length*width in + let nodes = (create_nodes "p" (0,nb)) and table = Hashtbl.create nb in + for i=0 to length-1 do + for j=0 to width-1 do + let n_id = (List.nth nodes (j*length + i)) in + let bl = if(i=0) then 0 else -1 in + let br = if(i=(length-1)) then 0 else 1 in + let bup = if(j=0) then 0 else -1 in + let bdown = if(j=(width-1)) then 0 else 1 in + for ip=bl to br do + for jp=bup to bdown do + if not ((ip=0 && jp=0) || (ip=jp) || (ip = -jp)) then + (Hashtbl.replace table n_id ((None,(List.nth nodes ((j+jp)*length + i+ip)))::(try Hashtbl.find table n_id with Not_found -> [])); ) else () + done; + done; + done; + done; + { + nodes= nodes ; + succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> [])) + } + + +let log2 x = (Float.log x)/. (Float.log 2.) + +let rec aux1 : (node_id array -> node_succ_t -> unit) = + fun na n_s -> + let len = Array.length na in let mid = len / 2 in + if len > 1 then + let n1 = (Array.sub na 0 mid) and n2 = (Array.sub na mid mid) in + aux1 n1 n_s; + aux1 n2 n_s; + Array.iter2 (fun node1 node2 -> + Hashtbl.replace n_s node1 + ((None,node2)::(try Hashtbl.find n_s node1 with Not_found -> [])); + Hashtbl.replace n_s node2 + ((None,node1)::(try Hashtbl.find n_s node2 with Not_found -> [])) + ) n1 n2 + +let neighbours_hyper_cube : (node_id list -> (node_id -> (int option * node_id) list)) = + fun nl -> + let na = Array.of_list nl in + let (node_succ:node_succ_t) = Hashtbl.create (Array.length na) in + aux1 na node_succ; + (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + +let gen_hyper_cube : (int -> topology) = + fun dim -> + let nb = int_of_float (2. ** (float_of_int dim)) in + let nodes = (create_nodes "p" (0,nb)) in + { + nodes = nodes ; + succ = neighbours_hyper_cube nodes; + } +(* +open AlmostNodes +open CommunGraph;; +neighbours_hyper_cube (AlmostNodes.mn [2,"root.ml",All "";2,"dc",All "1" ;2,"",All "10";2,"cws",All "11"]);; +gen_hyper_cube (AlmostNodes.mn [8,"root.ml",All ""]);; +*) diff --git a/tools/graphgen/communGraph.mli b/tools/graphgen/communGraph.mli new file mode 100644 index 0000000..8bfa1a8 --- /dev/null +++ b/tools/graphgen/communGraph.mli @@ -0,0 +1,18 @@ +(*open GraphGen*) +(** take a node list and generate clique graph with it *) +val gen_clique : (int -> GraphGen.topology) + +(** take a node list and generate star graph with it *) +val gen_star : (int -> GraphGen.topology) + +(** take a node list and generate ring graph with it *) +val gen_ring :(int -> GraphGen.topology) + +(** take a node list and the two dimension i,j of the grid and return a grid graph whith these dimension +the number of node must be correct unless return an error *) +val gen_grid : (int -> int -> GraphGen.topology) + +(** take a node list and generate hyper cube graph with it +the number of node must be correct unless return an error *) +val gen_hyper_cube : (int -> GraphGen.topology) + diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml new file mode 100644 index 0000000..9719638 --- /dev/null +++ b/tools/graphgen/graphGen.ml @@ -0,0 +1,63 @@ + +type node_id = string + +type topology = { + nodes : node_id list; + succ: node_id -> (int option * node_id) list +} + +let rand : (int -> int -> int) = + (* Makes a random number between the two arguments *) + fun min max -> min + Random.int (max-min) + +let rec create_nodes : (string -> int*int -> node_id list) = + (* Create names from a generic name *) + fun name (start,finish) -> + if start >= finish then [] else + let tmp : node_id = name ^ (string_of_int (start)) in + tmp::(create_nodes name (start+1, finish)) + + +let make_links_dot : (topology -> string) = + fun t -> + let links = List.flatten ( + List.map (fun n -> + let l = t.succ n in + List.mapi (fun i (w,neighbour) -> + ( + match w with + | None -> if n < neighbour then + Printf.sprintf ("%s -- %s") n neighbour + else + Printf.sprintf ("%s -- %s") neighbour n + | Some x -> + Printf.sprintf ("%s -- %s [weight=%d]") n neighbour x + ) + + ) l + ) t.nodes + ) in + String.concat "\n" (List.sort_uniq compare links) + +let rec make_nodes_dot : (node_id list -> string) = + (*Create a string in the dot syntax from a node list*) + function + | [] -> "" + | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node)^(make_nodes_dot tail) + +let make_dot : (topology -> string -> unit) = + (*Create a dot file from a graph*) + fun t file_name -> + let name = ref "graph0" in + let f = (if file_name = "" then stdout else + ( + name := Filename.remove_extension file_name; + (*if Filename.extension file_name <> ".dot" then + (open_out (file_name ^".dot")) + else*) open_out file_name + ) + ) in + let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot + (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) + diff --git a/tools/graphgen/graphGen.mli b/tools/graphgen/graphGen.mli new file mode 100644 index 0000000..0178c09 --- /dev/null +++ b/tools/graphgen/graphGen.mli @@ -0,0 +1,18 @@ + +type node_id = string + +type topology = { + nodes : node_id list; + succ: node_id -> (int option * node_id) list +} + +(** Gives a random int between the two arguments. Useful to have a random nodes number *) +val rand : (int -> int -> int) + +(** Create a name (i.d. node ID) list from a generic name *) +val create_nodes : (string -> int*int -> node_id list) + +val make_links_dot : (topology -> string) + +(** Create a dot file from a graph *) +val make_dot : (topology -> string -> unit) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml new file mode 100644 index 0000000..145996a --- /dev/null +++ b/tools/graphgen/graphGen_arg.ml @@ -0,0 +1,332 @@ +open GraphGen +open CommunGraph +open RandomGraph + +let () = Random.self_init (); + +type action = string +type nodes_file = Stdin | ANP of string | DOT of string +type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list | FileP of string +type grid_arg = { + mutable width: int; + mutable height: int; +} + +type udg_arg = { + mutable width: float; + mutable height: float; + mutable radius: float; + mutable proba: udg_proba; +} + +type er_prob = float (*between 0 and 1*) +type ba_m = int (*positive*) + +type t = { + mutable outputFile: string; + mutable action: action; + + mutable n : int; + mutable grid : grid_arg; + mutable er : er_prob; + mutable ba : ba_m; + mutable udg : udg_arg; + + mutable silent : bool; + + mutable _args : (string * Arg.spec * string) list; + mutable _general_man : (string * (string list * action) list) list; + + mutable _others : string list; + mutable _margin : int; +} + +let usage_msg print_command tool = + if print_command then + ("usage: " ^ tool ^ " [options] [args] \nuse -h to see the available commands.\n\n" ) + else + ("usage: "^tool^" [options] [args]\nuse -h to see avaible options") + +let print_usage tool = Printf.printf "%s\n" (usage_msg false tool); flush stdout + + +let (make_args : unit -> t) = + fun () -> + { + outputFile = ""; + action = "void"; + + n = 0; + grid = { + width = 0; + height = 0; + }; + er = 0.3; + ba = 2; + udg = { + width = 0.; + height = 0.; + radius = 0.; + proba = ConstP 1.; + }; + + silent = false; + + _args = []; + _general_man = []; + + _others = []; + _margin = 12; + } + +let myexit i = exit i + +let first_line b = ( + try ( + let f = String.index b '\n' in + String.sub b 0 f + ) with Not_found -> b +) +let file_notfound f = ( + prerr_string ("File not found: \""^f^"\""); + prerr_newline (); + myexit 1 +) +let unexpected s = ( + prerr_string ("unexpected argument \""^s^"\""); + prerr_newline (); + myexit 1 +) + + +let printSpec args outChannel action (c, messageList) = ( + List.iter (fun (ml,action_type) -> + if (action <> action_type && action_type <> "all") then () + else ( + let (m1, oth) = match ml with + | h::t -> (h,t) + | _ -> ("",[]) + in + let t2 = String.make args._margin ' ' in + let cl = 1 + String.length c in + let t1 = if (cl < args._margin ) then + String.make (args._margin - cl) ' ' + else + "\n"^t2 + in + Printf.fprintf outChannel "%s%s%s" c t1 m1; + List.iter (function x -> Printf.fprintf outChannel "\n%s%s" t2 x) oth ; + Printf.fprintf outChannel "\n" ; + ) + ) messageList +) + +let help args tool = ( + Printf.printf "\n"; + Printf.printf "%s" (usage_msg (args.action = "void") tool); + Printf.printf "\n"; + ( + if (args.action <> "void") then + List.iter (printSpec args stdout args.action) (List.rev args._general_man) + else + List.iter (printSpec args stdout "") [ + ("clique",[(["Generate a clique graph"],"")]); + ("star",[(["Generate a star graph"],"")]); + ("ring",[(["Generate a ring graph"],"")]); + ("grid",[(["Generate a grid graph"],"")]); + ("HC",[(["Generate a hyper-cube graph"],"")]); + ("ER",[(["Generate a graph using the Erdos Renyi model"],"")]); + ("BA",[(["Generate a graph using the Barabasi–Albert model"],"")]); + ("tree",[(["Generate an acyclic graph (tree)"],"")]); + ("UDG",[(["Generate a graph using the Unit Disc Graph model"],"")]); + ] + ); + Printf.printf "\n"; + exit 0 +) + + +let (mkopt : t -> string list -> ?arg:string -> Arg.spec -> + (string list * action) list -> unit) = + fun opt ol ?(arg="") se ml -> + let add_option o = opt._args <- (o, se, "")::opt._args in + List.iter add_option ol ; + let col1 = (String.concat ", " ol)^arg in + opt._general_man <- (col1, ml)::opt._general_man + +(*** User Options Tab **) +let (mkoptab : string array -> t -> unit) = + fun argv args -> ( + + mkopt args ["--standard_ouput";"-stdout"] + (Arg.Unit (fun () -> args.outputFile <- "")) + [(["Set the output channel for the generated graph to stdout. This is the output by default"; + "The output will have a DOT file syntax.\n"],"all")]; + + mkopt args ["--DOT_output";"-o"] ~arg:" " + (Arg.String (fun s -> args.outputFile <- s)) + [(["Set the output file for fot the generated graph to the given file."; + "The output will have a DOT file syntax.\n"],"all")]; + + let msg = "Set the node number in the graph\n" in + mkopt args ["--nodes_number";"-n"] ~arg:" " + (Arg.Int (fun n -> match args.action with + | "grid" | "HC" | "void" -> unexpected "-n" + | _ -> args.n <- n )) + [([msg],"clique");([msg],"star");([msg],"ring");([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG")]; + + mkopt args ["--dimension";"-d"] ~arg:" " + (Arg.Int (fun n -> match args.action with + | "HC"-> args.n <- n + | _ -> unexpected "-d")) + [(["Set the hyper-cube dimension.\n"],"HC")]; + + mkopt args ["--width";"-w"] ~arg:" " + (Arg.Float (fun w -> match args.action with + | "grid" -> args.grid.width <- (int_of_float w) + | "UDG" -> args.udg.width <- w + | _ -> unexpected "-w" )) + [(["Set the grid's width to the value (intiger)\n"],"grid");(["Set the UDG's terrain width to the value (float)\n"],"UDG")]; + + mkopt args ["--height";"-h"] ~arg:" " + (Arg.Float (fun h -> match args.action with + | "grid" -> args.grid.height <- (int_of_float h) + | "UDG" -> args.udg.height <- h + | _ -> unexpected "-h")) + [(["Set the grid's height to the value (intiger)\n"],"grid");(["Set the UDG's terrain height to the value (float)\n"],"UDG")]; + + + mkopt args ["--edge_probability";"-p"]~arg:" " + (Arg.Float (fun p -> match args.action with + | "ER" -> args.er <- p + | _ -> unexpected "-p")) + [(["Set the edge appering probability to the given value.";"Must be between 0 and 1, and is set to 0.3 by default\n"],"ER")]; + + + mkopt args ["--";"-m"]~arg:" " + (Arg.Int (fun m -> match args.action with + | "BA" -> args.ba <- m + | _ -> unexpected "-m")) + [(["Set the nuber of edge generated per additionnal node to the given value (2 by default)\n"],"BA")]; + + mkopt args ["--radius";"-r"]~arg:" " + (Arg.Float (fun r -> match args.action with + | "UDG" -> args.udg.radius <- r + | _ -> unexpected "-r")) + [(["Set the UDG's unit disc radius around a node to the given value (float)\n"],"UDG")]; + + mkopt args ["--constant_p";"-cp"] ~arg:" " + (Arg.Float (fun i -> args.udg.proba <- ConstP i)) + [(["...";"...";"...\n"], "UDG")]; + + mkopt args ["--PropToList_p";"-pl"] + (Arg.Unit (fun () -> args.udg.proba <- LstP [])) + [(["...";"...";"...\n"], "UDG")]; + + mkopt args ["--PropToCoupleList_p";"-pc"] + (Arg.Unit (fun () -> args.udg.proba <- CplLstP [])) + [(["...";"...";"...\n"], "UDG")]; + + (*mkopt args ["--probabilityFile";"-pf"] ~arg:" " + (Arg.String (fun _ -> ())) + [(["Useless."; + "Ment to change the probability of connecting according to a function in the given file,"; + " but not implemented yet\n"], "UDG")];*) + + mkopt args ["--silent";"-s"] + (Arg.Unit (fun b -> args.silent <- true)) + [(["Remove all outputs, exept ones made by other options.\n"],"all")]; + + mkopt args ["--help";"-h"] + (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action))(*; Printf.printf "\nDone\n"; exit 0*))) + [(["Prints the help\n"],"all")]; + ) + +(* all unrecognized options are accumulated *) +let (add_other : t -> string -> unit) = + fun opt s -> + opt._others <- s::opt._others + +let current = ref 1;; + +let parse argv = ( + let save_current = !current in + try ( + let args = make_args () in + (if (Array.length argv) = 1 then help args (argv.(0))); + let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in + ( + if (List.mem argv.(1) possible_actions) then args.action <- argv.(1) + else + if (List.mem argv.(1) ["-h";"--help";"-help"]) then help args (argv.(0)) else + (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n%s\n" (argv.(0)) (argv.(1)) + (usage_msg true argv.(0)); exit 2) + ); + mkoptab argv args; + (*(if (Array.length argv) = 2 then + (Printf.fprintf stderr "*** Error when calling '%s %s': argument missing\n\n%s\n" (argv.(0)) (argv.(1)) + (usage_msg false (argv.(0)^argv.(1))); exit 2) + );*) + + Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); + current := save_current; + (List.iter + (fun f -> + if (String.sub f 0 1 = "-") then + unexpected f + else + match args.action with + | "UDG" -> ( + match args.udg.proba with + | ConstP _ -> unexpected f + | LstP l -> args.udg.proba <- LstP ((float_of_string f)::l) + | CplLstP cl -> let cpl = ref (0.,0.) in ( + Scanf.sscanf f "%f,%f" (fun f1 f2 -> cpl := (f1,f2)); + args.udg.proba <- CplLstP ((!cpl)::cl) + ) + | FileP _ -> unexpected f + ) + | _ -> unexpected f + ) (List.rev args._others) + ); + args + ) + with + | Arg.Bad msg -> + Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0)) + (first_line msg) (usage_msg true argv.(0)); exit 2; + | Arg.Help msg -> + + exit 3 +) + +let () = ( + let t = parse Sys.argv in + let args_msg = ref "" in + let g = ( match t.action with + | "void" -> exit 0 + | "clique" -> (gen_clique t.n) + | "star" -> (gen_star t.n) + | "ring" -> (gen_ring t.n) + | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; gen_grid t.grid.height t.grid.width) + | "HC" -> (gen_hyper_cube t.n) + | "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er) + | "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba) + | "tree" -> (rand_tree t.n) + | "UDG" -> ( + args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius; + match t.udg.proba with + | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(p_constant_udg c)) + | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilies" !args_msg; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(manudgp l t.udg.radius)) + | CplLstP cl -> (args_msg := Printf.sprintf "%s and a list of probabilies accordig to the distance" !args_msg; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(manudgcpl cl)) + | FileP _ -> (Printf.fprintf stderr "Can't read an external function.\nPlease une a bult-in function\n"; exit 0) + ) + | _ -> (Printf.fprintf stderr "Unexpected outcome. May need debug.\nCommand line : %s\n" (String.concat " " (Array.to_list Sys.argv)); exit 2) + ) in + if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; + make_dot g t.outputFile; + if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile +) diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml new file mode 100644 index 0000000..fac7c0f --- /dev/null +++ b/tools/graphgen/randomGraph.ml @@ -0,0 +1,217 @@ +open GraphGen +open List + +type node_by_i_t = (int, string) Hashtbl.t +type node_succ_t = (node_id, (int option * node_id) list) Hashtbl.t +type probability = float (*between 0 and 1*) + +let gen_ER : (int -> probability -> topology) = + fun nb p -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + iteri (fun i n -> + iteri (fun j m -> + if (i < j) && (Random.float 1.) < p then + (Hashtbl.replace node_succ n + ((None,m)::(try Hashtbl.find node_succ n with Not_found -> [])); + Hashtbl.replace node_succ m + ((None,n)::(try Hashtbl.find node_succ m with Not_found -> []))) + ) nodes + ) nodes; + { + nodes = nodes ; + succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []); + } + + +let rec init_m_nodes : (int -> node_succ_t -> node_id list -> node_id list) = + fun i node_succ -> + function + | (node::tail) -> + if i > 0 then + (Hashtbl.replace node_succ node []; + init_m_nodes (i-1) node_succ tail) + else node::tail + | _ -> assert false + +let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int option * node_id) list)) = + fun nodes m node_succ -> + let d_tot = 2 * m and nodes = init_m_nodes m node_succ nodes in + match nodes with + | [] -> assert false + | head::nodes -> Hashtbl.replace node_succ head ( + Hashtbl.fold (fun n _ succ -> Hashtbl.replace node_succ n [(None,head)]; (None,n)::succ) node_succ [] + ); + (*init terminée. On a un graph connexe pour les m+1 premiers points, nl ne contient que les points non ajoutés*) + ignore (fold_left (fun deg_tot node -> + + let deg_temp = deg_tot and succ = ref [] in + let deg_temp = ref deg_temp in + + for i = 0 to m-1 do (*for each edge to create*) + let ran = Random.int !deg_temp in + ignore (Hashtbl.fold (fun n_id n_succ r -> + if r >= 0 && not (List.mem (None,n_id) !succ) then + let r = r - (length n_succ) in ( + if r < 0 then + (succ := (None,n_id)::!succ; + Hashtbl.replace node_succ n_id + ((None,node)::n_succ); + deg_temp := !deg_temp - length n_succ) + ); r + else r + ) node_succ ran); + + done; + + + Hashtbl.replace node_succ node !succ; + (deg_tot + (2 * m)) + + ) d_tot nodes); + (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + + + + + +let gen_BA : (int -> int -> topology) = + fun nb m -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + if nb < m + 1 then failwith (Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1)); + { + nodes = nodes; + succ = neighbours_BA nodes m node_succ; + } + +let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * node_id) list)) = + fun node_succ -> + function + | [] -> failwith "Tree Error : You need at least one nodes in your tree" + | h::t -> + ignore (List.fold_left (fun acc elem -> + let no = (List.nth acc (Random.int (List.length acc))) in + (Hashtbl.replace node_succ no ((None,elem)::(try Hashtbl.find node_succ no with Not_found -> [])); + Hashtbl.replace node_succ elem ((None,no)::(try Hashtbl.find node_succ elem with Not_found -> [])) + ); + (elem::acc) + ) [h] (t)); + (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + +let (rand_tree: int -> topology) = + fun nb -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + { + nodes = nodes; + succ = (pre_rand_tree node_succ nodes) + } + + +type node_udg = node_id*float*float +type plan_udg = node_udg list +type prob_udg = (float -> float) + +(* utils for UDG : *) + +let manudgp : (float list -> float -> prob_udg) = + fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d))) + +let manudgcpl : (((float*float) list) -> prob_udg) = + fun cpl d -> + let (_,tmp) = (List.fold_right (fun elem acc -> + let (dis,_) = elem and (dist,i) = acc in + if ((dist -. dis)> 0.) then ((dist -. dis),i+1) + else acc + + ) cpl (d,0)) in let (_,p) = (List.nth cpl tmp) in p + +let p_constant_udg : (float -> prob_udg) = + fun x _ -> x + +let (recommand_radius: float -> float -> float -> float -> float) = + fun degmean nb_node h w -> + if(degmean > nb_node) then + failwith "Error greater or equal number of node than mean degree is needed" + else + sqrt ((h*.w)*.degmean/.(Float.pi*.nb_node)) + +let (recommand_degmean:float -> float -> float -> float -> float) = + fun radius nb_node h w -> + ((radius**2.)*.Float.pi*.nb_node)/.(h*.w) + +let (reccomand_nb_node:float -> float -> float -> float -> int) = + fun radius degmean h w -> + (int_of_float ((degmean*.h*.w)/.((radius**2.)*.Float.pi)))+1 + +(* UDG implementation : *) + +let (make_plan_udg: node_id list -> float -> float -> plan_udg) = + fun nodes x y -> + List.fold_right (fun elem acc -> (elem,(Random.float x),(Random.float y))::acc ) (nodes) ([]) + +let (dist_udg: node_udg -> node_udg -> float) = + fun n1 n2 -> + let (_,x1,y1) = n1 and (_,x2,y2) = n2 in + sqrt (((x1-.x2)**2.) +. ((y1 -. y2)**2.)) + +let (rand_udg: prob_udg -> float -> bool) = + fun f d -> + (f d>= Random.float 1.) + +let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = + fun ?(p=(fun x -> 1.)) nb x y r -> + let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + let pl = (make_plan_udg nodes x y) in + List.iter (fun node -> + let nodeu = List.fold_right (fun elem acc -> + let (no,_,_) = elem in + if no = node then elem else acc + ) (pl) (List.hd pl) in + List.iter (fun elem -> + let (n,_,_) = elem and dist = dist_udg nodeu elem in + if ((dist <= 2.*.r) && node <> n) then + ( + let d = if (dist >= r) then (dist -. r) else dist in + (if (rand_udg p d) then + Hashtbl.replace node_succ node ((None,n)::(try Hashtbl.find node_succ node with Not_found -> []))) + ) + ) pl + ) nodes; + { + nodes = nodes ; + succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> [])); + } + +(***************************************************************) + +let rec make_nodes_dot : (node_udg list -> float -> string) = + (*Create a string in the dot syntax from a node list*) + fun nudg r -> + match nudg with + | [] -> "" + | head::tail -> + let (node,x,y) = head in + (*(Printf.sprintf "%s [algo=\"%s\",pos=\"%f,%f!\"]\n" node.id node.file x y )^*) + (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ + let draw_rad = if(r <> -1.) then + (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in + draw_rad^(make_nodes_dot tail r) + +let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = + (*Create a dot file from a graph*) + fun t plan dim ?(r = -1.) file_name -> + let name = ref "graph0" in + let f = (if file_name = "" then stdout else + ( + name := Filename.remove_extension file_name; + open_out file_name + ) + ) in + let (w,l) = dim in + let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in + let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos + + + ^(make_nodes_dot plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot; + close_out f + (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli new file mode 100644 index 0000000..4444d9b --- /dev/null +++ b/tools/graphgen/randomGraph.mli @@ -0,0 +1,18 @@ +open GraphGen +type probability = float (*between 0 and 1*) +type prob_udg = (float ->float) + + +val gen_ER : (int -> probability -> topology) + +val gen_BA : (int -> int -> topology) + +val rand_tree: (int -> topology) + +val manudgp: (float list -> float -> (float -> float)) + +val manudgcpl: (((float*float) list) -> (float -> float)) + +val p_constant_udg: (float -> (float -> float)) + +val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> topology) -- GitLab From 0fda1cce2ef116a1026e42158f4b28633cd2bb35 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Thu, 4 Jul 2019 12:00:51 +0200 Subject: [PATCH 02/16] Added GraphGen to dune. The command is gg. Also added some comments to some .mli files, and reorganized a bit the functions. --- tools/graphgen/communGraph.ml | 5 +- tools/graphgen/communGraph.mli | 25 +++-- tools/graphgen/dune | 9 ++ tools/graphgen/ggcore.ml | 63 +++++++++++ tools/graphgen/{graphGen.mli => ggcore.mli} | 0 tools/graphgen/graphGen.ml | 114 +++++++++----------- tools/graphgen/graphGen_arg.ml | 85 +++------------ tools/graphgen/graphGen_arg.mli | 38 +++++++ tools/graphgen/randomGraph.ml | 25 +++-- tools/graphgen/randomGraph.mli | 52 +++++++-- 10 files changed, 248 insertions(+), 168 deletions(-) create mode 100644 tools/graphgen/dune create mode 100644 tools/graphgen/ggcore.ml rename tools/graphgen/{graphGen.mli => ggcore.mli} (100%) create mode 100644 tools/graphgen/graphGen_arg.mli diff --git a/tools/graphgen/communGraph.ml b/tools/graphgen/communGraph.ml index 2f38299..b8d1db9 100644 --- a/tools/graphgen/communGraph.ml +++ b/tools/graphgen/communGraph.ml @@ -1,4 +1,4 @@ -open GraphGen +open Ggcore open List type node_succ_t = (string, (int option * string) list) Hashtbl.t @@ -80,9 +80,6 @@ let (gen_grid: int -> int -> topology) = succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> [])) } - -let log2 x = (Float.log x)/. (Float.log 2.) - let rec aux1 : (node_id array -> node_succ_t -> unit) = fun na n_s -> let len = Array.length na in let mid = len / 2 in diff --git a/tools/graphgen/communGraph.mli b/tools/graphgen/communGraph.mli index 8bfa1a8..2d39d7e 100644 --- a/tools/graphgen/communGraph.mli +++ b/tools/graphgen/communGraph.mli @@ -1,18 +1,17 @@ -(*open GraphGen*) -(** take a node list and generate clique graph with it *) -val gen_clique : (int -> GraphGen.topology) +open Ggcore -(** take a node list and generate star graph with it *) -val gen_star : (int -> GraphGen.topology) +(** Generate a clique graph of n nodes *) +val gen_clique : (int -> topology) + +(** Generate a star graph of n nodes *) +val gen_star : (int -> topology) -(** take a node list and generate ring graph with it *) -val gen_ring :(int -> GraphGen.topology) +(** Generate a ring graph of n nodes *) +val gen_ring :(int -> topology) -(** take a node list and the two dimension i,j of the grid and return a grid graph whith these dimension -the number of node must be correct unless return an error *) -val gen_grid : (int -> int -> GraphGen.topology) +(** take the two dimension i,j of the grid and return a grid graph whith these dimension *) +val gen_grid : (int -> int -> topology) -(** take a node list and generate hyper cube graph with it -the number of node must be correct unless return an error *) -val gen_hyper_cube : (int -> GraphGen.topology) +(** take a dimension and generate hyper cube graph of this dimension *) +val gen_hyper_cube : (int -> topology) diff --git a/tools/graphgen/dune b/tools/graphgen/dune new file mode 100644 index 0000000..8881164 --- /dev/null +++ b/tools/graphgen/dune @@ -0,0 +1,9 @@ +(executable + (name graphGen) + (libraries ) +) + +(install + (section bin) +(files (graphGen.exe as gg)) +) diff --git a/tools/graphgen/ggcore.ml b/tools/graphgen/ggcore.ml new file mode 100644 index 0000000..143837f --- /dev/null +++ b/tools/graphgen/ggcore.ml @@ -0,0 +1,63 @@ + +type node_id = string + +type topology = { + nodes : node_id list; + succ: node_id -> (int option * node_id) list +} + +let rand : (int -> int -> int) = + (* Makes a random number between the two arguments *) + fun min max -> min + Random.int (max-min) + +let rec create_nodes : (string -> int*int -> node_id list) = + (* Create names from a generic name *) + fun name (start,finish) -> + if start >= finish then [] else + let tmp : node_id = name ^ (string_of_int (start)) in + tmp::(create_nodes name (start+1, finish)) + + +let make_links_dot : (topology -> string) = + fun t -> + let links = List.flatten ( + List.map (fun n -> + let l = t.succ n in + List.map (fun (w,neighbour) -> + ( + match w with + | None -> if n < neighbour then + Printf.sprintf ("%s -- %s") n neighbour + else + Printf.sprintf ("%s -- %s") neighbour n + | Some x -> + Printf.sprintf ("%s -- %s [weight=%d]") n neighbour x + ) + + ) l + ) t.nodes + ) in + String.concat "\n" (List.sort_uniq compare links) + +let rec make_nodes_dot : (node_id list -> string) = + (*Create a string in the dot syntax from a node list*) + function + | [] -> "" + | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node)^(make_nodes_dot tail) + +let make_dot : (topology -> string -> unit) = + (*Create a dot file from a graph*) + fun t file_name -> + let name = ref "graph0" in + let f = (if file_name = "" then stdout else + ( + name := Filename.remove_extension file_name; + (*if Filename.extension file_name <> ".dot" then + (open_out (file_name ^".dot")) + else*) open_out file_name + ) + ) in + let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot + (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) + \ No newline at end of file diff --git a/tools/graphgen/graphGen.mli b/tools/graphgen/ggcore.mli similarity index 100% rename from tools/graphgen/graphGen.mli rename to tools/graphgen/ggcore.mli diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index 9719638..5595343 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -1,63 +1,53 @@ - -type node_id = string - -type topology = { - nodes : node_id list; - succ: node_id -> (int option * node_id) list -} - -let rand : (int -> int -> int) = - (* Makes a random number between the two arguments *) - fun min max -> min + Random.int (max-min) - -let rec create_nodes : (string -> int*int -> node_id list) = - (* Create names from a generic name *) - fun name (start,finish) -> - if start >= finish then [] else - let tmp : node_id = name ^ (string_of_int (start)) in - tmp::(create_nodes name (start+1, finish)) - - -let make_links_dot : (topology -> string) = - fun t -> - let links = List.flatten ( - List.map (fun n -> - let l = t.succ n in - List.mapi (fun i (w,neighbour) -> - ( - match w with - | None -> if n < neighbour then - Printf.sprintf ("%s -- %s") n neighbour - else - Printf.sprintf ("%s -- %s") neighbour n - | Some x -> - Printf.sprintf ("%s -- %s [weight=%d]") n neighbour x +open Ggcore +open CommunGraph +open RandomGraph +open GraphGen_arg + +let () = ( + let t = parse Sys.argv in + + if (t.n < 0) then ( + match t.action with + | "void" | "grid" -> () + | "HC" -> ( + t.n <- 3; + Printf.fprintf stderr "=========================================================================\n"; + Printf.fprintf stderr "Caution : the dimension is not defined or negative. It has been set to 3.\n"; + Printf.fprintf stderr "=========================================================================\n" + ) + | _ -> ( + t.n <- 10; + Printf.fprintf stderr "=============================================================================\n"; + Printf.fprintf stderr "Caution : the nodes number is not defined or negative. It has been set to 10.\n"; + Printf.fprintf stderr "=============================================================================\n" + ) + ); + let args_msg = ref "" in + let g = ( match t.action with + | "void" -> exit 0 + | "clique" -> (gen_clique t.n) + | "star" -> (gen_star t.n) + | "ring" -> (gen_ring t.n) + | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; gen_grid t.grid.height t.grid.width) + | "HC" -> (gen_hyper_cube t.n) + | "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er) + | "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba) + | "tree" -> (rand_tree t.n) + | "UDG" -> ( + args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius; + match t.udg.proba with + | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_constant c)) + | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_list l t.udg.radius)) + | CplLstP cl -> (args_msg := Printf.sprintf "%s and a list of probabilities according to the distance" !args_msg; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_couple_list cl)) + | FileP _ -> (Printf.fprintf stderr "Can't read an external function for the moment.\nPlease use a built-in function\n"; exit 0) ) - - ) l - ) t.nodes - ) in - String.concat "\n" (List.sort_uniq compare links) - -let rec make_nodes_dot : (node_id list -> string) = - (*Create a string in the dot syntax from a node list*) - function - | [] -> "" - | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node)^(make_nodes_dot tail) - -let make_dot : (topology -> string -> unit) = - (*Create a dot file from a graph*) - fun t file_name -> - let name = ref "graph0" in - let f = (if file_name = "" then stdout else - ( - name := Filename.remove_extension file_name; - (*if Filename.extension file_name <> ".dot" then - (open_out (file_name ^".dot")) - else*) open_out file_name - ) - ) in - let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in - Printf.fprintf f "%s" dot - (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) - + | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); + assert false) + ) in + if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; + make_dot g t.outputFile; + if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile +) \ No newline at end of file diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 145996a..b5d5a99 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -1,11 +1,6 @@ -open GraphGen -open CommunGraph -open RandomGraph - let () = Random.self_init (); type action = string -type nodes_file = Stdin | ANP of string | DOT of string type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list | FileP of string type grid_arg = { mutable width: int; @@ -45,10 +40,7 @@ let usage_msg print_command tool = if print_command then ("usage: " ^ tool ^ " [options] [args] \nuse -h to see the available commands.\n\n" ) else - ("usage: "^tool^" [options] [args]\nuse -h to see avaible options") - -let print_usage tool = Printf.printf "%s\n" (usage_msg false tool); flush stdout - + ("usage: "^tool^" [options] [args]\nuse -h to see available options") let (make_args : unit -> t) = fun () -> @@ -56,7 +48,7 @@ let (make_args : unit -> t) = outputFile = ""; action = "void"; - n = 0; + n = -1; grid = { width = 0; height = 0; @@ -87,11 +79,6 @@ let first_line b = ( String.sub b 0 f ) with Not_found -> b ) -let file_notfound f = ( - prerr_string ("File not found: \""^f^"\""); - prerr_newline (); - myexit 1 -) let unexpected s = ( prerr_string ("unexpected argument \""^s^"\""); prerr_newline (); @@ -165,7 +152,7 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--DOT_output";"-o"] ~arg:" " (Arg.String (fun s -> args.outputFile <- s)) - [(["Set the output file for fot the generated graph to the given file."; + [(["Set the output file for the generated graph to the given file."; "The output will have a DOT file syntax.\n"],"all")]; let msg = "Set the node number in the graph\n" in @@ -186,28 +173,28 @@ let (mkoptab : string array -> t -> unit) = | "grid" -> args.grid.width <- (int_of_float w) | "UDG" -> args.udg.width <- w | _ -> unexpected "-w" )) - [(["Set the grid's width to the value (intiger)\n"],"grid");(["Set the UDG's terrain width to the value (float)\n"],"UDG")]; + [(["Set the grid's width to the value (integer)\n"],"grid");(["Set the UDG's terrain width to the value (float)\n"],"UDG")]; mkopt args ["--height";"-h"] ~arg:" " (Arg.Float (fun h -> match args.action with | "grid" -> args.grid.height <- (int_of_float h) | "UDG" -> args.udg.height <- h | _ -> unexpected "-h")) - [(["Set the grid's height to the value (intiger)\n"],"grid");(["Set the UDG's terrain height to the value (float)\n"],"UDG")]; + [(["Set the grid's height to the value (integer)\n"],"grid");(["Set the UDG's terrain height to the value (float)\n"],"UDG")]; mkopt args ["--edge_probability";"-p"]~arg:" " (Arg.Float (fun p -> match args.action with | "ER" -> args.er <- p | _ -> unexpected "-p")) - [(["Set the edge appering probability to the given value.";"Must be between 0 and 1, and is set to 0.3 by default\n"],"ER")]; + [(["Set the edge appearing probability to the given value.";"Must be between 0 and 1, and is set to 0.3 by default\n"],"ER")]; mkopt args ["--";"-m"]~arg:" " (Arg.Int (fun m -> match args.action with | "BA" -> args.ba <- m | _ -> unexpected "-m")) - [(["Set the nuber of edge generated per additionnal node to the given value (2 by default)\n"],"BA")]; + [(["Set the number of edge generated per additional node to the given value (2 by default)\n"],"BA")]; mkopt args ["--radius";"-r"]~arg:" " (Arg.Float (fun r -> match args.action with @@ -215,27 +202,21 @@ let (mkoptab : string array -> t -> unit) = | _ -> unexpected "-r")) [(["Set the UDG's unit disc radius around a node to the given value (float)\n"],"UDG")]; - mkopt args ["--constant_p";"-cp"] ~arg:" " + mkopt args ["--proba_from_constant";"-pc"] ~arg:" " (Arg.Float (fun i -> args.udg.proba <- ConstP i)) [(["...";"...";"...\n"], "UDG")]; - mkopt args ["--PropToList_p";"-pl"] + mkopt args ["--proba_from_list";"-pl"] (Arg.Unit (fun () -> args.udg.proba <- LstP [])) [(["...";"...";"...\n"], "UDG")]; - mkopt args ["--PropToCoupleList_p";"-pc"] + mkopt args ["--proba_from_couple_list";"-pcl"] (Arg.Unit (fun () -> args.udg.proba <- CplLstP [])) [(["...";"...";"...\n"], "UDG")]; - (*mkopt args ["--probabilityFile";"-pf"] ~arg:" " - (Arg.String (fun _ -> ())) - [(["Useless."; - "Ment to change the probability of connecting according to a function in the given file,"; - " but not implemented yet\n"], "UDG")];*) - mkopt args ["--silent";"-s"] - (Arg.Unit (fun b -> args.silent <- true)) - [(["Remove all outputs, exept ones made by other options.\n"],"all")]; + (Arg.Unit (fun () -> args.silent <- true)) + [(["Remove all outputs, except ones made by other options.\n"],"all")]; mkopt args ["--help";"-h"] (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action))(*; Printf.printf "\nDone\n"; exit 0*))) @@ -251,8 +232,8 @@ let current = ref 1;; let parse argv = ( let save_current = !current in + let args = make_args () in try ( - let args = make_args () in (if (Array.length argv) = 1 then help args (argv.(0))); let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in ( @@ -263,10 +244,6 @@ let parse argv = ( (usage_msg true argv.(0)); exit 2) ); mkoptab argv args; - (*(if (Array.length argv) = 2 then - (Printf.fprintf stderr "*** Error when calling '%s %s': argument missing\n\n%s\n" (argv.(0)) (argv.(1)) - (usage_msg false (argv.(0)^argv.(1))); exit 2) - );*) Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); current := save_current; @@ -295,38 +272,6 @@ let parse argv = ( | Arg.Bad msg -> Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0)) (first_line msg) (usage_msg true argv.(0)); exit 2; - | Arg.Help msg -> - - exit 3 -) - -let () = ( - let t = parse Sys.argv in - let args_msg = ref "" in - let g = ( match t.action with - | "void" -> exit 0 - | "clique" -> (gen_clique t.n) - | "star" -> (gen_star t.n) - | "ring" -> (gen_ring t.n) - | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; gen_grid t.grid.height t.grid.width) - | "HC" -> (gen_hyper_cube t.n) - | "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er) - | "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba) - | "tree" -> (rand_tree t.n) - | "UDG" -> ( - args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius; - match t.udg.proba with - | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(p_constant_udg c)) - | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilies" !args_msg; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(manudgp l t.udg.radius)) - | CplLstP cl -> (args_msg := Printf.sprintf "%s and a list of probabilies accordig to the distance" !args_msg; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(manudgcpl cl)) - | FileP _ -> (Printf.fprintf stderr "Can't read an external function.\nPlease une a bult-in function\n"; exit 0) - ) - | _ -> (Printf.fprintf stderr "Unexpected outcome. May need debug.\nCommand line : %s\n" (String.concat " " (Array.to_list Sys.argv)); exit 2) - ) in - if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; - make_dot g t.outputFile; - if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile + | Arg.Help _msg -> + help args argv.(0) ) diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli new file mode 100644 index 0000000..14dd01a --- /dev/null +++ b/tools/graphgen/graphGen_arg.mli @@ -0,0 +1,38 @@ +type action = string + +type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list | FileP of string +type grid_arg = { + mutable width: int; + mutable height: int; +} + +type udg_arg = { + mutable width: float; + mutable height: float; + mutable radius: float; + mutable proba: udg_proba; +} + +type er_prob = float (*between 0 and 1*) +type ba_m = int (*positive*) + +type t = { + mutable outputFile: string; + mutable action: action; + + mutable n : int; + mutable grid : grid_arg; + mutable er : er_prob; + mutable ba : ba_m; + mutable udg : udg_arg; + + mutable silent : bool; + + mutable _args : (string * Arg.spec * string) list; + mutable _general_man : (string * (string list * action) list) list; + + mutable _others : string list; + mutable _margin : int; +} + +val parse : (string array -> t) \ No newline at end of file diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index fac7c0f..410aa96 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -1,7 +1,6 @@ -open GraphGen +open Ggcore open List -type node_by_i_t = (int, string) Hashtbl.t type node_succ_t = (node_id, (int option * node_id) list) Hashtbl.t type probability = float (*between 0 and 1*) @@ -47,7 +46,7 @@ let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int opti let deg_temp = deg_tot and succ = ref [] in let deg_temp = ref deg_temp in - for i = 0 to m-1 do (*for each edge to create*) + for _ = 0 to m-1 do (*for each edge to create*) let ran = Random.int !deg_temp in ignore (Hashtbl.fold (fun n_id n_succ r -> if r >= 0 && not (List.mem (None,n_id) !succ) then @@ -112,19 +111,19 @@ type prob_udg = (float -> float) (* utils for UDG : *) -let manudgp : (float list -> float -> prob_udg) = +let proba_from_list : (float list -> float -> prob_udg) = fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d))) -let manudgcpl : (((float*float) list) -> prob_udg) = +let proba_from_couple_list : (((float*float) list) -> prob_udg) = fun cpl d -> let (_,tmp) = (List.fold_right (fun elem acc -> - let (dis,_) = elem and (dist,i) = acc in - if ((dist -. dis)> 0.) then ((dist -. dis),i+1) - else acc + let (dis,_) = elem and (dist,i) = acc in let diff = (dist -. dis) in + if (diff > 0.) then (diff,i+1) + else (diff,i) ) cpl (d,0)) in let (_,p) = (List.nth cpl tmp) in p -let p_constant_udg : (float -> prob_udg) = +let proba_from_constant : (float -> prob_udg) = fun x _ -> x let (recommand_radius: float -> float -> float -> float -> float) = @@ -158,7 +157,7 @@ let (rand_udg: prob_udg -> float -> bool) = (f d>= Random.float 1.) let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = - fun ?(p=(fun x -> 1.)) nb x y r -> + fun ?(p=(fun _ -> 1.)) nb x y r -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in let pl = (make_plan_udg nodes x y) in List.iter (fun node -> @@ -183,7 +182,7 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = (***************************************************************) -let rec make_nodes_dot : (node_udg list -> float -> string) = +let rec make_nodes_dot_udg : (node_udg list -> float -> string) = (*Create a string in the dot syntax from a node list*) fun nudg r -> match nudg with @@ -194,7 +193,7 @@ let rec make_nodes_dot : (node_udg list -> float -> string) = (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ let draw_rad = if(r <> -1.) then (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in - draw_rad^(make_nodes_dot tail r) + draw_rad^(make_nodes_dot_udg tail r) let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = (*Create a dot file from a graph*) @@ -211,7 +210,7 @@ let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos - ^(make_nodes_dot plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in Printf.fprintf f "%s" dot; close_out f (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 4444d9b..49c7f52 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -1,18 +1,58 @@ -open GraphGen +open Ggcore type probability = float (*between 0 and 1*) -type prob_udg = (float ->float) +type node_udg = node_id*float*float +type plan_udg = node_udg list +type prob_udg = (float -> probability) (* if p is of type prob_udg, then for a distance d between two UDG nodes, + [p d] should give the probability of having an edge between the UDG nodes. *) + +(** [gen_ER n p] generate a graph using Erdos Renyi model, + of n nodes and of probability p for each possible edge to appear. *) val gen_ER : (int -> probability -> topology) +(** [gen_BA n m] generate a graph using Barabasi–Albert model, + of n nodes and with m edges added for each new node. + m has to be lower than n. + The initialization is a star of m+1 nodes, with the (m+1)th node being the root. + Barabasi–Albert model is used for the remaining nodes *) val gen_BA : (int -> int -> topology) +(** [rand_tree n] generate a random tree of n nodes *) val rand_tree: (int -> topology) -val manudgp: (float list -> float -> (float -> float)) +(** [gen_udg ~p n w h r] generate a graph using Unit Disc Graph model of n nodes. + w and h are the width and the height of the space in which the nodes are randomly disposed, + and r is the Unit Disc radius. + If two Unit Discs from different nodes touch themselves, + p will be run to obtain the probability of an edge appearing between these nodes. + p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*) +val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> topology) + +(** create a probability function for UDG that always return the same probability *) +val proba_from_constant: (float -> prob_udg) -val manudgcpl: (((float*float) list) -> (float -> float)) +(** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance. + It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on. + For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on. + Note that r must be equal to the radius of the Unit Disc *) +val proba_from_list: (float list -> float -> prob_udg) -val p_constant_udg: (float -> (float -> float)) +(** [proba_from_couple_list cpl] is similar to proba_from_list, but with a custom slice length. + for each element (r,p) of cpl, r sets the size of the slice, and p the probability in this slice. + So, "proba_from_list [1.;0.5;0.3;0.1] 10" + and "proba_from_couple_list [(2.5,1.);(2.5,0.5);(2.5,0.3);(2.5,0.1)]" are equivalent. + Note that the sum of the r of each tuple must be equal to the radius of the Unit Disc *) +val proba_from_couple_list: (((float*float) list) -> prob_udg) -val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> topology) +(** *) +val recommand_radius : (float -> float -> float -> float -> float) + +(** *) +val recommand_degmean : (float -> float -> float -> float -> float) + +(** *) +val reccomand_nb_node : (float -> float -> float -> float -> int) + +(** *) +val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) \ No newline at end of file -- GitLab From 082a21b2ef4b2cc12a3f8b530c7638adbcd9cd33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nathan=20R=C3=A9biscoul?= Date: Thu, 4 Jul 2019 15:49:01 +0200 Subject: [PATCH 03/16] add makde_dot_udg --- tools/graphgen/graphGen.ml | 35 ++++++++++++++-------- tools/graphgen/graphGen_arg.ml | 52 +++++++++++++++++++++------------ tools/graphgen/graphGen_arg.mli | 6 ++-- tools/graphgen/randomGraph.ml | 21 ++++++------- tools/graphgen/randomGraph.mli | 4 +-- 5 files changed, 74 insertions(+), 44 deletions(-) diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index 5595343..9f789da 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -14,7 +14,7 @@ let () = ( Printf.fprintf stderr "=========================================================================\n"; Printf.fprintf stderr "Caution : the dimension is not defined or negative. It has been set to 3.\n"; Printf.fprintf stderr "=========================================================================\n" - ) + ) | _ -> ( t.n <- 10; Printf.fprintf stderr "=============================================================================\n"; @@ -35,19 +35,30 @@ let () = ( | "tree" -> (rand_tree t.n) | "UDG" -> ( args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius; - match t.udg.proba with - | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_constant c)) - | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_list l t.udg.radius)) - | CplLstP cl -> (args_msg := Printf.sprintf "%s and a list of probabilities according to the distance" !args_msg; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_couple_list cl)) - | FileP _ -> (Printf.fprintf stderr "Can't read an external function for the moment.\nPlease use a built-in function\n"; exit 0) + let prob_func = (match t.udg.proba with + | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; (proba_from_constant c)) + | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; (proba_from_list l t.udg.radius)) + | CplLstP cl -> ( + args_msg := Printf.sprintf "%s and a list of probabilities according to the distance" !args_msg; + (proba_from_couple_list cl) + ) + | FileP _ -> (Printf.fprintf stderr "Can't read an external function for the moment.\nPlease use a built-in function\n"; exit 0) + ) in + let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in + if (t.dotUDG <> "") then ( + make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot"); + ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG )) + ); + if (t.dotUDGrad <> "") then ( + make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot"); + ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad )) + ); + graph ) - | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); + | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); assert false) - ) in + ) in if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; make_dot g t.outputFile; if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile -) \ No newline at end of file +) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index b5d5a99..8e4f360 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -19,6 +19,8 @@ type ba_m = int (*positive*) type t = { mutable outputFile: string; + mutable dotUDG: string; + mutable dotUDGrad: string; mutable action: action; mutable n : int; @@ -30,22 +32,24 @@ type t = { mutable silent : bool; mutable _args : (string * Arg.spec * string) list; - mutable _general_man : (string * (string list * action) list) list; + mutable _general_man : (string * (string list * action) list) list; mutable _others : string list; mutable _margin : int; } -let usage_msg print_command tool = - if print_command then +let usage_msg print_command tool = + if print_command then ("usage: " ^ tool ^ " [options] [args] \nuse -h to see the available commands.\n\n" ) else ("usage: "^tool^" [options] [args]\nuse -h to see available options") -let (make_args : unit -> t) = - fun () -> +let (make_args : unit -> t) = + fun () -> { outputFile = ""; + dotUDG = ""; + dotUDGrad = ""; action = "void"; n = -1; @@ -66,7 +70,7 @@ let (make_args : unit -> t) = _args = []; _general_man = []; - + _others = []; _margin = 12; } @@ -142,17 +146,17 @@ let (mkopt : t -> string list -> ?arg:string -> Arg.spec -> opt._general_man <- (col1, ml)::opt._general_man (*** User Options Tab **) -let (mkoptab : string array -> t -> unit) = +let (mkoptab : string array -> t -> unit) = fun argv args -> ( mkopt args ["--standard_ouput";"-stdout"] (Arg.Unit (fun () -> args.outputFile <- "")) - [(["Set the output channel for the generated graph to stdout. This is the output by default"; + [(["Set the output channel for the generated graph to stdout. This is the output by default"; "The output will have a DOT file syntax.\n"],"all")]; mkopt args ["--DOT_output";"-o"] ~arg:" " (Arg.String (fun s -> args.outputFile <- s)) - [(["Set the output file for the generated graph to the given file."; + [(["Set the output file for the generated graph to the given file."; "The output will have a DOT file syntax.\n"],"all")]; let msg = "Set the node number in the graph\n" in @@ -175,7 +179,7 @@ let (mkoptab : string array -> t -> unit) = | _ -> unexpected "-w" )) [(["Set the grid's width to the value (integer)\n"],"grid");(["Set the UDG's terrain width to the value (float)\n"],"UDG")]; - mkopt args ["--height";"-h"] ~arg:" " + mkopt args ["--height";"-he"] ~arg:" " (Arg.Float (fun h -> match args.action with | "grid" -> args.grid.height <- (int_of_float h) | "UDG" -> args.udg.height <- h @@ -214,18 +218,30 @@ let (mkoptab : string array -> t -> unit) = (Arg.Unit (fun () -> args.udg.proba <- CplLstP [])) [(["...";"...";"...\n"], "UDG")]; + mkopt args ["--dot_udg";"-du"]~arg:" " + (Arg.String (fun f -> match args.action with + | "UDG" -> args.dotUDG <- f + | _ -> unexpected "-mdudg")) + [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")]; + + mkopt args ["--dot_udg_radius";"-dur"]~arg:" " + (Arg.String (fun f -> match args.action with + | "UDG" -> args.dotUDGrad <- f + | _ -> unexpected "-mdudg")) + [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")]; + mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) [(["Remove all outputs, except ones made by other options.\n"],"all")]; mkopt args ["--help";"-h"] - (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action))(*; Printf.printf "\nDone\n"; exit 0*))) + (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action)))) [(["Prints the help\n"],"all")]; ) (* all unrecognized options are accumulated *) let (add_other : t -> string -> unit) = - fun opt s -> + fun opt s -> opt._others <- s::opt._others let current = ref 1;; @@ -247,11 +263,11 @@ let parse argv = ( Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); current := save_current; - (List.iter - (fun f -> + (List.iter + (fun f -> if (String.sub f 0 1 = "-") then - unexpected f - else + unexpected f + else match args.action with | "UDG" -> ( match args.udg.proba with @@ -271,7 +287,7 @@ let parse argv = ( with | Arg.Bad msg -> Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0)) - (first_line msg) (usage_msg true argv.(0)); exit 2; - | Arg.Help _msg -> + (first_line msg) (usage_msg true argv.(0)); exit 2; + | Arg.Help _msg -> help args argv.(0) ) diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index 14dd01a..c34945f 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -18,6 +18,8 @@ type ba_m = int (*positive*) type t = { mutable outputFile: string; + mutable dotUDG: string; + mutable dotUDGrad: string; mutable action: action; mutable n : int; @@ -29,10 +31,10 @@ type t = { mutable silent : bool; mutable _args : (string * Arg.spec * string) list; - mutable _general_man : (string * (string list * action) list) list; + mutable _general_man : (string * (string list * action) list) list; mutable _others : string list; mutable _margin : int; } -val parse : (string array -> t) \ No newline at end of file +val parse : (string array -> t) diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 410aa96..308bd06 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -23,14 +23,14 @@ let gen_ER : (int -> probability -> topology) = let rec init_m_nodes : (int -> node_succ_t -> node_id list -> node_id list) = - fun i node_succ -> - function + fun i node_succ -> + function | (node::tail) -> if i > 0 then (Hashtbl.replace node_succ node []; init_m_nodes (i-1) node_succ tail) else node::tail - | _ -> assert false + | _ -> assert false let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int option * node_id) list)) = fun nodes m node_succ -> @@ -86,14 +86,14 @@ let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * no fun node_succ -> function | [] -> failwith "Tree Error : You need at least one nodes in your tree" - | h::t -> + | h::t -> ignore (List.fold_left (fun acc elem -> let no = (List.nth acc (Random.int (List.length acc))) in (Hashtbl.replace node_succ no ((None,elem)::(try Hashtbl.find node_succ no with Not_found -> [])); Hashtbl.replace node_succ elem ((None,no)::(try Hashtbl.find node_succ elem with Not_found -> [])) ); (elem::acc) - ) [h] (t)); + ) [h] (t)); (fun n -> try Hashtbl.find node_succ n with Not_found -> []) let (rand_tree: int -> topology) = @@ -156,7 +156,7 @@ let (rand_udg: prob_udg -> float -> bool) = fun f d -> (f d>= Random.float 1.) -let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = +let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg)) = fun ?(p=(fun _ -> 1.)) nb x y r -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in let pl = (make_plan_udg nodes x y) in @@ -167,10 +167,10 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = ) (pl) (List.hd pl) in List.iter (fun elem -> let (n,_,_) = elem and dist = dist_udg nodeu elem in - if ((dist <= 2.*.r) && node <> n) then + if ((dist <= 2.*.r) && node <> n) then ( - let d = if (dist >= r) then (dist -. r) else dist in - (if (rand_udg p d) then + let d = if (dist >= r) then (dist -. r) else dist in + (if (rand_udg p d) then Hashtbl.replace node_succ node ((None,n)::(try Hashtbl.find node_succ node with Not_found -> []))) ) ) pl @@ -178,7 +178,7 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = { nodes = nodes ; succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> [])); - } + },pl (***************************************************************) @@ -212,5 +212,6 @@ let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in Printf.fprintf f "%s" dot; + flush f; close_out f (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 49c7f52..bb8d55a 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -27,7 +27,7 @@ val rand_tree: (int -> topology) If two Unit Discs from different nodes touch themselves, p will be run to obtain the probability of an edge appearing between these nodes. p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*) -val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> topology) +val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg)) (** create a probability function for UDG that always return the same probability *) val proba_from_constant: (float -> prob_udg) @@ -55,4 +55,4 @@ val recommand_degmean : (float -> float -> float -> float -> float) val reccomand_nb_node : (float -> float -> float -> float -> int) (** *) -val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) \ No newline at end of file +val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) -- GitLab From 0bd29b62c112ae6b585c3b92d1eb071088c4637a Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Fri, 5 Jul 2019 11:40:15 +0200 Subject: [PATCH 04/16] Added comments, enhanced 'gg -h', changed some names, replaced an UDG tool function with another, and other minor things. --- .../{communGraph.ml => commonGraph.ml} | 19 +-- .../{communGraph.mli => commonGraph.mli} | 0 tools/graphgen/dune | 1 - tools/graphgen/graphGen.ml | 7 +- tools/graphgen/graphGen_arg.ml | 138 +++++++++++------- tools/graphgen/graphGen_arg.mli | 2 +- tools/graphgen/randomGraph.ml | 41 +++--- tools/graphgen/randomGraph.mli | 46 +++--- 8 files changed, 144 insertions(+), 110 deletions(-) rename tools/graphgen/{communGraph.ml => commonGraph.ml} (88%) rename tools/graphgen/{communGraph.mli => commonGraph.mli} (100%) diff --git a/tools/graphgen/communGraph.ml b/tools/graphgen/commonGraph.ml similarity index 88% rename from tools/graphgen/communGraph.ml rename to tools/graphgen/commonGraph.ml index b8d1db9..39e077c 100644 --- a/tools/graphgen/communGraph.ml +++ b/tools/graphgen/commonGraph.ml @@ -5,7 +5,7 @@ type node_succ_t = (string, (int option * string) list) Hashtbl.t (*type node_by_i_t = (int, string) Hashtbl.t*) let nid_list_remove : (node_id list -> node_id -> (int option*node_id) list) = - fun l e -> fold_right (fun elem acc -> if(elem <> e) then (None,elem)::acc else acc ) l [] + fun l e -> rev (fold_left (fun acc elem -> if(elem <> e) then (None,elem)::acc else acc ) [] l) let (gen_clique: int -> topology) = @@ -33,8 +33,7 @@ let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list)) = fun li -> let node_succ:node_succ_t = Hashtbl.create (length li) in - let (_,ret) = fold_right (fun elem ((first,prev),accu) -> - let elem = elem in + let (_,ret) = fold_right (fun elem ((first,prev),accu) -> (* have to change it, to use a fold_left *) if first = "" then ((elem,elem),[[""; prev]]) else @@ -80,13 +79,13 @@ let (gen_grid: int -> int -> topology) = succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> [])) } -let rec aux1 : (node_id array -> node_succ_t -> unit) = +let rec link_hypercube_nodes : (node_id array -> node_succ_t -> unit) = fun na n_s -> let len = Array.length na in let mid = len / 2 in if len > 1 then let n1 = (Array.sub na 0 mid) and n2 = (Array.sub na mid mid) in - aux1 n1 n_s; - aux1 n2 n_s; + link_hypercube_nodes n1 n_s; + link_hypercube_nodes n2 n_s; Array.iter2 (fun node1 node2 -> Hashtbl.replace n_s node1 ((None,node2)::(try Hashtbl.find n_s node1 with Not_found -> [])); @@ -98,7 +97,7 @@ let neighbours_hyper_cube : (node_id list -> (node_id -> (int option * node_id) fun nl -> let na = Array.of_list nl in let (node_succ:node_succ_t) = Hashtbl.create (Array.length na) in - aux1 na node_succ; + link_hypercube_nodes na node_succ; (fun n -> try Hashtbl.find node_succ n with Not_found -> []) let gen_hyper_cube : (int -> topology) = @@ -109,9 +108,3 @@ let gen_hyper_cube : (int -> topology) = nodes = nodes ; succ = neighbours_hyper_cube nodes; } -(* -open AlmostNodes -open CommunGraph;; -neighbours_hyper_cube (AlmostNodes.mn [2,"root.ml",All "";2,"dc",All "1" ;2,"",All "10";2,"cws",All "11"]);; -gen_hyper_cube (AlmostNodes.mn [8,"root.ml",All ""]);; -*) diff --git a/tools/graphgen/communGraph.mli b/tools/graphgen/commonGraph.mli similarity index 100% rename from tools/graphgen/communGraph.mli rename to tools/graphgen/commonGraph.mli diff --git a/tools/graphgen/dune b/tools/graphgen/dune index 8881164..e15acda 100644 --- a/tools/graphgen/dune +++ b/tools/graphgen/dune @@ -1,6 +1,5 @@ (executable (name graphGen) - (libraries ) ) (install diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index 5595343..fd408c7 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -1,5 +1,5 @@ open Ggcore -open CommunGraph +open CommonGraph open RandomGraph open GraphGen_arg @@ -40,9 +40,8 @@ let () = ( gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_constant c)) | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_list l t.udg.radius)) - | CplLstP cl -> (args_msg := Printf.sprintf "%s and a list of probabilities according to the distance" !args_msg; - gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(proba_from_couple_list cl)) - | FileP _ -> (Printf.fprintf stderr "Can't read an external function for the moment.\nPlease use a built-in function\n"; exit 0) + | LinearP -> (args_msg := Printf.sprintf "%s and a list of probabilities according to the distance" !args_msg; + gen_udg t.n t.udg.width t.udg.height t.udg.radius ~p:(linear_prob cl)) ) | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); assert false) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index b5d5a99..7e13202 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -1,7 +1,11 @@ let () = Random.self_init (); type action = string -type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list | FileP of string +type udg_proba = + | ConstP of float + | LstP of float list + | ProgP + type grid_arg = { mutable width: int; mutable height: int; @@ -36,11 +40,20 @@ type t = { mutable _margin : int; } -let usage_msg print_command tool = - if print_command then - ("usage: " ^ tool ^ " [options] [args] \nuse -h to see the available commands.\n\n" ) - else - ("usage: "^tool^" [options] [args]\nuse -h to see available options") +let usage_msg do_print_command tool = + if do_print_command then + ("usage: " ^ tool ^ + " [options]\n") + else + ("usage: "^tool^" [options]\n") + +let print_usage output do_print_command tool = + Printf.fprintf output "%s%s" (usage_msg do_print_command tool) ( + if (do_print_command) then + "use -h to see the available commands.\n\n" + else "use -h to see available options.\n" + ) + let (make_args : unit -> t) = fun () -> @@ -113,20 +126,34 @@ let help args tool = ( Printf.printf "%s" (usage_msg (args.action = "void") tool); Printf.printf "\n"; ( - if (args.action <> "void") then - List.iter (printSpec args stdout args.action) (List.rev args._general_man) - else + if (args.action = "void") then ( + Printf.printf "======================\n"; + Printf.printf " Available commands :\n"; + Printf.printf "======================\n"; List.iter (printSpec args stdout "") [ ("clique",[(["Generate a clique graph"],"")]); ("star",[(["Generate a star graph"],"")]); ("ring",[(["Generate a ring graph"],"")]); ("grid",[(["Generate a grid graph"],"")]); ("HC",[(["Generate a hyper-cube graph"],"")]); - ("ER",[(["Generate a graph using the Erdos Renyi model"],"")]); - ("BA",[(["Generate a graph using the Barabasi–Albert model"],"")]); + ("ER",[(["Generate a graph using the Erdos Renyi algo"],"")]); + ("BA",[(["Generate a graph using the Barabasi–Albert algo"],"")]); ("tree",[(["Generate an acyclic graph (tree)"],"")]); - ("UDG",[(["Generate a graph using the Unit Disc Graph model"],"")]); - ] + ("UDG",[(["Generate a graph using the Unit Disc Graph algo"],"")]); + ]; + Printf.printf "\n"; + Printf.printf "Use '%s -h' to see the command's options.\n" tool; + Printf.printf "\n"; + Printf.printf "==================\n"; + Printf.printf " Global options :\n"; + Printf.printf "==================\n"; + ) else ( + Printf.printf "\n"; + Printf.printf "=====================\n"; + Printf.printf " Available options :\n"; + Printf.printf "=====================\n"; + ); + List.iter (printSpec args stdout args.action) (List.rev args._general_man) ); Printf.printf "\n"; exit 0 @@ -145,22 +172,24 @@ let (mkopt : t -> string list -> ?arg:string -> Arg.spec -> let (mkoptab : string array -> t -> unit) = fun argv args -> ( - mkopt args ["--standard_ouput";"-stdout"] + mkopt args ["--standard-output";"-stdout"] (Arg.Unit (fun () -> args.outputFile <- "")) - [(["Set the output channel for the generated graph to stdout. This is the output by default"; + [(["Set the output channel for the generated graph to stdout."; + "This is the output by default"; "The output will have a DOT file syntax.\n"],"all")]; - mkopt args ["--DOT_output";"-o"] ~arg:" " + mkopt args ["--DOT-output";"-o"] ~arg:" " (Arg.String (fun s -> args.outputFile <- s)) [(["Set the output file for the generated graph to the given file."; "The output will have a DOT file syntax.\n"],"all")]; let msg = "Set the node number in the graph\n" in - mkopt args ["--nodes_number";"-n"] ~arg:" " + mkopt args ["--nodes-number";"-n"] ~arg:" " (Arg.Int (fun n -> match args.action with | "grid" | "HC" | "void" -> unexpected "-n" | _ -> args.n <- n )) - [([msg],"clique");([msg],"star");([msg],"ring");([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG")]; + [([msg],"clique");([msg],"star");([msg],"ring"); + ([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG")]; mkopt args ["--dimension";"-d"] ~arg:" " (Arg.Int (fun n -> match args.action with @@ -173,54 +202,67 @@ let (mkoptab : string array -> t -> unit) = | "grid" -> args.grid.width <- (int_of_float w) | "UDG" -> args.udg.width <- w | _ -> unexpected "-w" )) - [(["Set the grid's width to the value (integer)\n"],"grid");(["Set the UDG's terrain width to the value (float)\n"],"UDG")]; + [(["Set the grid's width to the value (integer)\n"],"grid"); + (["Set the UDG's terrain width to the value (float)\n"],"UDG")]; mkopt args ["--height";"-h"] ~arg:" " (Arg.Float (fun h -> match args.action with | "grid" -> args.grid.height <- (int_of_float h) | "UDG" -> args.udg.height <- h | _ -> unexpected "-h")) - [(["Set the grid's height to the value (integer)\n"],"grid");(["Set the UDG's terrain height to the value (float)\n"],"UDG")]; + [(["Set the grid's height to the value (integer)\n"],"grid"); + (["Set the UDG's terrain height to the value (float)\n"],"UDG")]; - mkopt args ["--edge_probability";"-p"]~arg:" " + mkopt args ["--edge-probability";"-p"]~arg:" " (Arg.Float (fun p -> match args.action with | "ER" -> args.er <- p | _ -> unexpected "-p")) - [(["Set the edge appearing probability to the given value.";"Must be between 0 and 1, and is set to 0.3 by default\n"],"ER")]; + [(["Set the edge appearing probability to the given value."; + "Must be between 0 and 1, and is set to 0.3 by default\n"],"ER")]; mkopt args ["--";"-m"]~arg:" " (Arg.Int (fun m -> match args.action with | "BA" -> args.ba <- m | _ -> unexpected "-m")) - [(["Set the number of edge generated per additional node to the given value (2 by default)\n"],"BA")]; + [(["Set the number of edge generated per additional node to the given value"; + "(2 by default)\n"],"BA")]; - mkopt args ["--radius";"-r"]~arg:" " + mkopt args ["--radius";"-r"]~arg:" " (Arg.Float (fun r -> match args.action with | "UDG" -> args.udg.radius <- r | _ -> unexpected "-r")) - [(["Set the UDG's unit disc radius around a node to the given value (float)\n"],"UDG")]; + [(["Set the Unit Disc's radius around a node to the given value.\n"],"UDG")]; - mkopt args ["--proba_from_constant";"-pc"] ~arg:" " + mkopt args ["--prob-from-constant";"-pc"] ~arg:" " (Arg.Float (fun i -> args.udg.proba <- ConstP i)) - [(["...";"...";"...\n"], "UDG")]; + [(["Uses a probability function for UDG that always return the probability given in argument."; + "This probability function will be used to know if an edge will be created when"; + "two Unit Discs touch each other."; + "By default, the probability function is '-pc 1' (which is also the usual UDG).\n"], "UDG")]; - mkopt args ["--proba_from_list";"-pl"] + mkopt args ["--prob-from-list";"-pl"] ~arg:" ..." (Arg.Unit (fun () -> args.udg.proba <- LstP [])) + [([ + "Create a probability function for UDG that changes the probability according to the distance."; + "It divides the Unit Disc into multiple discs (as much as the number of arguments),"; + "and assign a probability to each disc."; + "The arguments taken in account are the actual arguments of the command, and should be floats.\n" + ], "UDG")]; + + mkopt args ["--progressive-prob";"-pp"] + (Arg.Unit (fun () -> args.udg.proba <- ProgP)) [(["...";"...";"...\n"], "UDG")]; - mkopt args ["--proba_from_couple_list";"-pcl"] - (Arg.Unit (fun () -> args.udg.proba <- CplLstP [])) - [(["...";"...";"...\n"], "UDG")]; - - mkopt args ["--silent";"-s"] +(* mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) - [(["Remove all outputs, except ones made by other options.\n"],"all")]; + [(["Remove all outputs, except ones made by other options.\n"],"all")];*) mkopt args ["--help";"-h"] - (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action))(*; Printf.printf "\nDone\n"; exit 0*))) - [(["Prints the help\n"],"all")]; + (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" + else " "^args.action)))) + [(["Prints the help of the command.\n"],"all")]; ) (* all unrecognized options are accumulated *) @@ -240,8 +282,8 @@ let parse argv = ( if (List.mem argv.(1) possible_actions) then args.action <- argv.(1) else if (List.mem argv.(1) ["-h";"--help";"-help"]) then help args (argv.(0)) else - (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n%s\n" (argv.(0)) (argv.(1)) - (usage_msg true argv.(0)); exit 2) + (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n" (argv.(0)) (argv.(1)); + (print_usage stderr true argv.(0)); exit 2) ); mkoptab argv args; @@ -254,24 +296,20 @@ let parse argv = ( else match args.action with | "UDG" -> ( - match args.udg.proba with - | ConstP _ -> unexpected f - | LstP l -> args.udg.proba <- LstP ((float_of_string f)::l) - | CplLstP cl -> let cpl = ref (0.,0.) in ( - Scanf.sscanf f "%f,%f" (fun f1 f2 -> cpl := (f1,f2)); - args.udg.proba <- CplLstP ((!cpl)::cl) - ) - | FileP _ -> unexpected f - ) + match args.udg.proba with + | LstP l -> args.udg.proba <- LstP ((float_of_string f)::l) + | _ -> unexpected f + ) + ) | _ -> unexpected f - ) (List.rev args._others) + ) (List.rev args._others) ); args ) with | Arg.Bad msg -> - Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0)) - (first_line msg) (usage_msg true argv.(0)); exit 2; + Printf.fprintf stderr "*** Error when calling '%s': %s\n" (argv.(0)) (first_line msg); + (print_usage stderr true argv.(0)); exit 2; | Arg.Help _msg -> help args argv.(0) ) diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index 14dd01a..e8adc9e 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -1,6 +1,6 @@ type action = string -type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list | FileP of string +type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list type grid_arg = { mutable width: int; mutable height: int; diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 410aa96..9e3dc28 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -111,41 +111,38 @@ type prob_udg = (float -> float) (* utils for UDG : *) -let proba_from_list : (float list -> float -> prob_udg) = +let prob_from_list : (float list -> float -> prob_udg) = fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d))) -let proba_from_couple_list : (((float*float) list) -> prob_udg) = - fun cpl d -> - let (_,tmp) = (List.fold_right (fun elem acc -> - let (dis,_) = elem and (dist,i) = acc in let diff = (dist -. dis) in - if (diff > 0.) then (diff,i+1) - else (diff,i) +let linear_prob : (float -> prob_udg) = + fun r -> (fun d -> d/r) + ) cpl (d,0)) in let (_,p) = (List.nth cpl tmp) in p -let proba_from_constant : (float -> prob_udg) = +let prob_from_constant : (float -> prob_udg) = fun x _ -> x -let (recommand_radius: float -> float -> float -> float -> float) = - fun degmean nb_node h w -> - if(degmean > nb_node) then - failwith "Error greater or equal number of node than mean degree is needed" +let recommend_radius : (int -> float -> (float * float) -> float) = + fun mean_deg nb_node (h,w) -> + if(mean_deg > nb_node) then + failwith "Error : the number of node should be greater or equal than mean degree" else - sqrt ((h*.w)*.degmean/.(Float.pi*.nb_node)) + sqrt ((h*.w)*.mean_deg/.(Float.pi*.(float_of_int nb_node))) -let (recommand_degmean:float -> float -> float -> float -> float) = - fun radius nb_node h w -> - ((radius**2.)*.Float.pi*.nb_node)/.(h*.w) +let reccomend_nb_node : (float -> float -> (float * float) -> int) = + fun radius mean_deg (h,w) -> + (int_of_float ((mean_deg*.h*.w)/.((radius**2.)*.Float.pi)))+1 -let (reccomand_nb_node:float -> float -> float -> float -> int) = - fun radius degmean h w -> - (int_of_float ((degmean*.h*.w)/.((radius**2.)*.Float.pi)))+1 +let compute_mean_degree : (int -> float -> (float * float) -> float) = + fun radius nb_node (h,w) -> + ((radius**2.)*.Float.pi*.(float_of_int nb_node))/.(h*.w) (* UDG implementation : *) let (make_plan_udg: node_id list -> float -> float -> plan_udg) = fun nodes x y -> - List.fold_right (fun elem acc -> (elem,(Random.float x),(Random.float y))::acc ) (nodes) ([]) + List.map (fun elem -> (elem,(Random.float x),(Random.float y))) (nodes) let (dist_udg: node_udg -> node_udg -> float) = fun n1 n2 -> @@ -161,10 +158,10 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> topology ) = let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in let pl = (make_plan_udg nodes x y) in List.iter (fun node -> - let nodeu = List.fold_right (fun elem acc -> + let nodeu = List.fold_left (fun acc elem -> let (no,_,_) = elem in if no = node then elem else acc - ) (pl) (List.hd pl) in + ) (List.hd pl) (pl) in List.iter (fun elem -> let (n,_,_) = elem and dist = dist_udg nodeu elem in if ((dist <= 2.*.r) && node <> n) then diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 49c7f52..fa263a1 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -3,8 +3,9 @@ type probability = float (*between 0 and 1*) type node_udg = node_id*float*float type plan_udg = node_udg list -type prob_udg = (float -> probability) (* if p is of type prob_udg, then for a distance d between two UDG nodes, - [p d] should give the probability of having an edge between the UDG nodes. *) +type prob_udg = (float -> probability) +(* if p is of type prob_udg, then for a distance d between two UDG nodes, +[p d] should give the probability of having an edge between the UDG nodes. *) (** [gen_ER n p] generate a graph using Erdos Renyi model, @@ -22,7 +23,7 @@ val gen_BA : (int -> int -> topology) val rand_tree: (int -> topology) (** [gen_udg ~p n w h r] generate a graph using Unit Disc Graph model of n nodes. - w and h are the width and the height of the space in which the nodes are randomly disposed, + w and h are the width and the height of the area in which the nodes are randomly disposed, and r is the Unit Disc radius. If two Unit Discs from different nodes touch themselves, p will be run to obtain the probability of an edge appearing between these nodes. @@ -30,29 +31,36 @@ val rand_tree: (int -> topology) val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> topology) (** create a probability function for UDG that always return the same probability *) -val proba_from_constant: (float -> prob_udg) +val prob_from_constant: (float -> prob_udg) (** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance. It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on. For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on. Note that r must be equal to the radius of the Unit Disc *) -val proba_from_list: (float list -> float -> prob_udg) +val prob_from_list: (float list -> float -> prob_udg) -(** [proba_from_couple_list cpl] is similar to proba_from_list, but with a custom slice length. - for each element (r,p) of cpl, r sets the size of the slice, and p the probability in this slice. - So, "proba_from_list [1.;0.5;0.3;0.1] 10" - and "proba_from_couple_list [(2.5,1.);(2.5,0.5);(2.5,0.3);(2.5,0.1)]" are equivalent. - Note that the sum of the r of each tuple must be equal to the radius of the Unit Disc *) -val proba_from_couple_list: (((float*float) list) -> prob_udg) +(** [linear_proba r] gives a function that, for an input d (distance) outputs d/r. + If r is the Unit Disc radius and d the distance between two points, + it outputs a probability that is higher for a low d and lower for a high d. *) +val linear_prob: (float -> prob_udg) -(** *) -val recommand_radius : (float -> float -> float -> float -> float) +(** [recommend_radius n mean_deg h w] returns the recommended radius to give to UDG + in order to get a mean degree approximately equal to mean_deg, + knowing there's n nodes and the UDG is applied in an area of height h and width w. *) +val recommend_radius : (int -> float -> float -> float -> float) -(** *) -val recommand_degmean : (float -> float -> float -> float -> float) +(** [reccomend_nb_node r mean_deg h w] returns the recommended number of nodes + to give to UDG in order to get a mean degree approximately equal to mean_deg, + knowing the radius is r and the UDG is applied in an area of height h and width w. *) +val reccomend_nb_node : (float -> float -> float -> float -> int) -(** *) -val reccomand_nb_node : (float -> float -> float -> float -> int) +(** [compute_mean_degree n r h w] computes and return the approximative mean degree of + an UDG graph with the same arguments. *) +val compute_mean_degree : (int -> float -> float -> float -> float) -(** *) -val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) \ No newline at end of file +(** [make_dot_udg ~r=r g p (h,w) f] Creates a DOT file to represent the UDG area, + r being the radius, g being the graph, p being the UDG area, + and (h,w) being the dimensions of the plan. + If no radius is given, they won't appear on the pdf. + If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) +val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) -- GitLab From 9bb45f3e10c15c3409b646bc52ce797d5ea2de65 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Fri, 5 Jul 2019 15:34:39 +0200 Subject: [PATCH 05/16] Debugged, renamed CommomGraph ClassicGraph, placed all the UDG utils from RandomGraph into a new module, enhanced "gg -s" such that is has effect on warnings, removed "rand" function --- .../{commonGraph.ml => classicGraph.ml} | 23 +++--- .../{commonGraph.mli => classicGraph.mli} | 0 tools/graphgen/ggcore.ml | 15 ++-- tools/graphgen/ggcore.mli | 3 - tools/graphgen/graphGen.ml | 78 ++++++++++--------- tools/graphgen/graphGen_arg.ml | 42 +++++----- tools/graphgen/graphGen_arg.mli | 2 +- tools/graphgen/randomGraph.ml | 67 ---------------- tools/graphgen/randomGraph.mli | 35 --------- tools/graphgen/udgUtils.ml | 70 +++++++++++++++++ tools/graphgen/udgUtils.mli | 42 ++++++++++ 11 files changed, 196 insertions(+), 181 deletions(-) rename tools/graphgen/{commonGraph.ml => classicGraph.ml} (90%) rename tools/graphgen/{commonGraph.mli => classicGraph.mli} (100%) create mode 100644 tools/graphgen/udgUtils.ml create mode 100644 tools/graphgen/udgUtils.mli diff --git a/tools/graphgen/commonGraph.ml b/tools/graphgen/classicGraph.ml similarity index 90% rename from tools/graphgen/commonGraph.ml rename to tools/graphgen/classicGraph.ml index 39e077c..6001554 100644 --- a/tools/graphgen/commonGraph.ml +++ b/tools/graphgen/classicGraph.ml @@ -33,16 +33,19 @@ let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list)) = fun li -> let node_succ:node_succ_t = Hashtbl.create (length li) in - let (_,ret) = fold_right (fun elem ((first,prev),accu) -> (* have to change it, to use a fold_left *) - if first = "" then - ((elem,elem),[[""; prev]]) - else - ( - match accu with - | [_;x]::tl -> ((first,elem),[first;prev]::([elem;x]::tl)) - | _ -> assert false - ) - ) li (("",(hd li)),[]) in + let ((_,last),ret) = fold_left (fun ((first,prev),accu) elem -> + if first = "" then + ((elem,elem),[[""; ""]]) + else + ( + match accu with + | [x;_]::tl -> ((first,elem),[prev;first]::([x;elem]::tl)) + | _ -> assert false + ) + ) (("",""),[]) li in let ret = rev ret in + let ret = (match ret with + | ["";x]::tail -> [last;x]::tail + | _ -> assert false) in iter2 (fun neighbours elem -> Hashtbl.replace node_succ elem (add_weight neighbours)) ret li ; (fun n -> try Hashtbl.find node_succ n with Not_found -> []) diff --git a/tools/graphgen/commonGraph.mli b/tools/graphgen/classicGraph.mli similarity index 100% rename from tools/graphgen/commonGraph.mli rename to tools/graphgen/classicGraph.mli diff --git a/tools/graphgen/ggcore.ml b/tools/graphgen/ggcore.ml index 143837f..e3fb561 100644 --- a/tools/graphgen/ggcore.ml +++ b/tools/graphgen/ggcore.ml @@ -6,10 +6,6 @@ type topology = { succ: node_id -> (int option * node_id) list } -let rand : (int -> int -> int) = - (* Makes a random number between the two arguments *) - fun min max -> min + Random.int (max-min) - let rec create_nodes : (string -> int*int -> node_id list) = (* Create names from a generic name *) fun name (start,finish) -> @@ -51,10 +47,13 @@ let make_dot : (topology -> string -> unit) = let name = ref "graph0" in let f = (if file_name = "" then stdout else ( - name := Filename.remove_extension file_name; - (*if Filename.extension file_name <> ".dot" then - (open_out (file_name ^".dot")) - else*) open_out file_name + name := 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 = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in diff --git a/tools/graphgen/ggcore.mli b/tools/graphgen/ggcore.mli index 0178c09..a6cdc4b 100644 --- a/tools/graphgen/ggcore.mli +++ b/tools/graphgen/ggcore.mli @@ -6,9 +6,6 @@ type topology = { succ: node_id -> (int option * node_id) list } -(** Gives a random int between the two arguments. Useful to have a random nodes number *) -val rand : (int -> int -> int) - (** Create a name (i.d. node ID) list from a generic name *) val create_nodes : (string -> int*int -> node_id list) diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index 81494a1..b297095 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -1,26 +1,28 @@ open Ggcore -open CommonGraph +open ClassicGraph open RandomGraph open GraphGen_arg +open UdgUtils let () = ( let t = parse Sys.argv in if (t.n < 0) then ( - match t.action with - | "void" | "grid" -> () + let msg = match t.action with + | "void" | "grid" -> "" | "HC" -> ( t.n <- 3; - Printf.fprintf stderr "=========================================================================\n"; - Printf.fprintf stderr "Caution : the dimension is not defined or negative. It has been set to 3.\n"; - Printf.fprintf stderr "=========================================================================\n" + "=========================================================================\n"^ + "Caution : the dimension is not defined or negative. It has been set to 3.\n"^ + "=========================================================================\n" ) | _ -> ( t.n <- 10; - Printf.fprintf stderr "=============================================================================\n"; - Printf.fprintf stderr "Caution : the nodes number is not defined or negative. It has been set to 10.\n"; - Printf.fprintf stderr "=============================================================================\n" - ) + "=============================================================================\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 ); let args_msg = ref "" in let g = ( match t.action with @@ -28,36 +30,42 @@ let () = ( | "clique" -> (gen_clique t.n) | "star" -> (gen_star t.n) | "ring" -> (gen_ring t.n) - | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; gen_grid t.grid.height t.grid.width) + | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; + gen_grid t.grid.height t.grid.width) | "HC" -> (gen_hyper_cube t.n) | "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er) | "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba) | "tree" -> (rand_tree t.n) | "UDG" -> ( - args_msg := Printf.sprintf " with w=%f l=%f r=%f" t.udg.width t.udg.height t.udg.radius; - let prob_func = (match t.udg.proba with - | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; (proba_from_constant c)) - | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; (proba_from_list l t.udg.radius)) - | LinearP -> ( - args_msg := Printf.sprintf "%s and a probability proportionnal to to the distance" !args_msg; - (linear_prob t.udg.radius) - ) - ) in - let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in - if (t.dotUDG <> "") then ( - make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot"); - ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG )) - ); - if (t.dotUDGrad <> "") then ( - make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot"); - ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad )) - ); - graph - ) - | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); - assert false) + args_msg := Printf.sprintf " with w=%f l=%f r=%f" + t.udg.width t.udg.height t.udg.radius; + let prob_func = (match t.udg.proba with + | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; + (prob_from_constant c)) + | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; + (prob_from_list l t.udg.radius)) + | LinearP -> ( + args_msg := Printf.sprintf "%s and a linear edge probability" !args_msg; + (linear_prob t.udg.radius) + ) + ) in + let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in + if (t.dotUDG <> "") then ( + make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot"); + ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG)) + ); + if (t.dotUDGrad <> "") then ( + make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot"); + ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad )) + ); + graph + ) + | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" + (String.concat " " (Array.to_list Sys.argv)); assert false) ) in - if (t.outputFile <> "" && not t.silent) then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; + if (t.outputFile <> "" && not t.silent) + then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; make_dot g t.outputFile; - if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile + if (t.outputFile <> "" && not t.silent) + then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile ) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 1805a41..6fc6f13 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -4,7 +4,7 @@ type action = string type udg_proba = | ConstP of float | LstP of float list - | ProgP + | LinearP type grid_arg = { mutable width: int; @@ -73,9 +73,9 @@ let (make_args : unit -> t) = er = 0.3; ba = 2; udg = { - width = 0.; - height = 0.; - radius = 0.; + width = 10.; + height = 10.; + radius = 2.; proba = ConstP 1.; }; @@ -207,7 +207,7 @@ let (mkoptab : string array -> t -> unit) = | "UDG" -> args.udg.width <- w | _ -> unexpected "-w" )) [(["Set the grid's width to the value (integer)\n"],"grid"); - (["Set the UDG's terrain width to the value (float)\n"],"UDG")]; + (["Set the UDG's terrain width to the value (float)";"10 by default.\n"],"UDG")]; mkopt args ["--height";"-he"] ~arg:" " (Arg.Float (fun h -> match args.action with @@ -215,7 +215,7 @@ let (mkoptab : string array -> t -> unit) = | "UDG" -> args.udg.height <- h | _ -> unexpected "-he")) [(["Set the grid's height to the value (integer)\n"],"grid"); - (["Set the UDG's terrain height to the value (float)\n"],"UDG")]; + (["Set the UDG's terrain height to the value (float)";"10 by default.\n"],"UDG")]; mkopt args ["--edge-probability";"-p"]~arg:" " @@ -237,7 +237,7 @@ let (mkoptab : string array -> t -> unit) = (Arg.Float (fun r -> match args.action with | "UDG" -> args.udg.radius <- r | _ -> unexpected "-r")) - [(["Set the Unit Disc's radius around a node to the given value.\n"],"UDG")]; + [(["Set the Unit Disc's radius around a node to the given value.";"3 by default.\n"],"UDG")]; mkopt args ["--prob-from-constant";"-pc"] ~arg:" " (Arg.Float (fun i -> args.udg.proba <- ConstP i)) @@ -256,28 +256,26 @@ let (mkoptab : string array -> t -> unit) = ], "UDG")]; mkopt args ["--progressive-prob";"-pp"] - (Arg.Unit (fun () -> args.udg.proba <- ProgP)) + (Arg.Unit (fun () -> args.udg.proba <- LinearP)) [(["...";"...";"...\n"], "UDG")]; - mkopt args ["--proba_from_couple_list";"-pcl"] - (Arg.Unit (fun () -> args.udg.proba <- CplLstP [])) - [(["...";"...";"...\n"], "UDG")]; - - mkopt args ["--dot_udg";"-du"]~arg:" " + mkopt args ["--dot_udg";"-du"]~arg:" " (Arg.String (fun f -> match args.action with | "UDG" -> args.dotUDG <- f | _ -> unexpected "-mdudg")) - [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")]; + [(["Create a DOT file to visualize the UDG plan."; + "The extension .dot will be added to the file base-name.\n"],"UDG")]; - mkopt args ["--dot_udg_radius";"-dur"]~arg:" " + mkopt args ["--dot_udg_radius";"-dur"]~arg:" " (Arg.String (fun f -> match args.action with | "UDG" -> args.dotUDGrad <- f | _ -> unexpected "-mdudg")) - [(["Create a DOT file to visualize the UDG plan.\n"],"UDG")]; + [(["Create a DOT file to visualize the UDG plan."; + "The extension .dot will be added to the file base-name.\n"],"UDG")]; -(* mkopt args ["--silent";"-s"] + mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) - [(["Remove all outputs, except ones made by other options.\n"],"all")];*) + [(["Remove all outputs, except ones made by other options.\n"],"all")]; mkopt args ["--help";"-h"] (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" @@ -295,6 +293,7 @@ let current = ref 1;; let parse argv = ( let save_current = !current in let args = make_args () in + mkoptab argv args; try ( (if (Array.length argv) = 1 then help args (argv.(0))); let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in @@ -305,23 +304,22 @@ let parse argv = ( (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n" (argv.(0)) (argv.(1)); (print_usage stderr true argv.(0)); exit 2) ); - mkoptab argv args; Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); current := save_current; (List.iter (fun f -> - if (String.sub f 0 1 = "-") then + if (String.sub f 0 1 = "-") then ( unexpected f - else + ) else ( match args.action with | "UDG" -> ( match args.udg.proba with | LstP l -> args.udg.proba <- LstP ((float_of_string f)::l) | _ -> unexpected f ) - ) | _ -> unexpected f + ) ) (List.rev args._others) ); args diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index bf12aee..70d476e 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -1,6 +1,6 @@ type action = string -type udg_proba = |ConstP of float | LstP of float list | CplLstP of (float*float) list +type udg_proba = | ConstP of float | LstP of float list | LinearP type grid_arg = { mutable width: int; mutable height: int; diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 28dca95..8e0a45e 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -109,37 +109,6 @@ type node_udg = node_id*float*float type plan_udg = node_udg list type prob_udg = (float -> float) -(* utils for UDG : *) - -let prob_from_list : (float list -> float -> prob_udg) = - fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d))) - -let linear_prob : (float -> prob_udg) = - fun r -> (fun d -> d/r) - - - ) cpl (d,0)) in let (_,p) = (List.nth cpl tmp) in p - -let prob_from_constant : (float -> prob_udg) = - fun x _ -> x - -let recommend_radius : (int -> float -> (float * float) -> float) = - fun mean_deg nb_node (h,w) -> - if(mean_deg > nb_node) then - failwith "Error : the number of node should be greater or equal than mean degree" - else - sqrt ((h*.w)*.mean_deg/.(Float.pi*.(float_of_int nb_node))) - -let reccomend_nb_node : (float -> float -> (float * float) -> int) = - fun radius mean_deg (h,w) -> - (int_of_float ((mean_deg*.h*.w)/.((radius**2.)*.Float.pi)))+1 - -let compute_mean_degree : (int -> float -> (float * float) -> float) = - fun radius nb_node (h,w) -> - ((radius**2.)*.Float.pi*.(float_of_int nb_node))/.(h*.w) - -(* UDG implementation : *) - let (make_plan_udg: node_id list -> float -> float -> plan_udg) = fun nodes x y -> List.map (fun elem -> (elem,(Random.float x),(Random.float y))) (nodes) @@ -176,39 +145,3 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (topology * plan_ nodes = nodes ; succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> [])); },pl - -(***************************************************************) - -let rec make_nodes_dot_udg : (node_udg list -> float -> string) = - (*Create a string in the dot syntax from a node list*) - fun nudg r -> - match nudg with - | [] -> "" - | head::tail -> - let (node,x,y) = head in - (*(Printf.sprintf "%s [algo=\"%s\",pos=\"%f,%f!\"]\n" node.id node.file x y )^*) - (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ - let draw_rad = if(r <> -1.) then - (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in - draw_rad^(make_nodes_dot_udg tail r) - -let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = - (*Create a dot file from a graph*) - fun t plan dim ?(r = -1.) file_name -> - let name = ref "graph0" in - let f = (if file_name = "" then stdout else - ( - name := Filename.remove_extension file_name; - open_out file_name - ) - ) in - let (w,l) = dim in - let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in - let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos - - - ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in - Printf.fprintf f "%s" dot; - flush f; - close_out f - (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 4cd3146..140c7ac 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -29,38 +29,3 @@ val rand_tree: (int -> topology) p will be run to obtain the probability of an edge appearing between these nodes. p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*) val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg)) - -(** create a probability function for UDG that always return the same probability *) -val prob_from_constant: (float -> prob_udg) - -(** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance. - It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on. - For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on. - Note that r must be equal to the radius of the Unit Disc *) -val prob_from_list: (float list -> float -> prob_udg) - -(** [linear_proba r] gives a function that, for an input d (distance) outputs d/r. - If r is the Unit Disc radius and d the distance between two points, - it outputs a probability that is higher for a low d and lower for a high d. *) -val linear_prob: (float -> prob_udg) - -(** [recommend_radius n mean_deg h w] returns the recommended radius to give to UDG - in order to get a mean degree approximately equal to mean_deg, - knowing there's n nodes and the UDG is applied in an area of height h and width w. *) -val recommend_radius : (int -> float -> float -> float -> float) - -(** [reccomend_nb_node r mean_deg h w] returns the recommended number of nodes - to give to UDG in order to get a mean degree approximately equal to mean_deg, - knowing the radius is r and the UDG is applied in an area of height h and width w. *) -val reccomend_nb_node : (float -> float -> float -> float -> int) - -(** [compute_mean_degree n r h w] computes and return the approximative mean degree of - an UDG graph with the same arguments. *) -val compute_mean_degree : (int -> float -> float -> float -> float) - -(** [make_dot_udg ~r=r g p (h,w) f] Creates a DOT file to represent the UDG area, - r being the radius, g being the graph, p being the UDG area, - and (h,w) being the dimensions of the plan. - If no radius is given, they won't appear on the pdf. - If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) -val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml new file mode 100644 index 0000000..ea76974 --- /dev/null +++ b/tools/graphgen/udgUtils.ml @@ -0,0 +1,70 @@ +open Ggcore +type probability = float (*between 0 and 1*) +type prob_udg = (float -> probability) + +type node_udg = node_id*float*float +type plan_udg = node_udg list + +let prob_from_list : (float list -> float -> prob_udg) = + fun l r d -> (List.nth l (int_of_float (((float_of_int (List.length l))/.r)*.d))) + +let linear_prob : (float -> prob_udg) = + fun r -> (fun d -> d/.r) + +let prob_from_constant : (float -> prob_udg) = + fun x _ -> x + +let recommend_radius : (int -> float -> float -> float -> float) = + fun nb_node mean_deg h w -> + if(mean_deg > float_of_int nb_node) then + failwith "Error : the number of node should be greater or equal than mean degree" + else + sqrt ((h*.w)*.mean_deg/.(Float.pi*.(float_of_int nb_node))) + +let recommend_nb_node : (float -> float -> float -> float -> int) = + fun radius mean_deg h w -> + (int_of_float ((mean_deg*.h*.w)/.((radius**2.)*.Float.pi)))+1 + +let compute_mean_degree : (int -> float -> float -> float -> float) = + fun nb_node radius h w -> + ((radius**2.)*.Float.pi*.(float_of_int nb_node))/.(h*.w) + +(******************************************************************************) + +let rec make_nodes_dot_udg : (node_udg list -> float -> string) = + (*Create a string in the dot syntax from a node list*) + fun nudg r -> + match nudg with + | [] -> "" + | head::tail -> + let (node,x,y) = head in + (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ + let draw_rad = if(r <> -1.) then + (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in + draw_rad^(make_nodes_dot_udg tail r) + +let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = + (*Create a dot file from a graph*) + fun t plan dim ?(r = -1.) file_name -> + let name = ref "graph0" in (* default name *) + let f = (if file_name = "" then stdout else + ( + name := 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 (w,l) = dim in + let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in + let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos + + + ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot; + flush f; + close_out f + (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/udgUtils.mli b/tools/graphgen/udgUtils.mli new file mode 100644 index 0000000..aad176e --- /dev/null +++ b/tools/graphgen/udgUtils.mli @@ -0,0 +1,42 @@ +open Ggcore +type probability = float (*between 0 and 1*) +type prob_udg = (float -> probability) + +type node_udg = node_id*float*float +type plan_udg = node_udg list + + +(** create a probability function for UDG that always return the same probability *) +val prob_from_constant: (float -> prob_udg) + +(** [proba_from_list fl r] create a probability function for UDG that changes the probability according to the distance. + It cuts r into (length fl), and attribute the first element of fl to the first slice (closest to the center), and so on. + For example, [proba_from_list [1.;0.5;0.3;0.1] 10 d] will return 1. if 0 <= d < 2.5, 0.5 if 2.5 <= d < 5, and so on. + Note that r must be equal to the radius of the Unit Disc *) +val prob_from_list: (float list -> float -> prob_udg) + +(** [linear_proba r] gives a function that, for an input d (distance) outputs d/r. + If r is the Unit Disc radius and d the distance between two points, + it outputs a probability that is higher for a low d and lower for a high d. *) +val linear_prob: (float -> prob_udg) + +(** [recommend_radius n mean_deg h w] returns the recommended radius to give to UDG + in order to get a mean degree approximately equal to mean_deg, + knowing there's n nodes and the UDG is applied in an area of height h and width w. *) +val recommend_radius : (int -> float -> float -> float -> float) + +(** [reccomend_nb_node r mean_deg h w] returns the recommended number of nodes + to give to UDG in order to get a mean degree approximately equal to mean_deg, + knowing the radius is r and the UDG is applied in an area of height h and width w. *) +val recommend_nb_node : (float -> float -> float -> float -> int) + +(** [compute_mean_degree n r h w] computes and return the approximative mean degree of + an UDG graph with the same arguments. *) +val compute_mean_degree : (int -> float -> float -> float -> float) + +(** [make_dot_udg g p (h,w) ~r=r f] Creates a DOT file to represent the UDG area, + r being the radius, g being the graph, p being the UDG area, + and (h,w) being the dimensions of the plan. + If no radius is given, they won't appear on the pdf. + If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) +val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) \ No newline at end of file -- GitLab From 336a1a4defa1521f4865a3b252b4d5f559f0d39d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nathan=20R=C3=A9biscoul?= Date: Fri, 5 Jul 2019 17:11:33 +0200 Subject: [PATCH 06/16] Add comment for udg_linear --- tools/graphgen/graphGen_arg.ml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 6fc6f13..1319b63 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -257,8 +257,16 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--progressive-prob";"-pp"] (Arg.Unit (fun () -> args.udg.proba <- LinearP)) - [(["...";"...";"...\n"], "UDG")]; + [(["Uses a probability function for UDG that change probabilty according to the distance from the center,"; + "using a linear function. Lower the distance is, greater the probability is."; + "This probability function will be used to know if an edge will be created when"; + "two Unit Discs touch each other.\n" + ], "UDG")]; + (** [linear_proba r] gives a function that, for an input d (distance) outputs d/r. + If r is the Unit Disc radius and d the distance between two points, + it outputs a probability that is higher for a low d and lower for a high d. *) + mkopt args ["--dot_udg";"-du"]~arg:" " (Arg.String (fun f -> match args.action with | "UDG" -> args.dotUDG <- f -- GitLab From 215e678f281defc0311ba6b55ce8ce58bb4382dd Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Fri, 5 Jul 2019 17:18:50 +0200 Subject: [PATCH 07/16] Added an error message when neato doesn't work (when using "gg UDG -du|-dur ...") that is affected by --silent (aka. -s) --- tools/graphgen/dune | 1 + tools/graphgen/graphGen.ml | 12 ++++++++++-- tools/graphgen/randomGraph.ml | 3 ++- tools/graphgen/udgUtils.ml | 8 +++++--- tools/graphgen/udgUtils.mli | 2 +- 5 files changed, 19 insertions(+), 7 deletions(-) diff --git a/tools/graphgen/dune b/tools/graphgen/dune index e15acda..8dac014 100644 --- a/tools/graphgen/dune +++ b/tools/graphgen/dune @@ -1,5 +1,6 @@ (executable (name graphGen) + (libraries sasacore) ) (install diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index b297095..ed87bce 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -52,11 +52,19 @@ let () = ( let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in if (t.dotUDG <> "") then ( make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot"); - ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG)) + let command_return = + Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG) in + if (command_return) <> 0 && (not t.silent) then + Printf.fprintf stderr "/!\\ Error n°%d while parsing %s.dot into %s.pdf /!\\" + command_return t.dotUDG t.dotUDG ); if (t.dotUDGrad <> "") then ( make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot"); - ignore (Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad )) + let command_return = + Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad) in + if (command_return) <> 0 && (not t.silent) then + Printf.fprintf stderr "/!\\ Error n°%d while parsing %s.dot into %s.pdf /!\\" + command_return t.dotUDGrad t.dotUDGrad ); graph ) diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 8e0a45e..4036a9e 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -76,7 +76,8 @@ let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int opti let gen_BA : (int -> int -> topology) = fun nb m -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in - if nb < m + 1 then failwith (Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1)); + if nb < m + 1 then + failwith (Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1)); { nodes = nodes; succ = neighbours_BA nodes m node_succ; diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml index ea76974..3c37ba5 100644 --- a/tools/graphgen/udgUtils.ml +++ b/tools/graphgen/udgUtils.ml @@ -40,7 +40,8 @@ let rec make_nodes_dot_udg : (node_udg list -> float -> string) = let (node,x,y) = head in (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ let draw_rad = if(r <> -1.) then - (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" node x y (2.*.r) (2.*.r) ) else "" in + (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" + node x y (2.*.r) (2.*.r) ) else "" in draw_rad^(make_nodes_dot_udg tail r) let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = @@ -59,7 +60,9 @@ let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string ) ) in let (w,l) = dim in - let mpos = if(r <> -1.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in + let mpos = if(r <> -1.) then + (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) + else "" in let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos @@ -67,4 +70,3 @@ let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string Printf.fprintf f "%s" dot; flush f; close_out f - (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/tools/graphgen/udgUtils.mli b/tools/graphgen/udgUtils.mli index aad176e..262ff49 100644 --- a/tools/graphgen/udgUtils.mli +++ b/tools/graphgen/udgUtils.mli @@ -39,4 +39,4 @@ val compute_mean_degree : (int -> float -> float -> float -> float) and (h,w) being the dimensions of the plan. If no radius is given, they won't appear on the pdf. If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) -val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) \ No newline at end of file +val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) -- GitLab From 071505b586ba7cb30c622554d6eee969c2a29231 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Mon, 8 Jul 2019 11:23:59 +0200 Subject: [PATCH 08/16] Changed gg's topology to Topology.t --- tools/graphgen/classicGraph.ml | 41 +++++++++++++++++++++------------ tools/graphgen/classicGraph.mli | 12 +++++----- tools/graphgen/ggcore.ml | 35 ++++++++++++++++------------ tools/graphgen/ggcore.mli | 21 +++++++++-------- tools/graphgen/graphGen_arg.ml | 8 +++---- tools/graphgen/randomGraph.ml | 32 +++++++++++++++++-------- tools/graphgen/randomGraph.mli | 11 +++++---- tools/graphgen/udgUtils.ml | 4 +++- tools/graphgen/udgUtils.mli | 5 ++-- 9 files changed, 101 insertions(+), 68 deletions(-) diff --git a/tools/graphgen/classicGraph.ml b/tools/graphgen/classicGraph.ml index 6001554..677f197 100644 --- a/tools/graphgen/classicGraph.ml +++ b/tools/graphgen/classicGraph.ml @@ -1,31 +1,36 @@ +open Sasacore +open Topology open Ggcore open List type node_succ_t = (string, (int option * string) list) Hashtbl.t -(*type node_by_i_t = (int, string) Hashtbl.t*) let nid_list_remove : (node_id list -> node_id -> (int option*node_id) list) = fun l e -> rev (fold_left (fun acc elem -> if(elem <> e) then (None,elem)::acc else acc ) [] l) -let (gen_clique: int -> topology) = +let (gen_clique: int -> Topology.t) = fun nb -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in List.iter (fun node_id -> Hashtbl.replace node_succ node_id (nid_list_remove nodes node_id)) nodes; + let nl = id_to_empty_nodes nodes in { - nodes = nodes ; - succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + nodes = nl; + succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []); + of_id = get_of_id nl } -let (gen_star: int -> topology) = +let (gen_star: int -> Topology.t) = fun nb -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = "root"::(create_nodes "p" (1,nb)) in let first = hd nodes in List.iter (fun node -> Hashtbl.replace node_succ node (if node = first then nid_list_remove nodes node else [(None,first)])) nodes; + let nl = id_to_empty_nodes nodes in { - nodes = nodes; - succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []) + nodes = nl; + succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []); + of_id = get_of_id nl } let add_weight (li : node_id list) : (int option * node_id) list = map (fun elem -> (None,elem)) li @@ -49,16 +54,18 @@ let neighbours_ring : (node_id list -> (node_id -> (int option * node_id) list)) iter2 (fun neighbours elem -> Hashtbl.replace node_succ elem (add_weight neighbours)) ret li ; (fun n -> try Hashtbl.find node_succ n with Not_found -> []) - let (gen_ring: int -> topology) = + let (gen_ring: int -> Topology.t) = fun nb -> let nodes = (create_nodes "p" (0,nb)) in + let nl = id_to_empty_nodes nodes in { - nodes = nodes ; - succ = neighbours_ring nodes + nodes = nl; + succ = neighbours_ring nodes; + of_id = get_of_id nl } -let (gen_grid: int -> int -> topology) = +let (gen_grid: int -> int -> Topology.t) = fun length width -> let nb = length*width in let nodes = (create_nodes "p" (0,nb)) and table = Hashtbl.create nb in @@ -77,9 +84,11 @@ let (gen_grid: int -> int -> topology) = done; done; done; + let nl = id_to_empty_nodes nodes in { - nodes= nodes ; - succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> [])) + nodes = nl; + succ = (fun nid -> (try Hashtbl.find table nid with Not_found -> [])); + of_id = get_of_id nl } let rec link_hypercube_nodes : (node_id array -> node_succ_t -> unit) = @@ -103,11 +112,13 @@ let neighbours_hyper_cube : (node_id list -> (node_id -> (int option * node_id) link_hypercube_nodes na node_succ; (fun n -> try Hashtbl.find node_succ n with Not_found -> []) -let gen_hyper_cube : (int -> topology) = +let gen_hyper_cube : (int -> Topology.t) = fun dim -> let nb = int_of_float (2. ** (float_of_int dim)) in let nodes = (create_nodes "p" (0,nb)) in + let nl = id_to_empty_nodes nodes in { - nodes = nodes ; + nodes = nl; succ = neighbours_hyper_cube nodes; + of_id = get_of_id nl } diff --git a/tools/graphgen/classicGraph.mli b/tools/graphgen/classicGraph.mli index 2d39d7e..bed633a 100644 --- a/tools/graphgen/classicGraph.mli +++ b/tools/graphgen/classicGraph.mli @@ -1,17 +1,17 @@ -open Ggcore +open Sasacore (** Generate a clique graph of n nodes *) -val gen_clique : (int -> topology) +val gen_clique : (int -> Topology.t) (** Generate a star graph of n nodes *) -val gen_star : (int -> topology) +val gen_star : (int -> Topology.t) (** Generate a ring graph of n nodes *) -val gen_ring :(int -> topology) +val gen_ring :(int -> Topology.t) (** take the two dimension i,j of the grid and return a grid graph whith these dimension *) -val gen_grid : (int -> int -> topology) +val gen_grid : (int -> int -> Topology.t) (** take a dimension and generate hyper cube graph of this dimension *) -val gen_hyper_cube : (int -> topology) +val gen_hyper_cube : (int -> Topology.t) diff --git a/tools/graphgen/ggcore.ml b/tools/graphgen/ggcore.ml index e3fb561..8f9d319 100644 --- a/tools/graphgen/ggcore.ml +++ b/tools/graphgen/ggcore.ml @@ -1,10 +1,6 @@ +open Sasacore.Topology -type node_id = string - -type topology = { - nodes : node_id list; - succ: node_id -> (int option * node_id) list -} +type node_ofId_t = (string, node) Hashtbl.t let rec create_nodes : (string -> int*int -> node_id list) = (* Create names from a generic name *) @@ -13,21 +9,30 @@ let rec create_nodes : (string -> int*int -> node_id list) = let tmp : node_id = name ^ (string_of_int (start)) in tmp::(create_nodes name (start+1, finish)) +let id_to_empty_nodes : (node_id list -> node list) = + List.map (fun n_id -> {id = n_id; file = ""; init = ""}) + +let get_of_id : (node list->(node_id-> node)) = + fun nl -> + let (of_id_hash:node_ofId_t) = Hashtbl.create (List.length nl) in + List.iter (fun node -> Hashtbl.replace of_id_hash node.id node) nl; + (fun n -> try Hashtbl.find of_id_hash n with Not_found -> + failwith (n^ " unknown node id")) -let make_links_dot : (topology -> string) = +let make_links_dot : (t -> string) = fun t -> let links = List.flatten ( List.map (fun n -> - let l = t.succ n in + let l = t.succ n.id in List.map (fun (w,neighbour) -> ( match w with - | None -> if n < neighbour then - Printf.sprintf ("%s -- %s") n neighbour + | None -> if n.id < neighbour then + Printf.sprintf ("%s -- %s") n.id neighbour else - Printf.sprintf ("%s -- %s") neighbour n + Printf.sprintf ("%s -- %s") neighbour n.id | Some x -> - Printf.sprintf ("%s -- %s [weight=%d]") n neighbour x + Printf.sprintf ("%s -- %s [weight=%d]") n.id neighbour x ) ) l @@ -35,13 +40,13 @@ let make_links_dot : (topology -> string) = ) in String.concat "\n" (List.sort_uniq compare links) -let rec make_nodes_dot : (node_id list -> string) = +let rec make_nodes_dot : (node list -> string) = (*Create a string in the dot syntax from a node list*) function | [] -> "" - | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node)^(make_nodes_dot tail) + | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node.id)^(make_nodes_dot tail) -let make_dot : (topology -> string -> unit) = +let make_dot : (t -> string -> unit) = (*Create a dot file from a graph*) fun t file_name -> let name = ref "graph0" in diff --git a/tools/graphgen/ggcore.mli b/tools/graphgen/ggcore.mli index a6cdc4b..732baed 100644 --- a/tools/graphgen/ggcore.mli +++ b/tools/graphgen/ggcore.mli @@ -1,15 +1,16 @@ - -type node_id = string - -type topology = { - nodes : node_id list; - succ: node_id -> (int option * node_id) list -} +open Sasacore.Topology (** Create a name (i.d. node ID) list from a generic name *) val create_nodes : (string -> int*int -> node_id list) -val make_links_dot : (topology -> string) +(** creates a list of nodes, each having an ID from the list given in argument, and no file or init value. *) +val id_to_empty_nodes : (node_id list -> node list) + +(** create a function to get a node from it's ID *) +val get_of_id : (node list -> (node_id-> node)) + +(** create a string containing the links in a DOT syntax *) +val make_links_dot : (t -> string) -(** Create a dot file from a graph *) -val make_dot : (topology -> string -> unit) +(** Create a DOT file from a graph *) +val make_dot : (t -> string -> unit) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 1319b63..d8a52be 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -257,27 +257,27 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--progressive-prob";"-pp"] (Arg.Unit (fun () -> args.udg.proba <- LinearP)) - [(["Uses a probability function for UDG that change probabilty according to the distance from the center,"; + [(["Uses a probability function for UDG that change probability according to the distance from the center,"; "using a linear function. Lower the distance is, greater the probability is."; "This probability function will be used to know if an edge will be created when"; "two Unit Discs touch each other.\n" ], "UDG")]; - (** [linear_proba r] gives a function that, for an input d (distance) outputs d/r. + (* [linear_proba r] gives a function that, for an input d (distance) outputs d/r. If r is the Unit Disc radius and d the distance between two points, it outputs a probability that is higher for a low d and lower for a high d. *) mkopt args ["--dot_udg";"-du"]~arg:" " (Arg.String (fun f -> match args.action with | "UDG" -> args.dotUDG <- f - | _ -> unexpected "-mdudg")) + | _ -> unexpected "-du")) [(["Create a DOT file to visualize the UDG plan."; "The extension .dot will be added to the file base-name.\n"],"UDG")]; mkopt args ["--dot_udg_radius";"-dur"]~arg:" " (Arg.String (fun f -> match args.action with | "UDG" -> args.dotUDGrad <- f - | _ -> unexpected "-mdudg")) + | _ -> unexpected "-dur")) [(["Create a DOT file to visualize the UDG plan."; "The extension .dot will be added to the file base-name.\n"],"UDG")]; diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 4036a9e..51927e9 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -1,10 +1,12 @@ +open Sasacore +open Topology open Ggcore open List type node_succ_t = (node_id, (int option * node_id) list) Hashtbl.t type probability = float (*between 0 and 1*) -let gen_ER : (int -> probability -> topology) = +let gen_ER : (int -> probability -> Topology.t) = fun nb p -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in iteri (fun i n -> @@ -16,9 +18,11 @@ let gen_ER : (int -> probability -> topology) = ((None,n)::(try Hashtbl.find node_succ m with Not_found -> []))) ) nodes ) nodes; + let nl = id_to_empty_nodes nodes in { - nodes = nodes ; + nodes = nl; succ = (fun n -> try Hashtbl.find node_succ n with Not_found -> []); + of_id = get_of_id nl } @@ -73,14 +77,18 @@ let neighbours_BA : (node_id list -> int -> node_succ_t -> (node_id -> (int opti -let gen_BA : (int -> int -> topology) = +let gen_BA : (int -> int -> Topology.t) = fun nb m -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in if nb < m + 1 then - failwith (Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1)); + failwith ( + Printf.sprintf "BA Error : with m = %d, nb needs to be at least %d. %d is lower than %d" m (m+1) nb (m+1)); + + let nl = id_to_empty_nodes nodes in { - nodes = nodes; + nodes = nl; succ = neighbours_BA nodes m node_succ; + of_id = get_of_id nl } let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * node_id) list)) = @@ -97,12 +105,14 @@ let pre_rand_tree : (node_succ_t -> node_id list -> (node_id -> (int option * no ) [h] (t)); (fun n -> try Hashtbl.find node_succ n with Not_found -> []) -let (rand_tree: int -> topology) = +let (rand_tree: int -> Topology.t) = fun nb -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in + let nl = id_to_empty_nodes nodes in { - nodes = nodes; - succ = (pre_rand_tree node_succ nodes) + nodes = nl; + succ = (pre_rand_tree node_succ nodes); + of_id = get_of_id nl } @@ -123,7 +133,7 @@ let (rand_udg: prob_udg -> float -> bool) = fun f d -> (f d>= Random.float 1.) -let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg)) = +let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (Topology.t * plan_udg)) = fun ?(p=(fun _ -> 1.)) nb x y r -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in let pl = (make_plan_udg nodes x y) in @@ -142,7 +152,9 @@ let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (topology * plan_ ) ) pl ) nodes; + let nl = id_to_empty_nodes nodes in { - nodes = nodes ; + nodes = nl; succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> [])); + of_id = get_of_id nl },pl diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 140c7ac..99dc188 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -1,4 +1,5 @@ -open Ggcore +open Sasacore +open Topology type probability = float (*between 0 and 1*) type node_udg = node_id*float*float @@ -10,17 +11,17 @@ type prob_udg = (float -> probability) (** [gen_ER n p] generate a graph using Erdos Renyi model, of n nodes and of probability p for each possible edge to appear. *) -val gen_ER : (int -> probability -> topology) +val gen_ER : (int -> probability -> Topology.t) (** [gen_BA n m] generate a graph using Barabasi–Albert model, of n nodes and with m edges added for each new node. m has to be lower than n. The initialization is a star of m+1 nodes, with the (m+1)th node being the root. Barabasi–Albert model is used for the remaining nodes *) -val gen_BA : (int -> int -> topology) +val gen_BA : (int -> int -> Topology.t) (** [rand_tree n] generate a random tree of n nodes *) -val rand_tree: (int -> topology) +val rand_tree: (int -> Topology.t) (** [gen_udg ~p n w h r] generate a graph using Unit Disc Graph model of n nodes. w and h are the width and the height of the area in which the nodes are randomly disposed, @@ -28,4 +29,4 @@ val rand_tree: (int -> topology) If two Unit Discs from different nodes touch themselves, p will be run to obtain the probability of an edge appearing between these nodes. p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*) -val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (topology * plan_udg)) +val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (Topology.t * plan_udg)) diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml index 3c37ba5..1b0f024 100644 --- a/tools/graphgen/udgUtils.ml +++ b/tools/graphgen/udgUtils.ml @@ -1,3 +1,5 @@ +open Sasacore +open Topology open Ggcore type probability = float (*between 0 and 1*) type prob_udg = (float -> probability) @@ -44,7 +46,7 @@ let rec make_nodes_dot_udg : (node_udg list -> float -> string) = node x y (2.*.r) (2.*.r) ) else "" in draw_rad^(make_nodes_dot_udg tail r) -let make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = +let make_dot_udg : (Topology.t -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = (*Create a dot file from a graph*) fun t plan dim ?(r = -1.) file_name -> let name = ref "graph0" in (* default name *) diff --git a/tools/graphgen/udgUtils.mli b/tools/graphgen/udgUtils.mli index 262ff49..b34f0c8 100644 --- a/tools/graphgen/udgUtils.mli +++ b/tools/graphgen/udgUtils.mli @@ -1,4 +1,5 @@ -open Ggcore +open Sasacore +open Topology type probability = float (*between 0 and 1*) type prob_udg = (float -> probability) @@ -39,4 +40,4 @@ val compute_mean_degree : (int -> float -> float -> float -> float) and (h,w) being the dimensions of the plan. If no radius is given, they won't appear on the pdf. If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) -val make_dot_udg : (topology -> plan_udg -> (float*float) -> ?r:float -> string -> unit) +val make_dot_udg : (Topology.t -> plan_udg -> (float*float) -> ?r:float -> string -> unit) -- GitLab From 31e0c21cd5451f18614a3d94a23a5704b0c8e258 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Mon, 8 Jul 2019 14:06:32 +0200 Subject: [PATCH 09/16] Moved make_dot to topology.ml, and use it in all gg files --- lib/sasacore/topology.ml | 46 +++++++++++++++++++++++++++++++++ lib/sasacore/topology.mli | 9 +++++++ tools/graphgen/classicGraph.ml | 6 ++--- tools/graphgen/ggcore.ml | 47 ---------------------------------- tools/graphgen/ggcore.mli | 6 ----- tools/graphgen/graphGen.ml | 3 ++- tools/graphgen/udgUtils.ml | 1 - 7 files changed, 60 insertions(+), 58 deletions(-) diff --git a/lib/sasacore/topology.ml b/lib/sasacore/topology.ml index 88b04de..6f59ef1 100644 --- a/lib/sasacore/topology.ml +++ b/lib/sasacore/topology.ml @@ -119,3 +119,49 @@ let (read: string -> t) = fun f -> failwith (str^ " unknown node id") ) } + +let make_links_dot : (t -> string) = + fun t -> + let links = List.flatten ( + List.map (fun n -> + let l = t.succ n.id in + 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 + ) + + ) l + ) t.nodes + ) in + String.concat "\n" (List.sort_uniq compare links) + +let rec make_nodes_dot : (node list -> string) = + (*Create a string in the dot syntax from a node list*) + function + | [] -> "" + | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node.id)^(make_nodes_dot tail) + +let make_dot : (t -> string -> unit) = + (*Create a dot file from a graph*) + fun t file_name -> + let name = ref "graph0" in + let f = (if file_name = "" then stdout else + ( + name := 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 = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot + (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) diff --git a/lib/sasacore/topology.mli b/lib/sasacore/topology.mli index 1768b04..098bf40 100644 --- a/lib/sasacore/topology.mli +++ b/lib/sasacore/topology.mli @@ -16,3 +16,12 @@ type t = { (** Parse a sasa dot file *) val read: string -> t + +(** Create a string containing the links of the graph given in argument in a DOT syntax *) +val make_links_dot : (t -> string) + +(** Create a string containing the nodes given in argument in a DOT syntax *) +val make_nodes_dot : (node list -> string) + +(** Create a DOT file from a graph *) +val make_dot : (t -> string -> unit) diff --git a/tools/graphgen/classicGraph.ml b/tools/graphgen/classicGraph.ml index 677f197..55a336a 100644 --- a/tools/graphgen/classicGraph.ml +++ b/tools/graphgen/classicGraph.ml @@ -118,7 +118,7 @@ let gen_hyper_cube : (int -> Topology.t) = let nodes = (create_nodes "p" (0,nb)) in let nl = id_to_empty_nodes nodes in { - nodes = nl; - succ = neighbours_hyper_cube nodes; - of_id = get_of_id nl + nodes = nl; + succ = neighbours_hyper_cube nodes; + of_id = get_of_id nl } diff --git a/tools/graphgen/ggcore.ml b/tools/graphgen/ggcore.ml index 8f9d319..ddcaef5 100644 --- a/tools/graphgen/ggcore.ml +++ b/tools/graphgen/ggcore.ml @@ -18,50 +18,3 @@ let get_of_id : (node list->(node_id-> node)) = List.iter (fun node -> Hashtbl.replace of_id_hash node.id node) nl; (fun n -> try Hashtbl.find of_id_hash n with Not_found -> failwith (n^ " unknown node id")) - -let make_links_dot : (t -> string) = - fun t -> - let links = List.flatten ( - List.map (fun n -> - let l = t.succ n.id in - 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 - ) - - ) l - ) t.nodes - ) in - String.concat "\n" (List.sort_uniq compare links) - -let rec make_nodes_dot : (node list -> string) = - (*Create a string in the dot syntax from a node list*) - function - | [] -> "" - | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node.id)^(make_nodes_dot tail) - -let make_dot : (t -> string -> unit) = - (*Create a dot file from a graph*) - fun t file_name -> - let name = ref "graph0" in - let f = (if file_name = "" then stdout else - ( - name := 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 = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in - Printf.fprintf f "%s" dot - (*ignore (Sys.command (Printf.sprintf "echo \"%s\" > \"%s.dot\"" dot file_name)); ()*) - \ No newline at end of file diff --git a/tools/graphgen/ggcore.mli b/tools/graphgen/ggcore.mli index 732baed..f87e173 100644 --- a/tools/graphgen/ggcore.mli +++ b/tools/graphgen/ggcore.mli @@ -8,9 +8,3 @@ val id_to_empty_nodes : (node_id list -> node list) (** create a function to get a node from it's ID *) val get_of_id : (node list -> (node_id-> node)) - -(** create a string containing the links in a DOT syntax *) -val make_links_dot : (t -> string) - -(** Create a DOT file from a graph *) -val make_dot : (t -> string -> unit) diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index ed87bce..b223b78 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -1,4 +1,5 @@ -open Ggcore +open Sasacore.Topology + open ClassicGraph open RandomGraph open GraphGen_arg diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml index 1b0f024..9e25030 100644 --- a/tools/graphgen/udgUtils.ml +++ b/tools/graphgen/udgUtils.ml @@ -1,6 +1,5 @@ open Sasacore open Topology -open Ggcore type probability = float (*between 0 and 1*) type prob_udg = (float -> probability) -- GitLab From 505130ed4f97ed1bac0022567a8dd2c6c4eb5033 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Mon, 8 Jul 2019 14:37:26 +0200 Subject: [PATCH 10/16] Added a graph decorator (ggDeco) --- tools/ggDeco/dune | 9 +++ tools/ggDeco/ggDeco.ml | 157 ++++++++++++++++++++++++++++++++++++ tools/ggDeco/ggDeco.mli | 7 ++ tools/ggDeco/ggDeco_Arg.ml | 156 +++++++++++++++++++++++++++++++++++ tools/ggDeco/ggDeco_Arg.mli | 15 ++++ 5 files changed, 344 insertions(+) create mode 100644 tools/ggDeco/dune create mode 100644 tools/ggDeco/ggDeco.ml create mode 100644 tools/ggDeco/ggDeco.mli create mode 100644 tools/ggDeco/ggDeco_Arg.ml create mode 100644 tools/ggDeco/ggDeco_Arg.mli diff --git a/tools/ggDeco/dune b/tools/ggDeco/dune new file mode 100644 index 0000000..2876c16 --- /dev/null +++ b/tools/ggDeco/dune @@ -0,0 +1,9 @@ +(executable + (name ggDeco) + (libraries sasacore) +) + +(install + (section bin) +(files (ggDeco.exe as ggDeco)) +) diff --git a/tools/ggDeco/ggDeco.ml b/tools/ggDeco/ggDeco.ml new file mode 100644 index 0000000..24933cf --- /dev/null +++ b/tools/ggDeco/ggDeco.ml @@ -0,0 +1,157 @@ +open Sasacore +open Topology + +open GgDeco_Arg + +exception Crossover (* Two different intervals crossover each-other *) +exception No_file_for of int + +type file = string +type file_spec = (int * int * file) + +(*let pop : (int -> file_spec list -> file_spec * file_spec list) = + fun i fl -> + let (f_s, fl) = List.fold_left (fun (f, li) elem -> + let (a,_,_) = elem in + if a = i then ( + match f with + | Some _ -> raise Pop_two_elements + | None -> (Some elem),li + ) else (f, elem::li) + ) (None, []) fl in + match f_s with + | Some f -> (f,List.rev fl) + | None -> raise Pop_no_element*) + +let compare_file_spec : (file_spec -> file_spec -> int) = + fun (a1,b1,_s1) (a2,b2,_s2) -> + if (b2 < a1 && b2 <> -1) then 1 else + if (b1 < a2 && b1 <> -1) then -1 + (*else if s1 = s2 then compare a1 a2 *) + else raise Crossover + +(* + * Parse strings into a file_spec list. + * Each file_spec element should be represented in the format "a-b:file", + * with "a" being the start, "b" being the end, and "file" being the file. + * To create multiple file_spec elements from one string, separate each element by a whitespace. + * If the syntax is not respected, an exception will be raised. + * Possible exceptions : End_of_file, Stdlib.Scanf.Scan_failure, int_of_string + * Caution : cases where "a" > "b" or "a" < 0 do not raise any exception. + *) +let parse_file_spec : (string -> file_spec list) = + fun s -> + let sl = String.split_on_char ' ' s in + List.map (fun file -> + Scanf.sscanf file "%[-0-9] : %s" (fun range file -> + Scanf.sscanf range "%d%s" (fun a s -> + let l = String.length s in + if (l <= 0) then (a,a,file) else ( + if (String.get s 0 <> '-') then (assert false); + if (l = 1) then (a,-1,file) else + let b = int_of_string (String.sub s 1 (l-1)) in + (a,b,file) + ) + ) + ) + ) sl + + +(*let deco : (Topology.t -> file_spec list -> Topology.t) = + fun g fl -> + let nodes = ref g.nodes and newNodes = ref [] and indice = ref 0 in + let fl = List.sort compare_file_spec fl in + List.iter (fun (a,b,s) -> + if a <> !indice then raise (No_file_for (!indice)); + let b = if b = -1 then (List.length g.nodes) -1 else b in + for _ = a to b do (* to iterate through the (a-b) first elements of !nodes, and then remove from !nodes these elements *) + let n = List.hd !nodes in + newNodes := (({id=n.id;file=s;init=n.init})::!newNodes); + nodes := List.tl !nodes; + indice := !indice +1 + done; + ) fl; + { + nodes = List.rev !newNodes; + succ = g.succ; + of_id = g.of_id; + }*) + + +let pop : (file_spec list ref -> int -> string) = + fun fl i -> + match !fl with + | [] -> raise (No_file_for i) + | (a,b,s)::tl -> if i < a || (i > b && b <> -1) then raise (No_file_for i) else + if i = b then fl := tl; + s + + +let deco : (Topology.t -> file_spec list -> Topology.t) = + fun g fl -> + let newNodes = ref [] and fl = ref (List.sort compare_file_spec fl) in + List.iteri (fun i n -> + let s = (pop fl i) in + newNodes := ( + ({ + id=n.id; + file=(if s = "." then n.file else s); + init=n.init + })::!newNodes + ); + ) g.nodes; + { + nodes = List.rev !newNodes; + succ = g.succ; + of_id = g.of_id; + } + +(************** Code duppliqué pour tester, qui sera à enlever ************** +let rec make_nodes_dot : (node list -> string) = + (*Create a string in the dot syntax from a node list*) + function + | [] -> "" + | node::tail -> (Printf.sprintf "%s [algo=\"%s\"]\n" node.id node.file)^(make_nodes_dot tail) + +let make_links_dot : (Topology.t -> string) = + fun t -> + let links = List.flatten ( + List.map (fun n -> + let l = t.succ n.id in + 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 + ) + ) l + ) t.nodes + ) in + String.concat "\n" (List.sort_uniq compare links) + +let make_dot : (Topology.t -> string -> unit) = + (*Create a dot file from a graph*) + fun t file_name -> + let name = ref "graph0" in + let f = (if file_name = "" then stdout else + ( + name := Filename.remove_extension file_name; + (*if Filename.extension file_name <> ".dot" then + (open_out (file_name ^".dot")) + else*) open_out file_name + ) + ) in + let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + Printf.fprintf f "%s" dot +****************** fin code duppliqué ********************) + +let () = ( + let args = parse Sys.argv in + let g = read args.dot_file in + let new_g = deco g (parse_file_spec args.algo_files) in + make_dot new_g args.output +) diff --git a/tools/ggDeco/ggDeco.mli b/tools/ggDeco/ggDeco.mli new file mode 100644 index 0000000..441b160 --- /dev/null +++ b/tools/ggDeco/ggDeco.mli @@ -0,0 +1,7 @@ + +type file = string +type file_spec = (int * int * file) + + +val deco : (Sasacore.Topology.t -> file_spec list -> Sasacore.Topology.t) + diff --git a/tools/ggDeco/ggDeco_Arg.ml b/tools/ggDeco/ggDeco_Arg.ml new file mode 100644 index 0000000..1f62e69 --- /dev/null +++ b/tools/ggDeco/ggDeco_Arg.ml @@ -0,0 +1,156 @@ +let () = Random.self_init (); + +type t = { + mutable dot_file: string; + mutable output: string; + + mutable algo_files : string; + + mutable _args : (string * Arg.spec * string) list; + mutable _general_man : (string * string list) list; + + mutable _others : string list; + mutable _margin : int; +} + +let usage_msg tool = + ("usage: " ^ tool ^ " \"\" [-o ]\n" ) + +let print_usage tool = Printf.printf "\n%s use -h for additional information.\n\n" (usage_msg tool); flush stdout; exit 1 + + +let (make_args : unit -> t) = + fun () -> + { + dot_file = ""; + output = ""; + + algo_files = ""; + + _args = []; + _general_man = []; + + _others = []; + _margin = 12; + } + +let myexit i = exit i + +let first_line b = ( + try ( + let f = String.index b '\n' in + String.sub b 0 f + ) with Not_found -> b +) +let exist_file f = ( + if not (Sys.file_exists f) then ( + prerr_string ("File not found: \""^f^"\""); + prerr_newline (); + myexit 1 + ) +) +let unexpected s = ( + prerr_string ("unexpected argument \""^s^"\""); + prerr_newline (); + myexit 1 +) + + +let printSpec args outChannel (c, messageList) = ( + let (m1, oth) = match messageList with + | h::t -> (h,t) + | _ -> ("",[]) + in + let t2 = String.make args._margin ' ' in + let cl = String.length c in + let t1 = if (cl < args._margin ) then + String.make (args._margin - cl) ' ' + else + "\n"^t2 + in + Printf.fprintf outChannel "%s%s%s" c t1 m1; + List.iter (function x -> Printf.fprintf outChannel "\n%s%s" t2 x) oth ; + Printf.fprintf outChannel "\n" ; +) + +let help args tool = ( + Printf.printf "\n"; + Printf.printf "%s" (usage_msg tool); + Printf.printf "\n"; + Printf.printf "Add or replace the 'algo' label in the dot file, to change the algorithms attached to each node.\n"; + Printf.printf " is the dot file on which you wish to change the algo.\n"; + Printf.printf " describe which nodes will have which algo attached to them. The syntax is the following :\n"; + Printf.printf "\n"; + Printf.printf " - To assign a file (containing an algo) to one node, write 'i:file', 'i' being the index of the node\n"; + Printf.printf " and 'file' being the file of the algo. \n"; + Printf.printf "\n"; + Printf.printf " - To assign a file to multiple nodes, write 'i-j:file', with 'i' being the index of the first node,\n"; + Printf.printf " 'j' being the last node's index (included) and 'file' being the file of the algo. \n"; + Printf.printf " Note : write 'i-:file' to assign the file to all nodes from i.\n"; + Printf.printf "\n"; + Printf.printf " - Concatenate all the the descriptions, with a whitespace between each.\n"; + Printf.printf " Example : \"1:root.ml 2-:p.ml\" assign root.ml to the first node, and p.ml to the other ones.\n"; + Printf.printf " Since it is one argument, do not forget the double quotes."; + (* maybe I should change it such that it accepts with or without the double quotes *) + Printf.printf "\n"; + Printf.printf "\n"; + Printf.printf "============ Available Options ============\n\n"; + ( + List.iter (printSpec args stdout) (List.rev args._general_man) + ); + Printf.printf "\n"; + exit 0 +) + + +let mkopt : t -> string list -> ?arg:string -> Arg.spec -> (string list -> unit) = + fun opt ol ?(arg="") se ml -> + let add_option o = opt._args <- (o, se, "")::opt._args in + List.iter add_option ol ; + let col1 = (String.concat ", " ol)^arg in + opt._general_man <- (col1, ml)::opt._general_man + +(*** User Options Tab **) +let (mkoptab : string array -> t -> unit) = + fun argv args -> ( + + mkopt args ["--output";"-o"] ~arg:" " + (Arg.String (fun s -> args.output <- s)) + ["Set the output file to the given file.\n"]; + + + mkopt args ["--help";"-h"] + (Arg.Unit (fun () -> help args argv.(0) )) + ["Prints this help\n"]; + ) + +(* all unrecognized options are accumulated *) +let (add_other : t -> string -> unit) = + fun opt s -> + opt._others <- s::opt._others + +let current = ref 0;; + +let parse argv = ( + let save_current = !current in + let args = make_args () in + mkoptab argv args; + try ( + Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg argv.(0)); + current := save_current; + (match (List.rev args._others) with + | [a;b] -> (args.algo_files <- a; exist_file b; args.dot_file <- b) + | _::_::tl -> unexpected (List.hd tl) + | _ -> print_usage (argv.(0)) + ); + args + ) + with + | Arg.Bad msg -> ( + Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0)) + (first_line msg) (usage_msg argv.(0)); exit 2 + ) + | Arg.Help _ -> ( + help args argv.(0) + ) +) diff --git a/tools/ggDeco/ggDeco_Arg.mli b/tools/ggDeco/ggDeco_Arg.mli new file mode 100644 index 0000000..81cce60 --- /dev/null +++ b/tools/ggDeco/ggDeco_Arg.mli @@ -0,0 +1,15 @@ + +type t = { + mutable dot_file: string; + mutable output: string; + + mutable algo_files : string; + + mutable _args : (string * Arg.spec * string) list; + mutable _general_man : (string * string list) list; + + mutable _others : string list; + mutable _margin : int; +} + +val parse : string array -> t -- GitLab From 792bf1a252ac5b53069505d49fd0a1e5a4f602ed Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Tue, 9 Jul 2019 10:00:14 +0200 Subject: [PATCH 11/16] Added tools/test/skeleton to test gg and gg-deco. Made also small modifications to make_dot (in topology.ml) --- lib/sasacore/topology.ml | 8 ++--- tools/ggDeco/dune | 2 +- tools/graphgen/graphGen_arg.ml | 14 ++++---- tools/test/skeleton/main-script.py | 55 ++++++++++++++++++++++++++++++ tools/test/skeleton/p.ml | 49 ++++++++++++++++++++++++++ 5 files changed, 115 insertions(+), 13 deletions(-) create mode 100755 tools/test/skeleton/main-script.py create mode 100644 tools/test/skeleton/p.ml diff --git a/lib/sasacore/topology.ml b/lib/sasacore/topology.ml index 6f59ef1..a55138d 100644 --- a/lib/sasacore/topology.ml +++ b/lib/sasacore/topology.ml @@ -129,11 +129,11 @@ let make_links_dot : (t -> string) = ( match w with | None -> if n.id < neighbour then - Printf.sprintf ("%s -- %s") n.id neighbour + Printf.sprintf (" %s -- %s") n.id neighbour else - Printf.sprintf ("%s -- %s") neighbour n.id + Printf.sprintf (" %s -- %s") neighbour n.id | Some x -> - Printf.sprintf ("%s -- %s [weight=%d]") n.id neighbour x + Printf.sprintf (" %s -- %s [weight=%d]") n.id neighbour x ) ) l @@ -145,7 +145,7 @@ let rec make_nodes_dot : (node list -> string) = (*Create a string in the dot syntax from a node list*) function | [] -> "" - | (node)::tail -> (Printf.sprintf "%s [algo=\"\"]\n" node.id)^(make_nodes_dot tail) + | (node)::tail -> (Printf.sprintf " %s [algo=\"%s\"]\n" node.id node.file)^(make_nodes_dot tail) let make_dot : (t -> string -> unit) = (*Create a dot file from a graph*) diff --git a/tools/ggDeco/dune b/tools/ggDeco/dune index 2876c16..3a17c92 100644 --- a/tools/ggDeco/dune +++ b/tools/ggDeco/dune @@ -5,5 +5,5 @@ (install (section bin) -(files (ggDeco.exe as ggDeco)) +(files (ggDeco.exe as gg-deco)) ) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index d8a52be..1698cbb 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -88,8 +88,6 @@ let (make_args : unit -> t) = _margin = 12; } -let myexit i = exit i - let first_line b = ( try ( let f = String.index b '\n' in @@ -99,7 +97,7 @@ let first_line b = ( let unexpected s = ( prerr_string ("unexpected argument \""^s^"\""); prerr_newline (); - myexit 1 + exit 2 (* unexpected argument *) ) @@ -160,7 +158,7 @@ let help args tool = ( List.iter (printSpec args stdout args.action) (List.rev args._general_man) ); Printf.printf "\n"; - exit 0 + exit 0 ) @@ -280,7 +278,7 @@ let (mkoptab : string array -> t -> unit) = | _ -> unexpected "-dur")) [(["Create a DOT file to visualize the UDG plan."; "The extension .dot will be added to the file base-name.\n"],"UDG")]; - + mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) [(["Remove all outputs, except ones made by other options.\n"],"all")]; @@ -303,14 +301,14 @@ let parse argv = ( let args = make_args () in mkoptab argv args; try ( - (if (Array.length argv) = 1 then help args (argv.(0))); + (if (Array.length argv) = 1 then (print_usage stdout true argv.(0); exit 1 (* no command or invalid command *))); let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in ( if (List.mem argv.(1) possible_actions) then args.action <- argv.(1) else if (List.mem argv.(1) ["-h";"--help";"-help"]) then help args (argv.(0)) else (Printf.fprintf stderr "*** Error when calling '%s %s': No such command\n\n" (argv.(0)) (argv.(1)); - (print_usage stderr true argv.(0)); exit 2) + (print_usage stderr true argv.(0)); exit 1 (* no command or invalid command *)) ); Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); @@ -335,7 +333,7 @@ let parse argv = ( with | Arg.Bad msg -> Printf.fprintf stderr "*** Error when calling '%s': %s\n" (argv.(0)) (first_line msg); - (print_usage stderr true argv.(0)); exit 2; + (print_usage stderr true argv.(0)); exit 3 (* bad argument *); | Arg.Help _msg -> help args argv.(0) ) diff --git a/tools/test/skeleton/main-script.py b/tools/test/skeleton/main-script.py new file mode 100755 index 0000000..d05df9f --- /dev/null +++ b/tools/test/skeleton/main-script.py @@ -0,0 +1,55 @@ +#!/usr/bin/env python3 +import subprocess, os + +def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent :bool = False): + args = ["gg", graphType, "-o", outputFile] + + for key in graphProperties: + if (key[0] != "-"): + args.append("-"+key) + else : + args.append(key) + + if (graphProperties[key] != ""): + args.append(graphProperties[key]) + + if is_silent: + args.append("-s") + + ret = subprocess.call(args) + + try : + os.remove(outputFile[0:-3]+"lut") + except FileNotFoundError as e: # [Errno 2] No such file or directory: '' + pass + #if (ret == 0) : + # subprocess.call(["sasa", "-gld", outputFile]) # returns an error I can't debug + return ret + +def decoGraph(inputFile: str, decoration: dict, outputFile:str = ""): + if (outputFile == "") : + outputFile = inputFile + spec = "" + for key in decoration: + spec = spec + str(key) + ":" + decoration[key] + " " + spec = spec[0:-1] + return subprocess.call(["gg-deco", spec, inputFile, "-o", outputFile]) + +def compileOcaml(file) : + subprocess.call(["ocamlfind", "ocamlopt", "-shared", "-package", "algo", file, "-o", file[0:-3]+".cmxs"]) + +def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = False): + commandLine = ["sasa", "-l", str(length), topologyFile] + if seed != None: + commandLine.append("-seed") + commandLine.append(str(seed)) + if rif: commandLine.append("-rif") + commandLine.append("-"+daemon) + subprocess.call(commandLine) + + +genGraph("BA", "result.dot", {"n":"10", "m":"2"}, False) + +decoGraph("result.dot", {0:"p.ml","1-":"p.ml"}) +compileOcaml("p.ml") +callSasa("result.dot") \ No newline at end of file diff --git a/tools/test/skeleton/p.ml b/tools/test/skeleton/p.ml new file mode 100644 index 0000000..6b08c60 --- /dev/null +++ b/tools/test/skeleton/p.ml @@ -0,0 +1,49 @@ +(* Time-stamp: *) + +(* a dumb algo *) + +open Algo + +type memory = int + +let (init_state: int -> memory) = + fun _i -> Random.int 10 + +let (state_to_string: memory -> string) = + fun m -> + string_of_int m + + +let (copy_state : memory -> memory) = + fun m -> m + +let (enable_f:'v neighbor list -> 'v -> action list) = + fun nl e -> + match (List.hd nl).state with + | 0 -> if e <> 1 then ["action2"] else [] + | 1 -> [] + | _ -> if e <> 0 then ["action1"] else [] + +let (step_f : 'v neighbor list -> 'v -> action -> 'v) = + fun nl e -> + function + | "action1" -> 0 + | "action2" -> 1 + | _ -> e + + +let () = + Algo.register { + algo = [ + { + algo_id = "p"; + init_state = init_state; + actions = Some ["action1"; "action2"]; + enab = enable_f; + step = step_f; + } + ]; + state_to_string = state_to_string; + state_of_string = Some int_of_string; + copy_state = copy_state; + } -- GitLab From 5f4d4561b97f5b778fe827af32e70a33cf32d056 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Tue, 9 Jul 2019 11:07:53 +0200 Subject: [PATCH 12/16] Added a RIF parser --- tools/test/skeleton/main-script.py | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/tools/test/skeleton/main-script.py b/tools/test/skeleton/main-script.py index d05df9f..1f37207 100755 --- a/tools/test/skeleton/main-script.py +++ b/tools/test/skeleton/main-script.py @@ -45,11 +45,35 @@ def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = False commandLine.append(str(seed)) if rif: commandLine.append("-rif") commandLine.append("-"+daemon) - subprocess.call(commandLine) + return subprocess.check_output(commandLine).decode("utf-8") + +def parseRif(rif:str): + rif = rif.split("#outputs", 1)[1].replace("\n", "").split("#") + header = [] + types = [] + possibleTypes = {"int":int,"float":float,"string":str,"bool":bool} + for s in rif[0].replace("\n","").split(" "): + if s != "": + s = s.split(":") + header.append(s[0][1:-1]) + types.append(possibleTypes[s[1]]) + + steps = rif[1:len(rif)] + matrix = [] + for i in range(len(steps)): + s = steps[i] + if s[0:4] != "step": + if s[0:4] == "outs": + matrixLine = s[5:len(s)].split(" ") + for j in range(len(matrixLine)): + matrixLine[j] = types[j](matrixLine[j]) + matrix.append(matrixLine) + return (header,types,matrix) genGraph("BA", "result.dot", {"n":"10", "m":"2"}, False) decoGraph("result.dot", {0:"p.ml","1-":"p.ml"}) compileOcaml("p.ml") -callSasa("result.dot") \ No newline at end of file +rif = callSasa("result.dot", rif = True) +ret = parseRif(rif) -- GitLab From 2e578551fca6a0021d81abc32cd3d03775672b48 Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Tue, 9 Jul 2019 11:38:31 +0200 Subject: [PATCH 13/16] Enhanced the python functions --- tools/test/skeleton/main-script.py | 33 +++++++++++++++++++----------- 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/tools/test/skeleton/main-script.py b/tools/test/skeleton/main-script.py index 1f37207..0a4c76e 100755 --- a/tools/test/skeleton/main-script.py +++ b/tools/test/skeleton/main-script.py @@ -1,7 +1,7 @@ #!/usr/bin/env python3 import subprocess, os -def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent :bool = False): +def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent: bool = False): args = ["gg", graphType, "-o", outputFile] for key in graphProperties: @@ -22,29 +22,40 @@ def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent : os.remove(outputFile[0:-3]+"lut") except FileNotFoundError as e: # [Errno 2] No such file or directory: '' pass - #if (ret == 0) : - # subprocess.call(["sasa", "-gld", outputFile]) # returns an error I can't debug - return ret + return ret -def decoGraph(inputFile: str, decoration: dict, outputFile:str = ""): +def compileAlgos(fileList): + ret = [] + for file in fileList: + ret.append(subprocess.call(["ocamlfind", "ocamlopt", "-shared", "-package", "algo", file, "-o", file[0:-3]+".cmxs"])) + return ret + +def decoGraph(inputFile: str, decoration: dict, outputFile:str = "", comp = True): if (outputFile == "") : outputFile = inputFile spec = "" for key in decoration: spec = spec + str(key) + ":" + decoration[key] + " " spec = spec[0:-1] - return subprocess.call(["gg-deco", spec, inputFile, "-o", outputFile]) - -def compileOcaml(file) : - subprocess.call(["ocamlfind", "ocamlopt", "-shared", "-package", "algo", file, "-o", file[0:-3]+".cmxs"]) + ret = subprocess.call(["gg-deco", spec, inputFile, "-o", outputFile]) + if comp : + ret = (ret, compileAlgos(set(decoration.values()))) + return ret def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = False): commandLine = ["sasa", "-l", str(length), topologyFile] + if seed != None: commandLine.append("-seed") commandLine.append(str(seed)) + if rif: commandLine.append("-rif") + commandLine.append("-"+daemon) + + if (daemon == "custd") and os.path.isfile(topologyFile[0:-3]+"lut") : + subprocess.call(["sasa", "-gld", topologyFile]) + return subprocess.check_output(commandLine).decode("utf-8") def parseRif(rif:str): @@ -72,8 +83,6 @@ def parseRif(rif:str): genGraph("BA", "result.dot", {"n":"10", "m":"2"}, False) - decoGraph("result.dot", {0:"p.ml","1-":"p.ml"}) -compileOcaml("p.ml") rif = callSasa("result.dot", rif = True) -ret = parseRif(rif) +parsedRif = parseRif(rif) -- GitLab From cd3e2d7f17a9901144d74f788356ee9015eab2fb Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Wed, 10 Jul 2019 23:57:44 +0200 Subject: [PATCH 14/16] Moved the python environment into 'tools', added Project object in the python environment alongside minor changes, created some scripts to test the environment, and changed make_dot function in topology.ml such that it removes the path of a file before using it as graph name. --- .gitignore | 3 +- lib/sasacore/topology.ml | 2 +- tools/ggDeco/ggDeco.ml | 110 +------ tools/ggDeco/ggDeco.mli | 7 +- tools/ggDeco/ggDeco_Arg.ml | 74 ++++- tools/ggDeco/ggDeco_Arg.mli | 4 +- tools/graphgen/graphGen_arg.ml | 38 +-- tools/graphgen/graphGen_arg.mli | 2 +- tools/scriptEnv.py | 452 +++++++++++++++++++++++++++++ tools/scriptSkeleton.py | 17 ++ tools/scriptSkeletonProject.py | 21 ++ tools/test/skeleton/main-script.py | 88 ------ tools/test/skeleton/p.ml | 6 +- tools/test/skeleton/script0.py | 17 ++ tools/test/skeleton/script1.py | 21 ++ tools/test/skeleton/script2_1.py | 30 ++ tools/test/skeleton/script2_2.py | 28 ++ tools/test/skeleton/tree.dot | 43 +++ 18 files changed, 726 insertions(+), 237 deletions(-) create mode 100644 tools/scriptEnv.py create mode 100644 tools/scriptSkeleton.py create mode 100644 tools/scriptSkeletonProject.py delete mode 100755 tools/test/skeleton/main-script.py create mode 100644 tools/test/skeleton/script0.py create mode 100644 tools/test/skeleton/script1.py create mode 100755 tools/test/skeleton/script2_1.py create mode 100755 tools/test/skeleton/script2_2.py create mode 100644 tools/test/skeleton/tree.dot diff --git a/.gitignore b/.gitignore index e3c1c27..3b35777 100644 --- a/.gitignore +++ b/.gitignore @@ -17,4 +17,5 @@ rdbg-session*.ml Makefile.local notes.org sasa-*.dot -*.html \ No newline at end of file +*.html +*.pyc \ No newline at end of file diff --git a/lib/sasacore/topology.ml b/lib/sasacore/topology.ml index a55138d..e644b93 100644 --- a/lib/sasacore/topology.ml +++ b/lib/sasacore/topology.ml @@ -153,7 +153,7 @@ let make_dot : (t -> string -> unit) = let name = ref "graph0" in let f = (if file_name = "" then stdout else ( - name := file_name; + 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; diff --git a/tools/ggDeco/ggDeco.ml b/tools/ggDeco/ggDeco.ml index 24933cf..8758f29 100644 --- a/tools/ggDeco/ggDeco.ml +++ b/tools/ggDeco/ggDeco.ml @@ -6,24 +6,7 @@ open GgDeco_Arg exception Crossover (* Two different intervals crossover each-other *) exception No_file_for of int -type file = string -type file_spec = (int * int * file) - -(*let pop : (int -> file_spec list -> file_spec * file_spec list) = - fun i fl -> - let (f_s, fl) = List.fold_left (fun (f, li) elem -> - let (a,_,_) = elem in - if a = i then ( - match f with - | Some _ -> raise Pop_two_elements - | None -> (Some elem),li - ) else (f, elem::li) - ) (None, []) fl in - match f_s with - | Some f -> (f,List.rev fl) - | None -> raise Pop_no_element*) - -let compare_file_spec : (file_spec -> file_spec -> int) = +let compare_file_spec : (files_spec_t -> files_spec_t -> int) = fun (a1,b1,_s1) (a2,b2,_s2) -> if (b2 < a1 && b2 <> -1) then 1 else if (b1 < a2 && b1 <> -1) then -1 @@ -37,48 +20,10 @@ let compare_file_spec : (file_spec -> file_spec -> int) = * To create multiple file_spec elements from one string, separate each element by a whitespace. * If the syntax is not respected, an exception will be raised. * Possible exceptions : End_of_file, Stdlib.Scanf.Scan_failure, int_of_string - * Caution : cases where "a" > "b" or "a" < 0 do not raise any exception. + * Caution : Crossover exceptions are not raised in this function *) -let parse_file_spec : (string -> file_spec list) = - fun s -> - let sl = String.split_on_char ' ' s in - List.map (fun file -> - Scanf.sscanf file "%[-0-9] : %s" (fun range file -> - Scanf.sscanf range "%d%s" (fun a s -> - let l = String.length s in - if (l <= 0) then (a,a,file) else ( - if (String.get s 0 <> '-') then (assert false); - if (l = 1) then (a,-1,file) else - let b = int_of_string (String.sub s 1 (l-1)) in - (a,b,file) - ) - ) - ) - ) sl - -(*let deco : (Topology.t -> file_spec list -> Topology.t) = - fun g fl -> - let nodes = ref g.nodes and newNodes = ref [] and indice = ref 0 in - let fl = List.sort compare_file_spec fl in - List.iter (fun (a,b,s) -> - if a <> !indice then raise (No_file_for (!indice)); - let b = if b = -1 then (List.length g.nodes) -1 else b in - for _ = a to b do (* to iterate through the (a-b) first elements of !nodes, and then remove from !nodes these elements *) - let n = List.hd !nodes in - newNodes := (({id=n.id;file=s;init=n.init})::!newNodes); - nodes := List.tl !nodes; - indice := !indice +1 - done; - ) fl; - { - nodes = List.rev !newNodes; - succ = g.succ; - of_id = g.of_id; - }*) - - -let pop : (file_spec list ref -> int -> string) = +let pop : (files_spec_t list ref -> int -> string) = fun fl i -> match !fl with | [] -> raise (No_file_for i) @@ -87,7 +32,7 @@ let pop : (file_spec list ref -> int -> string) = s -let deco : (Topology.t -> file_spec list -> Topology.t) = +let deco : (Topology.t -> files_spec_t list -> Topology.t) = fun g fl -> let newNodes = ref [] and fl = ref (List.sort compare_file_spec fl) in List.iteri (fun i n -> @@ -106,52 +51,9 @@ let deco : (Topology.t -> file_spec list -> Topology.t) = of_id = g.of_id; } -(************** Code duppliqué pour tester, qui sera à enlever ************** -let rec make_nodes_dot : (node list -> string) = - (*Create a string in the dot syntax from a node list*) - function - | [] -> "" - | node::tail -> (Printf.sprintf "%s [algo=\"%s\"]\n" node.id node.file)^(make_nodes_dot tail) - -let make_links_dot : (Topology.t -> string) = - fun t -> - let links = List.flatten ( - List.map (fun n -> - let l = t.succ n.id in - 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 - ) - ) l - ) t.nodes - ) in - String.concat "\n" (List.sort_uniq compare links) - -let make_dot : (Topology.t -> string -> unit) = - (*Create a dot file from a graph*) - fun t file_name -> - let name = ref "graph0" in - let f = (if file_name = "" then stdout else - ( - name := Filename.remove_extension file_name; - (*if Filename.extension file_name <> ".dot" then - (open_out (file_name ^".dot")) - else*) open_out file_name - ) - ) in - let dot = (Printf.sprintf "graph %s {\n\n" !name) ^ (make_nodes_dot t.nodes) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in - Printf.fprintf f "%s" dot -****************** fin code duppliqué ********************) - let () = ( let args = parse Sys.argv in let g = read args.dot_file in - let new_g = deco g (parse_file_spec args.algo_files) in - make_dot new_g args.output + let new_g = deco g args.files_spec in + make_dot new_g args.output ) diff --git a/tools/ggDeco/ggDeco.mli b/tools/ggDeco/ggDeco.mli index 441b160..dc71bdd 100644 --- a/tools/ggDeco/ggDeco.mli +++ b/tools/ggDeco/ggDeco.mli @@ -1,7 +1,2 @@ - -type file = string -type file_spec = (int * int * file) - - -val deco : (Sasacore.Topology.t -> file_spec list -> Sasacore.Topology.t) +val deco : (Sasacore.Topology.t -> GgDeco_Arg.files_spec_t list -> Sasacore.Topology.t) diff --git a/tools/ggDeco/ggDeco_Arg.ml b/tools/ggDeco/ggDeco_Arg.ml index 1f62e69..a9ec890 100644 --- a/tools/ggDeco/ggDeco_Arg.ml +++ b/tools/ggDeco/ggDeco_Arg.ml @@ -1,10 +1,14 @@ let () = Random.self_init (); +type file = string +type files_spec_t = (int * int * file) +exception Invalid_file_spec of string*string + type t = { mutable dot_file: string; mutable output: string; - mutable algo_files : string; + mutable files_spec : files_spec_t list; mutable _args : (string * Arg.spec * string) list; mutable _general_man : (string * string list) list; @@ -14,7 +18,7 @@ type t = { } let usage_msg tool = - ("usage: " ^ tool ^ " \"\" [-o ]\n" ) + ("usage: " ^ tool ^ " ... [-o ]\n" ) let print_usage tool = Printf.printf "\n%s use -h for additional information.\n\n" (usage_msg tool); flush stdout; exit 1 @@ -25,7 +29,7 @@ let (make_args : unit -> t) = dot_file = ""; output = ""; - algo_files = ""; + files_spec = []; _args = []; _general_man = []; @@ -34,8 +38,6 @@ let (make_args : unit -> t) = _margin = 12; } -let myexit i = exit i - let first_line b = ( try ( let f = String.index b '\n' in @@ -46,13 +48,13 @@ let exist_file f = ( if not (Sys.file_exists f) then ( prerr_string ("File not found: \""^f^"\""); prerr_newline (); - myexit 1 + exit 1 ) ) let unexpected s = ( prerr_string ("unexpected argument \""^s^"\""); prerr_newline (); - myexit 1 + exit 1 ) @@ -90,7 +92,6 @@ let help args tool = ( Printf.printf "\n"; Printf.printf " - Concatenate all the the descriptions, with a whitespace between each.\n"; Printf.printf " Example : \"1:root.ml 2-:p.ml\" assign root.ml to the first node, and p.ml to the other ones.\n"; - Printf.printf " Since it is one argument, do not forget the double quotes."; (* maybe I should change it such that it accepts with or without the double quotes *) Printf.printf "\n"; Printf.printf "\n"; @@ -131,6 +132,39 @@ let (add_other : t -> string -> unit) = let current = ref 0;; +let parse_file_spec : (string list -> files_spec_t list) = + fun s -> + List.map (fun file -> + try ( + Scanf.sscanf file "%[-0-9]:%s" (fun range file -> + if range = "" then (raise (Invalid_file_spec (file, "The first and last node's indexes are missing")) + ) else + Scanf.sscanf range "%d%s" (fun a s -> + if (a < 0) then raise (Invalid_file_spec (file,"The first node's index have to be positive or null")) else + if (s = "") then (a,a,file) else + + if (s = "-") then (a,-1,file) else + Scanf.sscanf s "-%d" (fun b -> + if (b < a) then + raise (Invalid_file_spec (file,"The last node's index have to be higher than the first node's index")) + else + (a,b,file) + ) + ) + ) + ) + with + | Scanf.Scan_failure _ -> + raise (Invalid_file_spec (file, + "The boundaries (first and last node's indexes) should be integers, but an non-numerical character has been found")) + ) s + +let rec pop l = + match l with + | [] -> assert false + | [a] -> ([],a) + | b::tl -> let (l,a) = pop tl in (b::l,a) + let parse argv = ( let save_current = !current in let args = make_args () in @@ -138,11 +172,25 @@ let parse argv = ( try ( Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg argv.(0)); current := save_current; - (match (List.rev args._others) with - | [a;b] -> (args.algo_files <- a; exist_file b; args.dot_file <- b) - | _::_::tl -> unexpected (List.hd tl) - | _ -> print_usage (argv.(0)) - ); + + (* Same as List.rev, but also check if there's no option (starting by '-') in these arguments *) + let others = List.fold_left (fun l o -> if String.get o 0 = '-' then unexpected o else o::l) [] args._others in + + (match others with + | [] | [_] -> + (Printf.fprintf stderr "Error : you need 2 arguments to use %s\n" (argv.(0)); flush stderr; print_usage (argv.(0))) + | l -> ( + let (a,b) = pop l in + let a = try ( + parse_file_spec a + ) with Invalid_file_spec (fs,s) -> ( + Printf.fprintf stderr "Error while parsing the file specification \"%s\" :\n" fs; + Printf.fprintf stderr "%s\n"s; + flush stderr; print_usage (argv.(0)) + ) in + args.files_spec <- a; exist_file b; args.dot_file <- b + ) + ); args ) with diff --git a/tools/ggDeco/ggDeco_Arg.mli b/tools/ggDeco/ggDeco_Arg.mli index 81cce60..384f34d 100644 --- a/tools/ggDeco/ggDeco_Arg.mli +++ b/tools/ggDeco/ggDeco_Arg.mli @@ -1,9 +1,11 @@ +type file = string +type files_spec_t = (int * int * file) type t = { mutable dot_file: string; mutable output: string; - mutable algo_files : string; + mutable files_spec : files_spec_t list; mutable _args : (string * Arg.spec * string) list; mutable _general_man : (string * string list) list; diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 1698cbb..90cf441 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -36,7 +36,7 @@ type t = { mutable silent : bool; mutable _args : (string * Arg.spec * string) list; - mutable _general_man : (string * (string list * action) list) list; + mutable _man : (string * (string list * action) list) list; mutable _others : string list; mutable _margin : int; @@ -82,7 +82,7 @@ let (make_args : unit -> t) = silent = false; _args = []; - _general_man = []; + _man = []; _others = []; _margin = 12; @@ -103,8 +103,7 @@ let unexpected s = ( let printSpec args outChannel action (c, messageList) = ( List.iter (fun (ml,action_type) -> - if (action <> action_type && action_type <> "all") then () - else ( + if (action = action_type) then let (m1, oth) = match ml with | h::t -> (h,t) | _ -> ("",[]) @@ -119,8 +118,7 @@ let printSpec args outChannel action (c, messageList) = ( Printf.fprintf outChannel "%s%s%s" c t1 m1; List.iter (function x -> Printf.fprintf outChannel "\n%s%s" t2 x) oth ; Printf.fprintf outChannel "\n" ; - ) - ) messageList + ) messageList ) let help args tool = ( @@ -146,16 +144,18 @@ let help args tool = ( Printf.printf "\n"; Printf.printf "Use '%s -h' to see the command's options.\n" tool; Printf.printf "\n"; - Printf.printf "==================\n"; - Printf.printf " Global options :\n"; - Printf.printf "==================\n"; - ) else ( + ); + Printf.printf "==================\n"; + Printf.printf " General options :\n"; + Printf.printf "==================\n"; + List.iter (printSpec args stdout "void") (List.rev args._man); + if (args.action <> "void") then ( Printf.printf "\n"; - Printf.printf "=====================\n"; - Printf.printf " Available options :\n"; - Printf.printf "=====================\n"; + Printf.printf "===================================\n"; + Printf.printf " Specific options to the command :\n"; + Printf.printf "===================================\n"; + List.iter (printSpec args stdout args.action) (List.rev args._man) ); - List.iter (printSpec args stdout args.action) (List.rev args._general_man) ); Printf.printf "\n"; exit 0 @@ -168,7 +168,7 @@ let (mkopt : t -> string list -> ?arg:string -> Arg.spec -> let add_option o = opt._args <- (o, se, "")::opt._args in List.iter add_option ol ; let col1 = (String.concat ", " ol)^arg in - opt._general_man <- (col1, ml)::opt._general_man + opt._man <- (col1, ml)::opt._man (*** User Options Tab **) let (mkoptab : string array -> t -> unit) = @@ -178,12 +178,12 @@ let (mkoptab : string array -> t -> unit) = (Arg.Unit (fun () -> args.outputFile <- "")) [(["Set the output channel for the generated graph to stdout."; "This is the output by default"; - "The output will have a DOT file syntax.\n"],"all")]; + "The output will have a DOT file syntax.\n"],"void")]; mkopt args ["--DOT-output";"-o"] ~arg:" " (Arg.String (fun s -> args.outputFile <- s)) [(["Set the output file for the generated graph to the given file."; - "The output will have a DOT file syntax.\n"],"all")]; + "The output will have a DOT file syntax.\n"],"void")]; let msg = "Set the node number in the graph\n" in mkopt args ["--nodes-number";"-n"] ~arg:" " @@ -281,12 +281,12 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) - [(["Remove all outputs, except ones made by other options.\n"],"all")]; + [(["Remove all outputs, except ones made by other options.\n"],"void")]; mkopt args ["--help";"-h"] (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action)))) - [(["Prints the help of the command.\n"],"all")]; + [(["Prints the help of the command.\n"],"void")]; ) (* all unrecognized options are accumulated *) diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index 70d476e..06260c3 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -31,7 +31,7 @@ type t = { mutable silent : bool; mutable _args : (string * Arg.spec * string) list; - mutable _general_man : (string * (string list * action) list) list; + mutable _man : (string * (string list * action) list) list; mutable _others : string list; mutable _margin : int; diff --git a/tools/scriptEnv.py b/tools/scriptEnv.py new file mode 100644 index 0000000..2172dca --- /dev/null +++ b/tools/scriptEnv.py @@ -0,0 +1,452 @@ +import subprocess, os, datetime + +def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent: bool = False): + """Generate a graph, using gg (GraphGen), and outputs it in a DOT file + + It also removes any '.lut' file at the name of the outputFile + + Args: + graphType (str): The type of graph. It correspond to the command used in 'gg ' + The list of possible values are at the end of this docstring. + + outputFile (str): The file in which the graph will be written. + We strongly advise to have '.dot' extension + + graphProperties (dict): The properties of the graph. They should be in a dictionary, + with the name of the property as key and the argument as value. + An empty string will be considered as no argument. + + is_silent (bool, optional): Indicates whether the call of gg will be silent or not. + If it is, all the outputs on stdout will be removed, + except for errors (or if '-h' is specified). + + Return: the return value of the gg command + + + Possible values for graphType and their properties : + "clique" -> a graph where all the nodes are neighbors of each other + proprieties : + --- 'n' (int) : node number + "star" -> a graph where all the nodes are connected to one node (usually called 'root') + proprieties : + --- 'n' (int) : node number + "ring" -> (also called cycle graph) a graph composed of a single cycle + proprieties : + --- 'n' (int) : node number + "grid" -> a squared grid graph + proprieties : + --- 'w' and 'he' (int) : the width and the height of the grid + "HC" -> a hypercube + proprieties : + --- 'd' (int) : the hypercube dimension + "ER" -> a graph created using the Erdos Renyi algo + proprieties : + --- 'n' (int) : node number + --- 'p' (float) : the probability of each edge (between 0 and 1) + "BA" -> a graph created using the Barabasi–Albert algo + proprieties : + --- 'n' (int) : node number + --- 'm' (float) : the number of edge generated per additional node + "tree" -> a tree graph + proprieties : + --- 'n' (int) : node number + "UDG" -> a graph created using the Unit Disc Graph algo + proprieties : + --- 'n' (int) : node number + --- 'w' and 'he' (float) : the width and the height of the UDG's terrain + --- 'r' (float) : the Unit Disc's radius (detection radius around each node) + --- 'du'/'dur' (string) : create a DOT file (and a PDF if Graphvis is installed) + to visualize the UDG graph (use dur to visualize radius). + Do not put any extension in the string + (they will be added automatically) + + """ + + args = ["gg", graphType, "-o", outputFile] + + for key in graphProperties: + if (key[0] != "-"): + args.append("-"+key) + else : + args.append(str(key)) + + if (graphProperties[key] != ""): + args.append(str(graphProperties[key])) + + if is_silent: + args.append("-s") + + ret = subprocess.call(args) + + try : + os.remove(outputFile[0:-3]+"lut") + except FileNotFoundError as e: # [Errno 2] No such file or directory: '' + pass + return ret + +def compileAlgos(fileList): + """Compile an iterable object of .ml files into .cmxs files, + or compile the .ml files of a string in the algo-files syntax supported by gg-deco""" + if type(fileList) == str : + tmp = fileList + fileList = [] + for s in tmp.split(): + fileList.append(s.split(":")[1]) + ret = [] + for file in fileList: + ret.append(subprocess.call(["ocamlfind", "ocamlopt", "-shared", "-package", "algo", file, "-o", file[0:-3]+".cmxs"])) + return ret + +def decoGraph(inputFile: str, decoration, outputFile:str = "", comp = True): + """Decorate a graph, using gg-deco, to add an algo or change the algo of each node + + Args : + inputFile (str) : the DOT file to decorate + decoration : a string, list or a dictionary describing the + outputFile (str, optional) : The name for the decorated DOT file. + Same as the inputFile by default. + comp (bool, optional) : If True, runs 'compileAlgo' on decoration + + Return : A list of the return values of each file + + """ + + if (outputFile == "") : + outputFile = inputFile + spec = [] + files = [] + + if type(decoration) == dict: + for key in decoration: + spec.append(str(key) + ":" + decoration[key]) + files.append(decoration[key]) + elif type(decoration) == str: + files = decoration + spec = decoration.split() + else : # type list + spec = decoration + for s in decoration: + s = s.split(":") + files.append([1]) + + ret = subprocess.call(["gg-deco"] + spec + [inputFile, "-o", outputFile]) + if comp : + ret = (ret, compileAlgos(files)) + return ret + +def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = True): + """Calls sasa on the specified topologyFile (a decorated DOT file) + + Needs to have the compiled versions of all .ml files used in the topology file + in the same directory. May create a .lut file if the daemon "custd" is used. + + Args : + topologyFile (string) : the DOT file on which sasa is executed + length (int, optional) : the maximum number of steps + seed (int, optional) : the pseudo-random number generator seed. Random by default + daemon (string, optional) : Indicates the daemon to use. List of possible daemons below + rif (bool, optional) : if True, indicates to sasa to output in RIF syntax + + Return : the output of sasa (string) + + Possible daemons : + "sd": Synchronous demon (selects as much actions as possible, up to one action per node) + "cd": Central demon (selects exactly one action) + "lcd" : Locally Central demon (never activates two neighbors' actions in the same step) + "dd" : Distributed demon (select at least one action, randomly) + + """ + + commandLine = ["sasa", "-l", str(length), topologyFile] + + if seed != None: + commandLine.append("-seed") + commandLine.append(str(seed)) + + if rif: commandLine.append("-rif") + + commandLine.append("-"+daemon) + + #if (daemon == "custd") and os.path.isfile(topologyFile[0:-3]+"lut") : + # subprocess.call(["sasa", "-gld", topologyFile]) + + return subprocess.check_output(commandLine, stderr=subprocess.STDOUT, encoding = "utf-8") + +def parseRif(rif:str): + """ Parse a rif document made by a sasa call (from sasa's stdout or output file) + + Return : a tuple of two elements : + - A list of the names of the variable + + - A list containing the state of each step. + (A state is the list of the values of the variables.) + """ + + """ + Example (not in the docstring) : + >>> rif = '\n#outputs "p0_x":int "p1_x":int "Enab_p0_action":bool "Enab_p1_action":bool ' + >>> rif += '"p0_action":bool "p1_action":bool\n\n#step 1\n #outs 4 2 t t t t\n\n#step 2\n ' + >>> rif += '#outs 0 0 f t f t\n\n#step 3\n #outs 0 1 f f f f\n\n#quit\n' + >>> (names, states) = parseRif(rif) + >>> names + ['p0_x', 'p1_x', 'Enab_p0_action', 'Enab_p1_action', 'p0_action', 'p1_action'] + >>> states + [[4, 2, True, True, True, True], [0, 0, False, True, False, True], [0, 1, False, False, False, False]] + + """ + + rif = list(filter(None, rif.split("\n"))) + names = [] + types = [] + states = [] + possibleTypes = {"int":int,"real":float,"bool":bool} + for line in rif: + newStateLine = [] + line = [x.split() for x in line.split("#", 1)] + + for v in line[0]: + newStateLine.append(v) + pragma = line[1][0] + if pragma in ["inputs", "outputs"]: + for n in line[1][1:]: + n = n.split(":") + names.append(n[0][1:-1]) + types.append(possibleTypes[n[1]]) + + if pragma == "outs": + for v in line[1][1:]: + newStateLine.append(v) + + tmp = [] + for v, t in zip(newStateLine, types): + if t != bool: + tmp.append(t(v)) + else : + tmp.append(v in ["t","T","1"]) + + if tmp != []: + states.append(tmp) + + return (names,states) + +def column(i, matrix:list, names:list = None): + """Outputs a list with the elements of a column in the matrix. + + If names is not specified, outputs the column i of the matrix + If names is specified, outputs the column at the index of i in names. + (useful to get the states of a variable from parseRif though all the steps) + + """ + + if names != None : i = names.index(i) + return [x[i] for x in matrix] + +def call(command, log = None, verb = 2, options = {}): + """Calls the shell command given in argument, and give its output in stdout as return value + + If the command fails (command return value other than 0), the command's stdout is printed, and + the error 'subprocess.CalledProcessError' is raised. + + Optional Args : + log (filename): a log file, in which the command's stdout will be appended + verb (int): the verbose level. It has three levels : 0,1 or 2. + On level 0, nothing will be printed excepted the raised error + On level 1, if there's an error, the command's stdout will be printed. + On level 2 (default), a message will tell when the command is called, + and when it has finished. + On level 3, the command's stdout will always be printed + options (dict): a way to add options in the command line. Each key of the dict will + be added to the command line with an additional "-" in front, followed by the + corresponding value in the dict. For example, {"n":3, "o":"toto.ml"} will add the + string "-n 3 -o toto.ml" to the command line. + + """ + + if verb > 1 : + print("Calling '"+command.split()[0]+"' ...") + + for k in options: + command += " -"+k+" "+str(options[k]) + + try: + output = subprocess.check_output( + command, shell=True, stderr=subprocess.STDOUT, encoding = "utf-8") + except subprocess.CalledProcessError as exc: + if log != None: + f = open(log, "a+") + f.write(exc.output) + if verb > 2 : + print("------ output : ------") + if verb > 0 : + print(exc.output) + if verb > 2 : + print("----------------------") + raise + + if log != None: + f = open(log, "a+") + f.write(output) + if verb > 2 : + print("------ output : ------") + print(output) + print("----------------------") + if verb > 1 : + print("Done.") + return output + + +class Project: + """Manage files of a project, to keep traces of a test battery. + Inside a project directory, there will be a directory for each version + (i.e. for each creation of a Project object). + """ + + def __init__(self, projectName = "sasaProject", date = True, time = True): + """Initialize a version of the project. + + Args : + projectName (str) : The name of the project, in which a new version will be created. + date (bool, optional) : indicates if the version's name will contain the date + time (bool, optional) : indicates if the version's name will contain the time + + Note : if an old version has the same name as the new one, a number will be added to the new + version's name. + + """ + + self.name = projectName + identifyer = "" + now = str(datetime.datetime.now()).split() + if date: + identifyer += now[0] + if date and time: + identifyer += "_" + if time: + identifyer += now[1].split(".")[0] + + try: + os.makedirs(projectName) + except FileExistsError: + pass + + if os.path.exists(projectName+"/"+identifyer) : + i = 0 + while os.path.exists(projectName+"/"+identifyer+"_"+str(i)):i += 1 + identifyer += "_"+str(i) + + os.makedirs(projectName+"/"+identifyer) + self.identifyer = identifyer + self.path = projectName+"/"+identifyer+"/" + self.folders = [] + + def createDir (self, dir): + """Creates the directory dir in the current version if it doesn't exist. + + Return value (bool) : True if the directory was created, False if it already existed + + Note : this method is principally created to be used by other methods in the object. + + """ + + try: + os.makedirs(self.path + dir) + return True + except FileExistsError: + return False + + def open(self, dir, name, ext): + """Opens a new file in the directory dir of the current version. + + The actual name of the file is 'name_i.ext', with name and ext being the arguments of the same name, + and i being the lower number such as no other file has the same name. + + Args : + dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. + name (str) : the name of the file, without extension. + ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + + Return value : + The opened file (same as "open(path)") if getIndex is False + + """ + + self.createDir(dir) + i = 0 + path = self.path + dir + "/" + name + if ext != "" and ext[0] != ".": ext = "."+ext + + while os.path.exists(path + "_" + str(i) + ext):i += 1 + path += "_"+str(i)+ ext + + f = open(path, 'w+') + + return f + + def add_file(self, dir, name, ext, content = ""): + """Creates a new file in the directory dir of the current version. + + The actual name of the file is 'name_i.ext', with name and ext being the arguments of the same name, + and i being the lower number such as no other file has the same name. + + Args : + dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. + name (str) : the name of the file, without extension. + ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + content (str, optional) : a string that will be added automatically to the file on creation. + + Return value : + The path to the created file + + """ + self.createDir(dir) + i = 0 + path = self.path + dir + "/" + name + if ext != "" and ext[0] != ".": ext = "."+ext + + while os.path.exists(path + "_" + str(i) + ext):i += 1 + path += "_"+str(i)+ ext + + f = open(path, 'w+') + + f.write(content) + f.close() + + return path + + def open_i(self, i, dir, name, ext, openType = 'a'): + """Opens a file in dir with the name 'name_i.ext'. + + Note : Use it to modify a file created previously, not to create a file at index i + unless you are sure of what you are doing + + Args : + dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. + name (str) : the name of the file, without extension. + ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + + """ + + self.createDir(dir) + return open(self.path + dir + "/" + name + "_" + str(i) + ext, openType) + + def exist_i(self, i, dir, name, ext): + """Checks if the file 'name_i.ext' exists in dir.""" + + return os.path.exists(self.path + dir + "/" + name + "_" + str(i) + ext) + + def get_last(self, dir, name, ext): + """Outputs the index just before the first free index. + + The purpose of this method is to give the last used index, but it might be wrong if + files are deleted or created without using this object, or if a file is created using open_i. + + Args : + dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. + name (str) : the name of the file, without extension. + ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + + """ + + i = 0 + while os.path.exists(self.path + dir + "/" + name + "_" + str(i) + ext): i += 1 + return i - 1 diff --git a/tools/scriptSkeleton.py b/tools/scriptSkeleton.py new file mode 100644 index 0000000..34984d5 --- /dev/null +++ b/tools/scriptSkeleton.py @@ -0,0 +1,17 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, //path_to_env//) +from scriptEnv import * + +genGraph("ring", "ring.dot", {"n":20}, True) +#call("gg ring -n 20 -o ring.dot") + +decoGraph("ring.dot", "0-:p.ml", comp = True) +#call('gg-deco 0-:p.ml ring.dot -o ring.dot', verb = 1) +#compileAlgos(["p.ml"]) + +(_,vals) = parseRif(callSasa("ring.dot")) +#(_,vals) = parseRif(call("sasa -rif ring.dot")) + +print(len(vals)) \ No newline at end of file diff --git a/tools/scriptSkeletonProject.py b/tools/scriptSkeletonProject.py new file mode 100644 index 0000000..6865028 --- /dev/null +++ b/tools/scriptSkeletonProject.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, //path_to_env//) +from scriptEnv import * + +myProj = Project() +compileAlgos(["p.ml"]) +totSteps = 0 + +for _ in range(10): + path = myProj.add_file("dots", "ring", ".dot") + genGraph("ring", path, {"n":20}, True) + + decoGraph(path, "0-:p.ml", comp = False) + + (_,vals) = parseRif(callSasa(path)) + + totSteps += len(vals) + +print(totSteps, totSteps/10) \ No newline at end of file diff --git a/tools/test/skeleton/main-script.py b/tools/test/skeleton/main-script.py deleted file mode 100755 index 0a4c76e..0000000 --- a/tools/test/skeleton/main-script.py +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/env python3 -import subprocess, os - -def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent: bool = False): - args = ["gg", graphType, "-o", outputFile] - - for key in graphProperties: - if (key[0] != "-"): - args.append("-"+key) - else : - args.append(key) - - if (graphProperties[key] != ""): - args.append(graphProperties[key]) - - if is_silent: - args.append("-s") - - ret = subprocess.call(args) - - try : - os.remove(outputFile[0:-3]+"lut") - except FileNotFoundError as e: # [Errno 2] No such file or directory: '' - pass - return ret - -def compileAlgos(fileList): - ret = [] - for file in fileList: - ret.append(subprocess.call(["ocamlfind", "ocamlopt", "-shared", "-package", "algo", file, "-o", file[0:-3]+".cmxs"])) - return ret - -def decoGraph(inputFile: str, decoration: dict, outputFile:str = "", comp = True): - if (outputFile == "") : - outputFile = inputFile - spec = "" - for key in decoration: - spec = spec + str(key) + ":" + decoration[key] + " " - spec = spec[0:-1] - ret = subprocess.call(["gg-deco", spec, inputFile, "-o", outputFile]) - if comp : - ret = (ret, compileAlgos(set(decoration.values()))) - return ret - -def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = False): - commandLine = ["sasa", "-l", str(length), topologyFile] - - if seed != None: - commandLine.append("-seed") - commandLine.append(str(seed)) - - if rif: commandLine.append("-rif") - - commandLine.append("-"+daemon) - - if (daemon == "custd") and os.path.isfile(topologyFile[0:-3]+"lut") : - subprocess.call(["sasa", "-gld", topologyFile]) - - return subprocess.check_output(commandLine).decode("utf-8") - -def parseRif(rif:str): - rif = rif.split("#outputs", 1)[1].replace("\n", "").split("#") - header = [] - types = [] - possibleTypes = {"int":int,"float":float,"string":str,"bool":bool} - for s in rif[0].replace("\n","").split(" "): - if s != "": - s = s.split(":") - header.append(s[0][1:-1]) - types.append(possibleTypes[s[1]]) - - steps = rif[1:len(rif)] - matrix = [] - for i in range(len(steps)): - s = steps[i] - if s[0:4] != "step": - if s[0:4] == "outs": - matrixLine = s[5:len(s)].split(" ") - for j in range(len(matrixLine)): - matrixLine[j] = types[j](matrixLine[j]) - matrix.append(matrixLine) - return (header,types,matrix) - - -genGraph("BA", "result.dot", {"n":"10", "m":"2"}, False) -decoGraph("result.dot", {0:"p.ml","1-":"p.ml"}) -rif = callSasa("result.dot", rif = True) -parsedRif = parseRif(rif) diff --git a/tools/test/skeleton/p.ml b/tools/test/skeleton/p.ml index 6b08c60..0f11782 100644 --- a/tools/test/skeleton/p.ml +++ b/tools/test/skeleton/p.ml @@ -9,9 +9,9 @@ type memory = int let (init_state: int -> memory) = fun _i -> Random.int 10 -let (state_to_string: memory -> string) = +(*let (state_to_string: memory -> string) = fun m -> - string_of_int m + string_of_int m*) let (copy_state : memory -> memory) = @@ -43,7 +43,7 @@ let () = step = step_f; } ]; - state_to_string = state_to_string; + state_to_string = string_of_int; state_of_string = Some int_of_string; copy_state = copy_state; } diff --git a/tools/test/skeleton/script0.py b/tools/test/skeleton/script0.py new file mode 100644 index 0000000..847eff9 --- /dev/null +++ b/tools/test/skeleton/script0.py @@ -0,0 +1,17 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, "../..") +from scriptEnv import * + +genGraph("ring", "ring.dot", {"n":20}, True) +#call("gg ring -n 20 -o ring.dot") + +decoGraph("ring.dot", "0-:p.ml", comp = True) +#call('gg-deco 0-:p.ml ring.dot -o ring.dot', verb = 1) +#compileAlgos(["p.ml"]) + +(_,vals) = parseRif(callSasa("ring.dot")) +#(_,vals) = parseRif(call("sasa -rif ring.dot")) + +print(len(vals)) \ No newline at end of file diff --git a/tools/test/skeleton/script1.py b/tools/test/skeleton/script1.py new file mode 100644 index 0000000..543ab97 --- /dev/null +++ b/tools/test/skeleton/script1.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, "../..") +from scriptEnv import * + +myProj = Project() +compileAlgos(["p.ml"]) +totSteps = 0 + +for _ in range(10): + path = myProj.add_file("dots", "ring", ".dot") + genGraph("ring", path, {"n":20}, True) + + decoGraph(path, "0-:p.ml", comp = False) + + (_,vals) = parseRif(callSasa(path)) + + totSteps += len(vals) + +print(totSteps, totSteps/10) \ No newline at end of file diff --git a/tools/test/skeleton/script2_1.py b/tools/test/skeleton/script2_1.py new file mode 100755 index 0000000..fc5ddea --- /dev/null +++ b/tools/test/skeleton/script2_1.py @@ -0,0 +1,30 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, '../..') +from scriptEnv import * + +from statistics import stdev + +proj = Project("proj_s1", True, False) + +f = proj.open("log", "log", "") +compileAlgos(["p.ml"]) + +step_nb = [] +for x in range(1000): + + path = proj.add_file("dots", "tree", ".dot") + genGraph("tree", path, {"n":20}, True) + decoGraph(path, "0-:p.ml", comp = False) + rif = callSasa(path) + + proj.add_file("rifs", "tree", ".rif", content = rif) + (_,vals) = parseRif(rif) + step_nb.append(len(vals)) + sd = None + if x > 1:sd = stdev(step_nb) + #print(x,"-",sd) + f.write(str(len(vals)) + " -- " + str(sd) + "\n") + +print(sum(step_nb)/1000) diff --git a/tools/test/skeleton/script2_2.py b/tools/test/skeleton/script2_2.py new file mode 100755 index 0000000..36f2738 --- /dev/null +++ b/tools/test/skeleton/script2_2.py @@ -0,0 +1,28 @@ +#!/usr/bin/env python3 + +import sys +sys.path.insert(0, '../..') +from scriptEnv import * +from statistics import stdev +proj = Project("proj_s2", True, False) + +f = proj.open("log", "log", "") +compileAlgos(["p.ml"]) + +step_nb = [] +for x in range(1000): + + path = proj.add_file("dots", "tree", ".dot") + call("gg tree -n 20 -o "+path, verb = 1) + call('gg-deco 0-:p.ml '+path+" -o "+path, verb = 1) + rif = call('sasa -rif '+path, verb = 1) + + proj.add_file("rifs", "tree", ".rif", content = rif) + (_,vals) = parseRif(rif) + step_nb.append(len(vals)) + sd = None + if x > 1:sd = stdev(step_nb) + print(x,"-",sd) + f.write(str(len(vals)) + " -- " + str(sd) + "\n") + +print(sum(step_nb)/1000) \ No newline at end of file diff --git a/tools/test/skeleton/tree.dot b/tools/test/skeleton/tree.dot new file mode 100644 index 0000000..e9e92a3 --- /dev/null +++ b/tools/test/skeleton/tree.dot @@ -0,0 +1,43 @@ +graph tree { + + p0 [algo="p.ml"] + p1 [algo="p.ml"] + p2 [algo="p.ml"] + p3 [algo="p.ml"] + p4 [algo="p.ml"] + p5 [algo="p.ml"] + p6 [algo="p.ml"] + p7 [algo="p.ml"] + p8 [algo="p.ml"] + p9 [algo="p.ml"] + p10 [algo="p.ml"] + p11 [algo="p.ml"] + p12 [algo="p.ml"] + p13 [algo="p.ml"] + p14 [algo="p.ml"] + p15 [algo="p.ml"] + p16 [algo="p.ml"] + p17 [algo="p.ml"] + p18 [algo="p.ml"] + p19 [algo="p.ml"] + + p0 -- p1 + p1 -- p11 + p1 -- p12 + p1 -- p16 + p1 -- p2 + p1 -- p3 + p10 -- p19 + p10 -- p4 + p11 -- p15 + p13 -- p9 + p14 -- p5 + p17 -- p2 + p18 -- p2 + p2 -- p4 + p2 -- p6 + p3 -- p5 + p3 -- p9 + p5 -- p7 + p6 -- p8 +} -- GitLab From f998f1bfe011f809b3d2d38ee186de1dab22faaf Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Fri, 12 Jul 2019 09:51:01 +0200 Subject: [PATCH 15/16] Separated UDG and Quasi UDG --- tools/graphgen/graphGen.ml | 60 +++------ tools/graphgen/graphGen_arg.ml | 121 ++++++++---------- tools/graphgen/graphGen_arg.mli | 8 +- tools/graphgen/randomGraph.ml | 35 +++--- tools/graphgen/randomGraph.mli | 22 ++-- tools/graphgen/udgUtils.ml | 23 ++-- tools/graphgen/udgUtils.mli | 2 +- tools/scriptEnv.py | 209 +++++++++++++------------------- 8 files changed, 199 insertions(+), 281 deletions(-) diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index b223b78..5eb5240 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -5,6 +5,16 @@ open RandomGraph open GraphGen_arg open UdgUtils +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 () = ( let t = parse Sys.argv in @@ -25,56 +35,26 @@ let () = ( ) in if (not t.silent) then Printf.fprintf stderr "%s" msg ); - let args_msg = ref "" in + if (t.outputFile <> "" && not t.silent) + then Printf.printf "Generating a %s graph...\n" t.action; let g = ( match t.action with | "void" -> exit 0 | "clique" -> (gen_clique t.n) | "star" -> (gen_star t.n) | "ring" -> (gen_ring t.n) - | "grid" -> (args_msg := Printf.sprintf" with l=%d w=%d" t.grid.height t.grid.width; - gen_grid t.grid.height t.grid.width) + | "grid" -> (gen_grid t.grid.height t.grid.width) | "HC" -> (gen_hyper_cube t.n) - | "ER" -> (args_msg := Printf.sprintf" with p=%f" t.er; gen_ER t.n t.er) - | "BA" -> (args_msg := Printf.sprintf" with m=%d" t.ba; gen_BA t.n t.ba) + | "ER" -> (gen_ER t.n t.er) + | "BA" -> (gen_BA t.n t.ba) | "tree" -> (rand_tree t.n) - | "UDG" -> ( - args_msg := Printf.sprintf " with w=%f l=%f r=%f" - t.udg.width t.udg.height t.udg.radius; - let prob_func = (match t.udg.proba with - | ConstP c -> (args_msg := Printf.sprintf "%s and p=%f" !args_msg c; - (prob_from_constant c)) - | LstP l -> (args_msg := Printf.sprintf "%s and a list of probabilities" !args_msg; - (prob_from_list l t.udg.radius)) - | LinearP -> ( - args_msg := Printf.sprintf "%s and a linear edge probability" !args_msg; - (linear_prob t.udg.radius) - ) - ) in - let (graph,plan) = gen_udg ~p:(prob_func) t.n t.udg.width t.udg.height t.udg.radius in - if (t.dotUDG <> "") then ( - make_dot_udg graph plan (t.udg.width,t.udg.height) (t.dotUDG^".dot"); - let command_return = - Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDG t.dotUDG) in - if (command_return) <> 0 && (not t.silent) then - Printf.fprintf stderr "/!\\ Error n°%d while parsing %s.dot into %s.pdf /!\\" - command_return t.dotUDG t.dotUDG - ); - if (t.dotUDGrad <> "") then ( - make_dot_udg graph plan (t.udg.width,t.udg.height) ~r:(t.udg.radius) (t.dotUDGrad^".dot"); - let command_return = - Sys.command (Printf.sprintf "neato -Tpdf %s.dot -o %s.pdf" t.dotUDGrad t.dotUDGrad) in - if (command_return) <> 0 && (not t.silent) then - Printf.fprintf stderr "/!\\ Error n°%d while parsing %s.dot into %s.pdf /!\\" - command_return t.dotUDGrad t.dotUDGrad - ); - graph - ) + | "UDG" -> (let (graph, plan) = gen_udg 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 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 - if (t.outputFile <> "" && not t.silent) - then Printf.printf "Generating a %s graph%s...\n" t.action !args_msg; - make_dot g t.outputFile; + make_dot g t.outputFile; if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile ) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index 90cf441..e55b17c 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -1,21 +1,18 @@ let () = Random.self_init (); type action = string -type udg_proba = - | ConstP of float - | LstP of float list - | LinearP type grid_arg = { mutable width: int; mutable height: int; } -type udg_arg = { +type qudg_arg = { mutable width: float; mutable height: float; mutable radius: float; - mutable proba: udg_proba; + mutable r1: float; + mutable p: float; } type er_prob = float (*between 0 and 1*) @@ -31,7 +28,7 @@ type t = { mutable grid : grid_arg; mutable er : er_prob; mutable ba : ba_m; - mutable udg : udg_arg; + mutable qudg : qudg_arg; mutable silent : bool; @@ -72,11 +69,12 @@ let (make_args : unit -> t) = }; er = 0.3; ba = 2; - udg = { + qudg = { width = 10.; height = 10.; - radius = 2.; - proba = ConstP 1.; + radius = 3.; + r1 = 2.; + p = 0.5; }; silent = false; @@ -140,6 +138,7 @@ let help args tool = ( ("BA",[(["Generate a graph using the Barabasi–Albert algo"],"")]); ("tree",[(["Generate an acyclic graph (tree)"],"")]); ("UDG",[(["Generate a graph using the Unit Disc Graph algo"],"")]); + ("QUDG",[(["Generate a graph using the Quasi UDG algo"],"")]); ]; Printf.printf "\n"; Printf.printf "Use '%s -h' to see the command's options.\n" tool; @@ -191,7 +190,7 @@ let (mkoptab : string array -> t -> unit) = | "grid" | "HC" | "void" -> unexpected "-n" | _ -> args.n <- n )) [([msg],"clique");([msg],"star");([msg],"ring"); - ([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG")]; + ([msg],"ER");([msg],"BA");([msg],"tree");([msg],"UDG");([msg],"QUDG")]; mkopt args ["--dimension";"-d"] ~arg:" " (Arg.Int (fun n -> match args.action with @@ -202,18 +201,20 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--width";"-w"] ~arg:" " (Arg.Float (fun w -> match args.action with | "grid" -> args.grid.width <- (int_of_float w) - | "UDG" -> args.udg.width <- w + | "UDG" | "QUDG" -> args.qudg.width <- w | _ -> unexpected "-w" )) [(["Set the grid's width to the value (integer)\n"],"grid"); - (["Set the UDG's terrain width to the value (float)";"10 by default.\n"],"UDG")]; + (["Set the UDG's terrain width to the value (float)";"10 by default.\n"],"UDG"); + (["Set the QUDG's terrain width to the value (float)";"10 by default.\n"],"QUDG")]; mkopt args ["--height";"-he"] ~arg:" " (Arg.Float (fun h -> match args.action with | "grid" -> args.grid.height <- (int_of_float h) - | "UDG" -> args.udg.height <- h + | "UDG" | "QUDG" -> args.qudg.height <- h | _ -> unexpected "-he")) [(["Set the grid's height to the value (integer)\n"],"grid"); - (["Set the UDG's terrain height to the value (float)";"10 by default.\n"],"UDG")]; + (["Set the UDG's terrain height to the value (float)";"10 by default.\n"],"UDG"); + (["Set the QUDG's terrain height to the value (float)";"10 by default.\n"],"QUDG")]; mkopt args ["--edge-probability";"-p"]~arg:" " @@ -233,55 +234,51 @@ let (mkoptab : string array -> t -> unit) = mkopt args ["--radius";"-r"]~arg:" " (Arg.Float (fun r -> match args.action with - | "UDG" -> args.udg.radius <- r + | "UDG" -> args.qudg.radius <- r | _ -> unexpected "-r")) - [(["Set the Unit Disc's radius around a node to the given value.";"3 by default.\n"],"UDG")]; - - mkopt args ["--prob-from-constant";"-pc"] ~arg:" " - (Arg.Float (fun i -> args.udg.proba <- ConstP i)) - [(["Uses a probability function for UDG that always return the probability given in argument."; - "This probability function will be used to know if an edge will be created when"; - "two Unit Discs touch each other."; - "By default, the probability function is '-pc 1' (which is also the usual UDG).\n"], "UDG")]; - - mkopt args ["--prob-from-list";"-pl"] ~arg:" ..." - (Arg.Unit (fun () -> args.udg.proba <- LstP [])) - [([ - "Create a probability function for UDG that changes the probability according to the distance."; - "It divides the Unit Disc into multiple discs (as much as the number of arguments),"; - "and assign a probability to each disc."; - "The arguments taken in account are the actual arguments of the command, and should be floats.\n" - ], "UDG")]; - - mkopt args ["--progressive-prob";"-pp"] - (Arg.Unit (fun () -> args.udg.proba <- LinearP)) - [(["Uses a probability function for UDG that change probability according to the distance from the center,"; - "using a linear function. Lower the distance is, greater the probability is."; - "This probability function will be used to know if an edge will be created when"; - "two Unit Discs touch each other.\n" - ], "UDG")]; - - (* [linear_proba r] gives a function that, for an input d (distance) outputs d/r. - If r is the Unit Disc radius and d the distance between two points, - it outputs a probability that is higher for a low d and lower for a high d. *) + [(["Set the Unit Disc's radius around all nodes to the given value.";"3 by default.\n"],"UDG")]; + + mkopt args ["--first-radius";"-r0"]~arg:" " + (Arg.Float (fun r -> match args.action with + | "QUDG" -> args.qudg.radius <- r + | _ -> unexpected "-r0")) + [(["Set the first radius around all nodes to the given value.";"3 by default.\n"],"QUDG")]; + + mkopt args ["--second-radius";"-r1"]~arg:" " + (Arg.Float (fun r -> match args.action with + | "QUDG" -> args.qudg.r1 <- r + | _ -> unexpected "-r1")) + [(["Set the second radius around all nodes to the given value.";"2 by default.\n"],"QUDG")]; + + mkopt args ["--probability";"-p"]~arg:" " + (Arg.Float (fun p -> args.qudg.p <- p)) + [(["Sets the probability of the nodes being neighbors when they are inside the second"; + "radius, but not the first one.\n" + ], "QUDG")]; - mkopt args ["--dot_udg";"-du"]~arg:" " + let msg = ["Create a DOT file to visualize the UDG plan."; + "When it transformed into a PDF that takes the positioning tags into account"; + "(like 'neato' command from GraphViz), each node is visible at the coordinates"; + "where they were placed during execution.\n"] in + mkopt args ["--dot_udg";"-du"]~arg:" " (Arg.String (fun f -> match args.action with - | "UDG" -> args.dotUDG <- f + | "UDG" | "QUDG" -> args.dotUDG <- f | _ -> unexpected "-du")) - [(["Create a DOT file to visualize the UDG plan."; - "The extension .dot will be added to the file base-name.\n"],"UDG")]; + [(msg,"UDG");(msg,"QUDG")]; - mkopt args ["--dot_udg_radius";"-dur"]~arg:" " + mkopt args ["--dot_udg_radius";"-dur"]~arg:" " (Arg.String (fun f -> match args.action with - | "UDG" -> args.dotUDGrad <- f + | "UDG" | "QUDG" -> args.dotUDGrad <- f | _ -> unexpected "-dur")) [(["Create a DOT file to visualize the UDG plan."; - "The extension .dot will be added to the file base-name.\n"],"UDG")]; + "Same as the option '-du', but with the radius being also displayed.\n"],"UDG"); + (["Create a DOT file to visualize the UDG plan."; + "Same as the option '-du', but with the two radiuses being also displayed.\n"],"QUDG")]; mkopt args ["--silent";"-s"] (Arg.Unit (fun () -> args.silent <- true)) - [(["Remove all outputs, except ones made by other options.\n"],"void")]; + [(["Remove all outputs, except the dot output if it is on stdout,"; + "and the error if one occurred.\n"],"void")]; mkopt args ["--help";"-h"] (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" @@ -302,7 +299,7 @@ let parse argv = ( mkoptab argv args; try ( (if (Array.length argv) = 1 then (print_usage stdout true argv.(0); exit 1 (* no command or invalid command *))); - let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG"] in + let possible_actions = ["clique";"star";"ring";"grid";"HC";"ER";"BA";"tree";"UDG";"QUDG"] in ( if (List.mem argv.(1) possible_actions) then args.action <- argv.(1) else @@ -313,21 +310,7 @@ let parse argv = ( Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); current := save_current; - (List.iter - (fun f -> - if (String.sub f 0 1 = "-") then ( - unexpected f - ) else ( - match args.action with - | "UDG" -> ( - match args.udg.proba with - | LstP l -> args.udg.proba <- LstP ((float_of_string f)::l) - | _ -> unexpected f - ) - | _ -> unexpected f - ) - ) (List.rev args._others) - ); + if (List.length args._others) <> 0 then unexpected (List.hd args._others); args ) with diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index 06260c3..ec4612a 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -1,16 +1,16 @@ type action = string -type udg_proba = | ConstP of float | LstP of float list | LinearP type grid_arg = { mutable width: int; mutable height: int; } -type udg_arg = { +type qudg_arg = { mutable width: float; mutable height: float; mutable radius: float; - mutable proba: udg_proba; + mutable r1: float; + mutable p: float; } type er_prob = float (*between 0 and 1*) @@ -26,7 +26,7 @@ type t = { mutable grid : grid_arg; mutable er : er_prob; mutable ba : ba_m; - mutable udg : udg_arg; + mutable qudg : qudg_arg; mutable silent : bool; diff --git a/tools/graphgen/randomGraph.ml b/tools/graphgen/randomGraph.ml index 51927e9..1fb625a 100644 --- a/tools/graphgen/randomGraph.ml +++ b/tools/graphgen/randomGraph.ml @@ -118,7 +118,6 @@ let (rand_tree: int -> Topology.t) = type node_udg = node_id*float*float type plan_udg = node_udg list -type prob_udg = (float -> float) let (make_plan_udg: node_id list -> float -> float -> plan_udg) = fun nodes x y -> @@ -129,32 +128,30 @@ let (dist_udg: node_udg -> node_udg -> float) = let (_,x1,y1) = n1 and (_,x2,y2) = n2 in sqrt (((x1-.x2)**2.) +. ((y1 -. y2)**2.)) -let (rand_udg: prob_udg -> float -> bool) = - fun f d -> - (f d>= Random.float 1.) - -let (gen_udg: ?p:prob_udg -> int -> float -> float -> float -> (Topology.t * plan_udg)) = - fun ?(p=(fun _ -> 1.)) nb x y r -> +let gen_qudg : (int -> float -> float -> float -> float -> float -> (Topology.t * plan_udg)) = + fun nb x y r0 r1 p -> let (node_succ:node_succ_t) = Hashtbl.create nb and nodes = create_nodes "p" (0,nb) in let pl = (make_plan_udg nodes x y) in - List.iter (fun node -> - let nodeu = List.fold_left (fun acc elem -> - let (no,_,_) = elem in - if no = node then elem else acc - ) (List.hd pl) (pl) in + List.iter (fun n_udg -> + let (node, _, _) = n_udg in List.iter (fun elem -> - let (n,_,_) = elem and dist = dist_udg nodeu elem in - if ((dist <= 2.*.r) && node <> n) then - ( - let d = if (dist >= r) then (dist -. r) else dist in - (if (rand_udg p d) then - Hashtbl.replace node_succ node ((None,n)::(try Hashtbl.find node_succ node with Not_found -> []))) + let (n,_,_) = elem and dist = dist_udg n_udg elem in + + if node <> n && (dist <= r0 || (dist <= r1 && Random.float 1. <= p)) + (* e.q. if the node is : (within the radius r0) + or : (within the radius r1, with a brobability of p) *) + then ( + Hashtbl.replace node_succ node + ((None,n)::(try Hashtbl.find node_succ node with Not_found -> [])) ) ) pl - ) nodes; + ) pl; let nl = id_to_empty_nodes nodes in { nodes = nl; succ =(fun n -> (try Hashtbl.find node_succ n with Not_found -> [])); of_id = get_of_id nl },pl + +let gen_udg : (int -> float -> float -> float -> (Topology.t * plan_udg)) = + fun nb x y r -> (gen_qudg nb x y r 0. 0.) \ No newline at end of file diff --git a/tools/graphgen/randomGraph.mli b/tools/graphgen/randomGraph.mli index 99dc188..85d6476 100644 --- a/tools/graphgen/randomGraph.mli +++ b/tools/graphgen/randomGraph.mli @@ -4,10 +4,6 @@ type probability = float (*between 0 and 1*) type node_udg = node_id*float*float type plan_udg = node_udg list -type prob_udg = (float -> probability) -(* if p is of type prob_udg, then for a distance d between two UDG nodes, -[p d] should give the probability of having an edge between the UDG nodes. *) - (** [gen_ER n p] generate a graph using Erdos Renyi model, of n nodes and of probability p for each possible edge to appear. *) @@ -23,10 +19,16 @@ val gen_BA : (int -> int -> Topology.t) (** [rand_tree n] generate a random tree of n nodes *) val rand_tree: (int -> Topology.t) -(** [gen_udg ~p n w h r] generate a graph using Unit Disc Graph model of n nodes. +(** [gen_udg nb x y r] generate a graph using the Unit Disc Graph model, of n nodes. w and h are the width and the height of the area in which the nodes are randomly disposed, - and r is the Unit Disc radius. - If two Unit Discs from different nodes touch themselves, - p will be run to obtain the probability of an edge appearing between these nodes. - p is (fun _ -> 1) by default, which means that the edge will appear if the Unit Discs of two nodes touch themselves.*) -val gen_udg: (?p:prob_udg -> int -> float -> float -> float -> (Topology.t * plan_udg)) + and r is the radius around each node, in which all the other nodes will be neighbors. + *) +val gen_udg : (int -> float -> float -> float -> (Topology.t * plan_udg)) + +(** [gen_qudg nb x y r0 r1 p] generate a graph using the Quasi Unit Disc Graph model, of n nodes. + w and h are the width and the height of the area in which the nodes are randomly disposed. + r0, r1 and p are three values to determine if two nodes, at a distance d of each other, + are neighbors. If d <= r0, they are neighbors. Otherwise, if d <= r1, + they have a probability of p of being neighbors. + *) +val gen_qudg: (int -> float -> float -> float -> float -> float -> (Topology.t * plan_udg)) diff --git a/tools/graphgen/udgUtils.ml b/tools/graphgen/udgUtils.ml index 9e25030..8dd52f8 100644 --- a/tools/graphgen/udgUtils.ml +++ b/tools/graphgen/udgUtils.ml @@ -32,22 +32,25 @@ let compute_mean_degree : (int -> float -> float -> float -> float) = (******************************************************************************) -let rec make_nodes_dot_udg : (node_udg list -> float -> string) = +let rec make_nodes_dot_udg : (node_udg list -> float -> float -> string) = (*Create a string in the dot syntax from a node list*) - fun nudg r -> + fun nudg r0 r1 -> match nudg with | [] -> "" | head::tail -> let (node,x,y) = head in (Printf.sprintf "%s [pos=\"%f,%f!\"]\n" node x y )^ - let draw_rad = if(r <> -1.) then + let draw_rad = (if (r0 > 0.) then (Printf.sprintf "%srad [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"red\"]\n" - node x y (2.*.r) (2.*.r) ) else "" in - draw_rad^(make_nodes_dot_udg tail r) + node x y (2.*.r0) (2.*.r0) ) else "")^ + if(r1 > r0) then + (Printf.sprintf "%srad2 [pos=\"%f,%f!\",width=%f, length=%f,shape = circle,label=\"\",color=\"lightblue\"]\n" + node x y (2.*.r1) (2.*.r1) ) else "" in + draw_rad^(make_nodes_dot_udg tail r0 r1) -let make_dot_udg : (Topology.t -> plan_udg -> (float*float) -> ?r:float -> string -> unit) = +let make_dot_udg_qudg : (Topology.t -> plan_udg -> (float*float) -> ?r0:float -> ?r1:float -> string -> unit) = (*Create a dot file from a graph*) - fun t plan dim ?(r = -1.) file_name -> + fun t plan dim ?(r0 = 0.) ?(r1 = 0.) file_name -> let name = ref "graph0" in (* default name *) let f = (if file_name = "" then stdout else ( @@ -61,13 +64,11 @@ let make_dot_udg : (Topology.t -> plan_udg -> (float*float) -> ?r:float -> stri ) ) in let (w,l) = dim in - let mpos = if(r <> -1.) then + let mpos = if(r0 > 0. || r1 > 0.) then (Printf.sprintf "size = \"%f,%f!\"\ntopLeft [pos=\"%f,%f!\",style=invis]\nlowRight [pos=\"0,0!\",style = invis]\nnode [fixedsize=false,shape=circle]\n" w l w l) else "" in let dot = (Printf.sprintf "graph %s {\n\n"!name )^mpos - - - ^(make_nodes_dot_udg plan r) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in + ^(make_nodes_dot_udg plan r0 r1) ^ "\n" ^ (make_links_dot t) ^ "\n}\n" in Printf.fprintf f "%s" dot; flush f; close_out f diff --git a/tools/graphgen/udgUtils.mli b/tools/graphgen/udgUtils.mli index b34f0c8..df43f39 100644 --- a/tools/graphgen/udgUtils.mli +++ b/tools/graphgen/udgUtils.mli @@ -40,4 +40,4 @@ val compute_mean_degree : (int -> float -> float -> float -> float) and (h,w) being the dimensions of the plan. If no radius is given, they won't appear on the pdf. If you have Grahviz, we advice using 'twopi -Tpdf f' to obtain a pdf. *) -val make_dot_udg : (Topology.t -> plan_udg -> (float*float) -> ?r:float -> string -> unit) +val make_dot_udg_qudg : (Topology.t -> plan_udg -> (float*float) -> ?r0:float -> ?r1:float -> string -> unit) diff --git a/tools/scriptEnv.py b/tools/scriptEnv.py index 2172dca..1e435bf 100644 --- a/tools/scriptEnv.py +++ b/tools/scriptEnv.py @@ -1,92 +1,100 @@ import subprocess, os, datetime -def genGraph(graphType: str, outputFile: str, graphProperties: dict, is_silent: bool = False): - """Generate a graph, using gg (GraphGen), and outputs it in a DOT file +def call(command, log = None, verb = 2, options = {}): + """Calls the shell command given in argument, and give its output in stdout as return value - It also removes any '.lut' file at the name of the outputFile + If the command fails (command return value other than 0), the command's stdout is printed, and + the error 'subprocess.CalledProcessError' is raised. - Args: - graphType (str): The type of graph. It correspond to the command used in 'gg ' - The list of possible values are at the end of this docstring. - - outputFile (str): The file in which the graph will be written. - We strongly advise to have '.dot' extension - - graphProperties (dict): The properties of the graph. They should be in a dictionary, - with the name of the property as key and the argument as value. - An empty string will be considered as no argument. - - is_silent (bool, optional): Indicates whether the call of gg will be silent or not. - If it is, all the outputs on stdout will be removed, - except for errors (or if '-h' is specified). - - Return: the return value of the gg command - - - Possible values for graphType and their properties : - "clique" -> a graph where all the nodes are neighbors of each other - proprieties : - --- 'n' (int) : node number - "star" -> a graph where all the nodes are connected to one node (usually called 'root') - proprieties : - --- 'n' (int) : node number - "ring" -> (also called cycle graph) a graph composed of a single cycle - proprieties : - --- 'n' (int) : node number - "grid" -> a squared grid graph - proprieties : - --- 'w' and 'he' (int) : the width and the height of the grid - "HC" -> a hypercube - proprieties : - --- 'd' (int) : the hypercube dimension - "ER" -> a graph created using the Erdos Renyi algo - proprieties : - --- 'n' (int) : node number - --- 'p' (float) : the probability of each edge (between 0 and 1) - "BA" -> a graph created using the Barabasi–Albert algo - proprieties : - --- 'n' (int) : node number - --- 'm' (float) : the number of edge generated per additional node - "tree" -> a tree graph - proprieties : - --- 'n' (int) : node number - "UDG" -> a graph created using the Unit Disc Graph algo - proprieties : - --- 'n' (int) : node number - --- 'w' and 'he' (float) : the width and the height of the UDG's terrain - --- 'r' (float) : the Unit Disc's radius (detection radius around each node) - --- 'du'/'dur' (string) : create a DOT file (and a PDF if Graphvis is installed) - to visualize the UDG graph (use dur to visualize radius). - Do not put any extension in the string - (they will be added automatically) + Optional Args : + log (filename): a log file, in which the command's stdout will be appended + verb (int): the verbose level. It has three levels : 0,1 or 2. + On level 0, nothing will be printed excepted the raised error + On level 1, if there's an error, the command's stdout will be printed. + On level 2 (default), a message will tell when the command is called, + and when it has finished. + On level 3, the command's stdout will always be printed + options (dict): a way to add options in the command line. Each key of the dict will + be added to the command line with an additional "-" in front, followed by the + corresponding value in the dict. For example, {"n":3, "o":"toto.ml"} will add the + string '-n "3" -o "toto.ml"' to the command line. + + Return (str) : the output of the command + + Note : the module subprocess is used to call the command """ - args = ["gg", graphType, "-o", outputFile] + if verb > 1 : + print("Calling '"+command.split()[0]+"' ...") - for key in graphProperties: - if (key[0] != "-"): - args.append("-"+key) + for k in options: + if options[k] == "" : + command += " -"+k else : - args.append(str(key)) + command += " -"+k+' "'+str(options[k])+'"' + + try: + output = subprocess.check_output( + command, shell=True, stderr=subprocess.STDOUT, encoding = "utf-8") + except subprocess.CalledProcessError as exc: + if log != None: + f = open(log, "a+") + f.write(exc.output) + if verb > 2 : + print("------ output : ------") + if verb > 0 : + print(exc.output) + if verb > 2 : + print("----------------------") + raise + + if log != None: + f = open(log, "a+") + f.write(output) + if verb > 2 : + print("------ output : ------") + print(output) + print("----------------------") + if verb > 1 : + print("Done.") + return output + +def genGraph(graphType, outputFile, options, is_silent = False, log = None, verb = 2): + """Generate a graph, using the 'call' function on the command 'gg'. + + It also removes any '.lut' file at the name of the outputFile + + Args: + graphType (str): The first argument given to 'gg', corresponding to the command in 'gg '. + Use 'gg -h' in console to view the avaible commands (corresponding to avaible graphTypes). + outputFile (str): The output file given to 'gg' with the option '-o'. + We strongly advice to give it a '.dot' extension + graphProperties (dict): options given to 'call' function. + is_silent (bool, optional): Indicates whether the option '-s' will be added to the command line or not. + log (str) : the log file given to 'call' + verb (int) : the verbose level given to 'call' + + Return (str): the output of the 'gg' command - if (graphProperties[key] != ""): - args.append(str(graphProperties[key])) + """ + + args = "gg " + graphType + ' -o "' + outputFile + '"' if is_silent: - args.append("-s") + args += "-s" - ret = subprocess.call(args) + ret = call(args, log, verb, options) try : os.remove(outputFile[0:-3]+"lut") - except FileNotFoundError as e: # [Errno 2] No such file or directory: '' + except FileNotFoundError as e: pass return ret def compileAlgos(fileList): - """Compile an iterable object of .ml files into .cmxs files, - or compile the .ml files of a string in the algo-files syntax supported by gg-deco""" + """Compile an iterable object (like lists or sets) of .ml files into .cmxs files, + or compile the .ml files of a string in the algo-files syntax supported by gg-deco.""" if type(fileList) == str : tmp = fileList fileList = [] @@ -98,11 +106,12 @@ def compileAlgos(fileList): return ret def decoGraph(inputFile: str, decoration, outputFile:str = "", comp = True): - """Decorate a graph, using gg-deco, to add an algo or change the algo of each node + """Decorate a graph, using the 'call' function on the command 'gg-deco' Args : inputFile (str) : the DOT file to decorate - decoration : a string, list or a dictionary describing the + decoration : a string, list or a dictionary describing the files of each node. + If it is a string, it will be given as it is to gg-deco outputFile (str, optional) : The name for the decorated DOT file. Same as the inputFile by default. comp (bool, optional) : If True, runs 'compileAlgo' on decoration @@ -172,7 +181,7 @@ def callSasa(topologyFile, length = 200, seed = None, daemon = "dd", rif = True) return subprocess.check_output(commandLine, stderr=subprocess.STDOUT, encoding = "utf-8") -def parseRif(rif:str): +def parseRif(rif): """ Parse a rif document made by a sasa call (from sasa's stdout or output file) Return : a tuple of two elements : @@ -229,7 +238,7 @@ def parseRif(rif:str): return (names,states) -def column(i, matrix:list, names:list = None): +def column(i, matrix, names = None): """Outputs a list with the elements of a column in the matrix. If names is not specified, outputs the column i of the matrix @@ -241,60 +250,6 @@ def column(i, matrix:list, names:list = None): if names != None : i = names.index(i) return [x[i] for x in matrix] -def call(command, log = None, verb = 2, options = {}): - """Calls the shell command given in argument, and give its output in stdout as return value - - If the command fails (command return value other than 0), the command's stdout is printed, and - the error 'subprocess.CalledProcessError' is raised. - - Optional Args : - log (filename): a log file, in which the command's stdout will be appended - verb (int): the verbose level. It has three levels : 0,1 or 2. - On level 0, nothing will be printed excepted the raised error - On level 1, if there's an error, the command's stdout will be printed. - On level 2 (default), a message will tell when the command is called, - and when it has finished. - On level 3, the command's stdout will always be printed - options (dict): a way to add options in the command line. Each key of the dict will - be added to the command line with an additional "-" in front, followed by the - corresponding value in the dict. For example, {"n":3, "o":"toto.ml"} will add the - string "-n 3 -o toto.ml" to the command line. - - """ - - if verb > 1 : - print("Calling '"+command.split()[0]+"' ...") - - for k in options: - command += " -"+k+" "+str(options[k]) - - try: - output = subprocess.check_output( - command, shell=True, stderr=subprocess.STDOUT, encoding = "utf-8") - except subprocess.CalledProcessError as exc: - if log != None: - f = open(log, "a+") - f.write(exc.output) - if verb > 2 : - print("------ output : ------") - if verb > 0 : - print(exc.output) - if verb > 2 : - print("----------------------") - raise - - if log != None: - f = open(log, "a+") - f.write(output) - if verb > 2 : - print("------ output : ------") - print(output) - print("----------------------") - if verb > 1 : - print("Done.") - return output - - class Project: """Manage files of a project, to keep traces of a test battery. Inside a project directory, there will be a directory for each version -- GitLab From 6c71abe3cc3646e027f6c6f2da74fb2ecc6be08b Mon Sep 17 00:00:00 2001 From: Gwennan Eliezer Date: Mon, 15 Jul 2019 09:37:02 +0200 Subject: [PATCH 16/16] Added graph attributes to gg (need to merge with master or 3! for the end) --- tools/ggDeco/ggDeco.ml | 2 +- tools/graphgen/graphGen.ml | 41 ++++++++++++++- tools/graphgen/graphGen_arg.ml | 27 +++++++++- tools/graphgen/graphGen_arg.mli | 2 + tools/scriptEnv.py | 90 ++++++++++++++++++++++----------- 5 files changed, 129 insertions(+), 33 deletions(-) diff --git a/tools/ggDeco/ggDeco.ml b/tools/ggDeco/ggDeco.ml index 8758f29..7803c51 100644 --- a/tools/ggDeco/ggDeco.ml +++ b/tools/ggDeco/ggDeco.ml @@ -55,5 +55,5 @@ let () = ( let args = parse Sys.argv in let g = read args.dot_file in let new_g = deco g args.files_spec in - make_dot new_g args.output + make_dot new_g args.output attr ) diff --git a/tools/graphgen/graphGen.ml b/tools/graphgen/graphGen.ml index 5eb5240..ae66f15 100644 --- a/tools/graphgen/graphGen.ml +++ b/tools/graphgen/graphGen.ml @@ -1,10 +1,18 @@ -open Sasacore.Topology +open Sasacore +open Topology +open GraphProp open ClassicGraph open RandomGraph open GraphGen_arg open UdgUtils +exception Incorrect_attribute + +let min_max = ref None +let connected_cyclic = ref None +let height = ref None + let generate_du_dur graph plan_udg t : unit = if (t.dotUDG <> "") then ( @@ -15,6 +23,35 @@ let generate_du_dur graph plan_udg t : unit = ); () +let compute_attr : (Topology.t -> string list -> (string*string) list) = + fun g -> List.map (fun attr -> + attr,match attr with + | "min_deg" -> string_of_int (match !min_max with + | None -> (let x = get_degree g in min_max := Some x; fst x) + | Some x -> fst x) + | "mean_deg" -> string_of_float (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 false) + | "diameter" -> string_of_int (get_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)) + else raise Incorrect_attribute) + ) + + + let () = ( let t = parse Sys.argv in @@ -54,7 +91,7 @@ let () = ( | _ -> (Printf.fprintf stderr "Unexpected outcome. Command line : %s\n" (String.concat " " (Array.to_list Sys.argv)); assert false) ) in - make_dot g t.outputFile; + make_dot g t.outputFile (compute_attr g t.attr); if (t.outputFile <> "" && not t.silent) then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile ) diff --git a/tools/graphgen/graphGen_arg.ml b/tools/graphgen/graphGen_arg.ml index e55b17c..215579a 100644 --- a/tools/graphgen/graphGen_arg.ml +++ b/tools/graphgen/graphGen_arg.ml @@ -30,6 +30,8 @@ type t = { mutable ba : ba_m; mutable qudg : qudg_arg; + mutable attr : string list; + mutable silent : bool; mutable _args : (string * Arg.spec * string) list; @@ -77,6 +79,8 @@ let (make_args : unit -> t) = p = 0.5; }; + attr = []; + silent = false; _args = []; @@ -280,6 +284,13 @@ let (mkoptab : string array -> t -> unit) = [(["Remove all outputs, except the dot output if it is on stdout,"; "and the error if one occurred.\n"],"void")]; + args._man <- ("--attributes, -atr ...", [([ + "Specify the given attributes of the graph to his DOT file."; + "the possible attributes are :"; + "min_deg, mean_deg, max_deg, is_connected, is_cyclic, is_tree, links_number, + diameter, height i (with i being the index of a node)" + ],"void")])::args._man; + mkopt args ["--help";"-h"] (Arg.Unit (fun () -> help args ((argv.(0))^(if args.action = "void" then "" else " "^args.action)))) @@ -310,7 +321,21 @@ let parse argv = ( Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg false (argv.(0)^argv.(1))); current := save_current; - if (List.length args._others) <> 0 then unexpected (List.hd args._others); + args._others <- List.rev args._others; + let have_atr = ref false in + (List.iter (fun o -> + if !have_atr then ( + if (String.sub o 0 1) = "-" then + unexpected o + else + args.attr <- o::args.attr + ) else ( + if List.mem o ["--attributes";"-atr"] then + have_atr := true + else + unexpected o + ) + ) args._others); args ) with diff --git a/tools/graphgen/graphGen_arg.mli b/tools/graphgen/graphGen_arg.mli index ec4612a..70eda6d 100644 --- a/tools/graphgen/graphGen_arg.mli +++ b/tools/graphgen/graphGen_arg.mli @@ -28,6 +28,8 @@ type t = { mutable ba : ba_m; mutable qudg : qudg_arg; + mutable attr : string list; + mutable silent : bool; mutable _args : (string * Arg.spec * string) list; diff --git a/tools/scriptEnv.py b/tools/scriptEnv.py index 1e435bf..c3028db 100644 --- a/tools/scriptEnv.py +++ b/tools/scriptEnv.py @@ -1,4 +1,4 @@ -import subprocess, os, datetime +import subprocess, os, datetime, math def call(command, log = None, verb = 2, options = {}): """Calls the shell command given in argument, and give its output in stdout as return value @@ -67,7 +67,7 @@ def genGraph(graphType, outputFile, options, is_silent = False, log = None, verb Args: graphType (str): The first argument given to 'gg', corresponding to the command in 'gg '. - Use 'gg -h' in console to view the avaible commands (corresponding to avaible graphTypes). + Use 'gg -h' in console to view the available commands (corresponding to available graphTypes). outputFile (str): The output file given to 'gg' with the option '-o'. We strongly advice to give it a '.dot' extension graphProperties (dict): options given to 'call' function. @@ -250,49 +250,57 @@ def column(i, matrix, names = None): if names != None : i = names.index(i) return [x[i] for x in matrix] -class Project: +class FileManager: """Manage files of a project, to keep traces of a test battery. Inside a project directory, there will be a directory for each version (i.e. for each creation of a Project object). + + Proprieties : + path (str) : the path to the current version """ - def __init__(self, projectName = "sasaProject", date = True, time = True): + def __init__(self, projectName = "sasaProject", version_name = "", date = True, time = True, add_index = True): """Initialize a version of the project. Args : projectName (str) : The name of the project, in which a new version will be created. - date (bool, optional) : indicates if the version's name will contain the date - time (bool, optional) : indicates if the version's name will contain the time - - Note : if an old version has the same name as the new one, a number will be added to the new - version's name. + version_name (str, optional) : indicates the version's name base name + date (bool, optional) : indicates if the version's name will contain the date after the base name + time (bool, optional) : indicates if the version's name will contain the time after the date or base name + add_index (bool, optional) : indicates if the version's name will contain an index if a version of the same + name already exists (to ensure not to mix an old version with the new one). """ - self.name = projectName - identifyer = "" + self.name = projectName # the name of the project + version = version_name now = str(datetime.datetime.now()).split() + if version_name == "" and date: + version += "_" if date: - identifyer += now[0] + version += now[0] if date and time: - identifyer += "_" + version += "_" if time: - identifyer += now[1].split(".")[0] + version += now[1].split(".")[0] try: os.makedirs(projectName) except FileExistsError: pass - if os.path.exists(projectName+"/"+identifyer) : + if os.path.exists(projectName+"/"+version) and add_index : i = 0 - while os.path.exists(projectName+"/"+identifyer+"_"+str(i)):i += 1 - identifyer += "_"+str(i) + while os.path.exists(projectName+"/"+version+"_"+str(i)):i += 1 + version += "_"+str(i) - os.makedirs(projectName+"/"+identifyer) - self.identifyer = identifyer - self.path = projectName+"/"+identifyer+"/" - self.folders = [] + try : + os.makedirs(projectName+"/"+version) + except FileExistsError: + if add_index : raise + + self.version = version # the name of the version + self.path = projectName+"/"+version+"/" # the path to the version def createDir (self, dir): """Creates the directory dir in the current version if it doesn't exist. @@ -309,8 +317,8 @@ class Project: except FileExistsError: return False - def open(self, dir, name, ext): - """Opens a new file in the directory dir of the current version. + def open(self, dir, name, ext, openType = 'w+', add_index = True): + """Use the built-in function open() to open a file in the directory 'dir' of the current version. The actual name of the file is 'name_i.ext', with name and ext being the arguments of the same name, and i being the lower number such as no other file has the same name. @@ -319,9 +327,15 @@ class Project: dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. name (str) : the name of the file, without extension. ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + openType (str, optional) : the second argument given to the built-in function open(). + Note that if add_index is set to False and the file already exists, + 'w'/'w+' will overwrite the file, whereas 'a'/'a+' and 'r' will not. + add_index (bool, optional) : indicates if an index will be given to the file's name. + Set it to True if you want to ensure that the opened file is a new file. + Return value : - The opened file (same as "open(path)") if getIndex is False + The opened file (same as "open(path)") """ @@ -337,7 +351,7 @@ class Project: return f - def add_file(self, dir, name, ext, content = ""): + def add_file(self, dir, name, ext, content = "", add_index = True): """Creates a new file in the directory dir of the current version. The actual name of the file is 'name_i.ext', with name and ext being the arguments of the same name, @@ -346,8 +360,11 @@ class Project: Args : dir (str) : the name of the directory in which the file will be created. Creates it if it doesn't exists. name (str) : the name of the file, without extension. - ext (str) : the extension of the file. If it doesn't start by a point ('.'), it will be added. + ext (str) : the extension of the file. content (str, optional) : a string that will be added automatically to the file on creation. + add_index (bool, optional) : indicates if an index will be given to the file's name. + Set it to True if you want to ensure that no file of the same name + is overwritten on creation. Return value : The path to the created file @@ -356,7 +373,7 @@ class Project: self.createDir(dir) i = 0 path = self.path + dir + "/" + name - if ext != "" and ext[0] != ".": ext = "."+ext + #if ext != "" and ext[0] != ".": ext = "."+ext while os.path.exists(path + "_" + str(i) + ext):i += 1 path += "_"+str(i)+ ext @@ -369,7 +386,8 @@ class Project: return path def open_i(self, i, dir, name, ext, openType = 'a'): - """Opens a file in dir with the name 'name_i.ext'. + """Opens a file in dir with the name 'name_i.ext'. + (The point between 'i' and 'ext' is for readability, and is not added by the method.) Note : Use it to modify a file created previously, not to create a file at index i unless you are sure of what you are doing @@ -384,8 +402,13 @@ class Project: self.createDir(dir) return open(self.path + dir + "/" + name + "_" + str(i) + ext, openType) + def read_i(self, i, dir, name, ext): + f = open_i(self, i, dir, name, ext, "r") + return f.read() + def exist_i(self, i, dir, name, ext): - """Checks if the file 'name_i.ext' exists in dir.""" + """Checks if the file 'name_i.ext' exists in dir. + (The point between 'i' and 'ext' is for readability, and is not added by the method.)""" return os.path.exists(self.path + dir + "/" + name + "_" + str(i) + ext) @@ -405,3 +428,12 @@ class Project: i = 0 while os.path.exists(self.path + dir + "/" + name + "_" + str(i) + ext): i += 1 return i - 1 + +class UDGtools(object): + """A set of tools to use UDG""" + @property # so that UDGtools() gives an error + def __init__(self):pass + + @staticmethod + def getRadius(n, h, w, md): + math.sqrt(h * w * md / (math.pi * n)) -- GitLab