Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

clean up #7

Merged
merged 5 commits into from

2 participants

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Jul 2, 2013
  1. @MarwanG

    Removal of all comments

    MarwanG authored
  2. @MarwanG

    arb to spec

    MarwanG authored
  3. @MarwanG

    removed Tests.ml

    MarwanG authored
  4. @MarwanG
  5. @MarwanG

    added types

    MarwanG authored
This page is out of date. Refresh to see the latest.
View
4 src/CombSys.ml
@@ -54,14 +54,10 @@ let evaluation (phi:combsys) (z:float) (y:float array):float array =
let u = Array.create (Array.length y) 0.0 in
for i=0 to ((Array.length y) - 1)
do
- (*print_string ("i=" ^ (string_of_int i)) ;*)
let vali = eval_eq z y phi.(i)
in
- (* print_endline (" vali=" ^ (string_of_float vali)) ;*)
u.(i) <- vali
done;
- (*print_endline ("u = " ^ (Util.string_of_array string_of_float u)) ;*)
- (*print_endline (string_of_float u.(0));*)
u ;;
(* conversion from grammar *)
View
46 src/GParser.ml
@@ -21,7 +21,7 @@ type character =
Char of char
| EOF;;
-let contains s1 s2 =
+let contains (s1:string) (s2:string) =
try
let len = String.length s2 in
for i = 0 to String.length s1 - len do
@@ -34,16 +34,16 @@ let is_space = function
| Char(ch) -> ch == ' ' or ch == '\n' or ch == '\t' or ch == '\r'
| EOF -> false ;;
-let get_char str i =
+let get_char (str:string) (i:int) =
try Char (String.get str i) with
_ -> EOF;;
-let rec skip_spaces str i =
+let rec skip_spaces (str:string) (i:int) =
let ichar = get_char str i in
if is_space ichar then skip_spaces str (i+1)
else i ;;
-let rec skip_until_eol str i =
+let rec skip_until_eol (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> i
@@ -51,7 +51,7 @@ let rec skip_until_eol str i =
if ch='\n' then i+1
else skip_until_eol str (i+1);;
-let rec skip_until_starslash str i =
+let rec skip_until_starslash (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> raise (Parse_Error "Missing end of comment: */")
@@ -64,7 +64,7 @@ let rec skip_until_starslash str i =
(* skip_until_starslash "/* toto titi tata */ tutu" 2 ;; *)
-let rec skip_comments str i =
+let rec skip_comments (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> i
@@ -81,7 +81,7 @@ let rec skip_comments str i =
(* skip_comments "/* toto titi tata */ tutu" 0 ;; *)
-let rec skip str i =
+let rec skip (str:string) (i:int) =
let i' = skip_comments str i in
if not (i'==i) then skip str i'
else i;;
@@ -100,7 +100,7 @@ let string_of_list l =
list_iteri (fun ch i -> String.set str ch i) l ;
str ;;
-let next_word str i =
+let next_word (str:string) (i:int) =
let rec aux i word =
let ichar = get_char str i in
match ichar with
@@ -115,19 +115,17 @@ let next_word str i =
else aux (i+1) (ch::word)
in
let (word,i') = aux (skip str i) [] in
- (* print_endline ("next word = " ^ (string_of_list word)) ; *)
(string_of_list word,i') ;;
-let advance str i expect =
+let advance (str:string) (i:int) (expect:string) =
let (word,i') = next_word str i
in
if word = expect then i'
else raise (Parse_Error ("Missing '" ^ expect ^ "'")) ;;
-let parse_component str i =
+let parse_component (str:string) (i:int) =
let rec aux i weight refs =
let (componentName,i') = next_word str i in
- (* print_endline ("Component name = " ^ componentName) ; *)
if componentName="<z>" then
let (next,i'') = next_word str i' in
(if next="*" then
@@ -152,7 +150,6 @@ let parse_component str i =
else raise (Parse_Error "Expecting '+', ';' or '*'")
else (* component Name is ok *)
let (next,i'') = next_word str i' in
- (* print_endline ("Next = " ^ next) ; *)
if next="+" or next =";" then
((weight,List.rev ((ELEM componentName)::refs)),i')
else if next="*" then
@@ -163,7 +160,7 @@ let parse_component str i =
(* parse_component "<z> * BinNode * BinNode +" 0 ;; *)
-let parse_components str i =
+let parse_components (str:string) (i:int) =
let rec aux i comps =
let (comp,i') = parse_component str i in
let (next,i'') = next_word str i' in
@@ -177,7 +174,7 @@ let parse_components str i =
(* parse_components "Leaf * <z> + BinNode * BinNode ;" 0 ;; *)
-let parse_rule str i =
+let parse_rule (str:string) (i:int) =
let (ruleName,i') = next_word str i in
if ruleName="" then
raise (Parse_Error "Missing rule name")
@@ -190,7 +187,7 @@ let parse_rule str i =
(* parse_rule "BinNode ::= Leaf * <z> + BinNode * BinNode ;" 0 ;; *)
-let parse_int str i =
+let parse_int (str:string) (i:int) =
let int_str, i' = next_word str i
in
try
@@ -199,7 +196,7 @@ let parse_int str i =
(int_val, i')
with Failure _ -> raise (Parse_Error (sprintf "cannot convert '%s' to an integer" int_str))
-let parse_float str i =
+let parse_float (str:string) (i:int) =
let float_str, i' = next_word str i
in
try
@@ -209,7 +206,7 @@ let parse_float str i =
with Failure _ -> raise (Parse_Error (sprintf "cannot convert '%s' to a float" float_str))
-let parse_option str i =
+let parse_option (str:string) (i:int) =
let opt_id, i' = next_word str i
in match opt_id with
| "min" ->
@@ -279,7 +276,7 @@ let parse_option str i =
| _ -> raise (Parse_Error (sprintf "Uknown or unsupported option: %s" opt_id))
-let parse_grammar str =
+let parse_grammar (str:string) =
let rec aux i rules =
match next_word str i with
("",_) -> List.rev rules
@@ -295,7 +292,7 @@ let parse_grammar str =
(* parse_grammar "BinNode ::= Leaf * <z> + BinNode * BinNode;" ;; *)
-let string_of_file fname =
+let string_of_file (fname:string) =
let inchan = open_in fname in
let rec read str =
try let next = input_line inchan in
@@ -304,17 +301,10 @@ let string_of_file fname =
in
read "" ;;
-let parse_from_file fname =
+let parse_from_file (fname:string) =
let input = string_of_file fname in
let grm = parse_grammar input
in
if Options.global_options.verbosity >= 3
then printf "[GEN]: Parsed grammar = %s\n%!" (Grammar.string_of_grammar (List.map (fun (n,l) -> (ELEM n,l)) grm)) ;
grm ;;
-
-(*
-let gram = parse_from_file "examples/binary.arb"
-in
-(print_endline "Grammar parsed = ") ;
-(print_endline (string_of_grammar gram));;
-*)
View
61 src/Gen.ml
@@ -20,6 +20,7 @@ open CombSys
open Grammar
open OracleSimple
+
(* g must be completed
Renvoie une map des poids total de chaque composant (somme des pondération des sous composants)
et une map de la grammaire sous forme de (composant -> liste des (liste des sous_composants * pondération)) *)
@@ -79,11 +80,14 @@ let pondere2 (g:grammar) (y:float array)
in
List.fold_left aux StringMap.empty g_comp
+type 'a queue = 'a Queue.t
+type 'a stack = 'a Stack.t
+
let rec gen_stack_tree
(size:int)
- next_rules current_rules
+ (next_rules: string queue) (current_rules: (string * int) stack)
map
- sizemax
+ (sizemax:int)
leafs =
if size<sizemax then
if (Queue.is_empty next_rules) then
@@ -112,7 +116,6 @@ let rec gen_stack_tree
(fun (l,n) elt ->
match elt with
| SEQ(rul) -> let (_,rdm) = StringMap.find rul map in
-(* print_endline (string_of_float rdm);*)
let n' = int_of_float (floor((log( Random.float 1.)) /. (log rdm))) in
((List.append (concat_n [rul] n') l),(n'+n-1))
| ELEM(rul) -> if(List.exists (fun x -> x = rul) leafs) then
@@ -138,8 +141,8 @@ let rec gen_stack_tree
let rec gen_tree_of_stack_rec
(stack,size)
- current_rules
- with_prefix idprefix =
+ (current_rules: tree queue)
+ (with_prefix:bool) (idprefix:string) =
match (Stack.is_empty stack) with
|true -> ()
|false -> let prefix = if with_prefix then idprefix ^ (string_of_int (size)) else (string_of_int (size)) in
@@ -155,57 +158,13 @@ let rec gen_tree_of_stack_rec
let gen_tree_of_stack
(stack,size)
- with_prefix idprefix =
+ (with_prefix:bool) (idprefix:string) =
let queue = Queue.create () in
match size with
| 0 -> (None,0)
| _ -> gen_tree_of_stack_rec (stack,size) queue with_prefix idprefix;
(Some(Queue.pop queue),size)
-(*
-let rec gen_tree_rec
- (size:int)
- (next_rule:string)
- wmap gmap sizemax with_prefix idprefix
- : (tree option * int) =
- if sizemax-size<=0 then
- (None,sizemax)
- else
- (* On génère la suite de l'arbre *)
- if StringMap.find next_rule wmap = 1.
- (* On doit générer une feuille *)
- then
- let prefix =
- if with_prefix then idprefix ^ (string_of_int (size))
- else (string_of_int (size))
- in
- (Some (Leaf((name_of_elem next_rule),prefix)),size+1)
- else
- (* On doit générer des sous arbres *)
- let prefix =
- if with_prefix then idprefix ^ (string_of_int (size+1))
- else (string_of_int (size+1))
- in
- let rdm_float = Random.float (StringMap.find next_rule wmap) in
- let (_,_,next_rules_list) =
- List.fold_left
- (fun (limit,stop,temp) (l,f) -> if limit-.f<=0. && stop then (limit,false,l) else (limit-.f,stop,temp))
- (rdm_float,true,[])
- (StringMap.find next_rule gmap)
- in
- let aux opt next =
- match opt with
- |None -> None
- |Some(l,s) ->
- match gen_tree_rec s next wmap gmap sizemax with_prefix idprefix with
- |(None,_) -> None
- |(Some sub_tree,new_size) -> Some(l@[sub_tree],new_size)
- in
- let suite = List.fold_left aux (Some([],size+1)) next_rules_list in
- match suite with
- |None -> (None,sizemax)
- |Some([Leaf(a,b)],s) -> (Some(Leaf(a,b)),s-1)
- |Some(sons,s) -> (Some(Node((name_of_elem next_rule),prefix,sons)),s)
-*)
+
let gen_tree
(g:grammar)
(with_prefix:bool) (idprefix:string)
View
13 src/Grammar.ml
@@ -34,7 +34,7 @@ let (plane_tree:(Elem.t * (int * Elem.t list) list) list) = [ (ELEM("T"),[(0,[SE
(* StringSet.iter (fun x -> print_endline (name_of_elem x)) (names_of_grammar plane_tree);; *)
-let name_of_elem elt =
+let name_of_elem (elt:elem) =
match elt with
|SEQ(name) -> name
|ELEM(name) -> name ;;
@@ -45,23 +45,23 @@ let names_of_component (_,comps) =
let names_of_rule (_,comps) =
List.fold_left (fun names comp -> StringSet.union (names_of_component comp) names) (StringSet.empty) comps ;;
-let names_of_grammar grm =
+let names_of_grammar (grm:grammar) =
List.fold_left (fun gnames rule -> StringSet.union (names_of_rule rule) gnames) (StringSet.empty) grm ;;
-let rule_names_of_grammar grm =
+let rule_names_of_grammar (grm:grammar) =
List.fold_left (fun rnames (rname,_) -> StringSet.add rname rnames) (StringSet.empty) grm ;;
-let leafs_of_grammar grm =
+let leafs_of_grammar (grm:grammar) =
let leafs = StringSet.diff (names_of_grammar grm) (rule_names_of_grammar grm)
in
StringSet.fold (fun leaf l -> leaf::l) leafs [] ;;
-let completion grm =
+let completion (grm:grammar) =
let leafs = leafs_of_grammar grm
in
grm @ (List.fold_left (fun lrules leaf -> (leaf,[(0,[])])::lrules) [] leafs) ;;
-let count elt liste =
+let count (elt:elem) (liste: elem list) =
let rec count_rec e l i =
match l with
|[] -> i
@@ -93,4 +93,3 @@ let rec string_of_grammar = function
| [] -> ""
| rul::rules -> (string_of_rule rul) ^ "\n" ^ (string_of_grammar rules) ;;
-(* print_endline (string_of_grammar bintree);; *)
View
5 src/Makefile
@@ -1,5 +1,5 @@
SRCS = $(wildcard *.ml *.mli *.mll *.mly)
-TARGS = arbogen tests
+TARGS = arbogen
KIND = native # d.byte
FLAGS = -w,Ae,-warn-error,A
@@ -8,9 +8,6 @@ all: $(TARGS)
arbogen: _build/Arbogen.$(KIND)
cp $< $@
-tests: _build/Tests.$(KIND)
- cp $< $@
-
_build/%.$(KIND): $(SRCS)
ocamlbuild -cflags $(FLAGS) -no-links $*.$(KIND)
View
7 src/OracleSimple.ml
@@ -22,7 +22,6 @@ let iterationSimple (phi:combsys) (z:float) (epsilon:float):float array =
let rec iterate (y:float array): float array =
let y' = evaluation phi z y
in
-(* print_endline (string_of_float (normInf_diff y y'));*)
if (Array.fold_left (fun pred x -> pred or (x > 1.)) false y')
then (Array.make (Array.length y') (-1.0))
else
@@ -37,7 +36,6 @@ let iterationSimple (phi:combsys) (z:float) (epsilon:float):float array =
let diverge (y:float array) (epsilon:float):bool =
let tooBig = 1.0/.epsilon in
let rec dvgi (i:int) (s:int):bool =
- (*print_endline ("element = " ^ (string_of_float ele));*)
if i <= s then
(if (y.(i) < 0.0) || (y.(i) > tooBig) then true
else dvgi (i+1) s)
@@ -46,15 +44,12 @@ let diverge (y:float array) (epsilon:float):bool =
dvgi 0 ((Array.length y) - 1)
(* output:zmin,zmax,vectorY *)
-let rec searchSingularity phi (zmin:float) (zmax:float) (epsilon1:float) (epsilon2:float)(zstart:float):float *float* float array =
- (*print_endline ((string_of_float zmin)^" "^(string_of_float zmax));*)
+let rec searchSingularity (phi:combsys) (zmin:float) (zmax:float) (epsilon1:float) (epsilon2:float)(zstart:float):float *float* float array =
if zmax -. zmin < epsilon1 then
(zmin,zmax,iterationSimple phi zmin epsilon2)
else
let z = zstart in
- (*print_float z;*)
let y = iterationSimple phi z epsilon2 in
- (*print_endline ("singularite= " ^ (string_of_float zmin) ^ "moyenne= " ^ (string_of_float z));*)
if diverge y epsilon2 = true then
searchSingularity phi zmin zstart epsilon1 epsilon2 ((zmin+.zstart)/.2.)
else
View
58 src/Tests.ml
@@ -1,58 +0,0 @@
-(*********************************************************
- * Arbogen-lib : fast uniform random generation of trees *
- *********************************************************
- * Module: Tests *
- * ------- *
- * Generator tests (can be run in the top-level) *
- * ------- *
- * (C) 2011, Xuming Zhan, Frederic Peschanski *
- * Antonine Genitrini, Matthieu Dien *
- * under the *
- * GNU GPL v.3 licence (cf. LICENSE file) *
- *********************************************************)
-
-open Tree;;
-
-(* open CombSys ;; *)
-
-(* open OracleSimple;; *)
-
-open Gen;;
-open Grammar;;
-
-
-(*let tbtree = [("BinNode",[(1,["Leaf"]);(2,["TriNode";"TriNode"])]);
-("TriNode",[(1,["Leaf"]);(0,["BinNode";"BinNode";"BinNode"])])] in
-match generator tbtree true 0 80 150000 0.0001 0.1 0.000001 0.1 false "" 1000 0.8 8 with
-|None -> failwith "a priori ça marche pas"
-|Some(tree,_) -> print_endline (*(dot_of_tree true tree)*) (string_of_tree tree) ;;*)
-
-
-(*let bintree = [ ("BinNode", [ (1,["Leaf"]) ; (1,["BinNode";"BinNode"]) ]) ] in
-match generator bintree true 0 1 2000 0.001 0.1 0.00001 0.1 false "" 100 0.8 6 with
-|None -> failwith "a priori ça marche pas"
-|Some(tree,size) -> print_endline (string_of_int size) ; print_endline (dot_of_tree true tree) (*(string_of_tree tree)*) ;;*)
-
-(*let bintree = [ ("TriNode", [ (1,["Leaf"]) ; (1,["TriNode";"TriNode";"TriNode"]) ]) ] in
-match generator bintree true 0 100 150 0.001 0.1 0.0001 0.1 false "" 300 0.8 6 with
-|None -> failwith "a priori ça marche pas"
-|Some(tree,_) -> (*print_endline (string_of_int size) ;*) print_endline (dot_of_tree true tree) (*(string_of_tree tree)*) ;;*)
-
-(*let (tree:(Elem.t * (int * Elem.t list) list) list) = [ (ELEM("T"),[(1,[SEQ("T")]);(1,[ELEM("Leaf")])]);(SEQ("T"),[(0,[ELEM("T")])])] in
-let (s,_) = string_of_combsys (combsys_of_grammar (completion tree)) in
-print_endline s ;;*)
-
-let (plane_tree:grammar) = [ ("T",[(1,[SEQ("T")])])]
-in
-(*let bin_tree = [("T",[(1,[ELEM("T");ELEM("T")]);(1,[ELEM("Leaf")])])] in*)
-(*List.iter (fun x -> print_endline x) (leafs_of_grammar plane_tree);
-let (s,_) = string_of_combsys (combsys_of_grammar (completion plane_tree)) in
-print_endline s ;
-let sys = combsys_of_grammar (completion plane_tree) in
-let (zmin,_,_) = searchSingularity sys 0. 1. 0.001 0.0001 1. in
-print_endline (string_of_float zmin) ;;*)
-(*let bintree = [ (ELEM("BinNode"), [ (1,[ELEM("Leaf")]) ; (1,[ELEM("BinNode");ELEM("BinNode")]) ]) ]
-in*)
-match generator plane_tree true 0 100000 1500000 0.1 0.1 0.1 0.1 false "" 100 0.8 10 with
-|None -> failwith "Change your parameters"
-|Some(tree,_) -> (*print_endline (string_of_int size) ;*) print_endline (dot_of_tree true tree) (*(string_of_tree tree)*) ;;
View
16 src/Tree.ml
@@ -25,7 +25,7 @@ let rec indent_string = function
| 0 -> ""
| n -> " " ^ indent_string (n-1)
-let indent_string_of_tree t =
+let indent_string_of_tree (t:tree) =
let rec tree level t = match t with
| Leaf(typ,id) -> (indent_string level) ^ "Leaf[" ^ typ ^ "," ^ id ^ "]"
| Node(typ,id,ts) ->
@@ -37,7 +37,7 @@ let indent_string_of_tree t =
in tree 0 t
-let rec tree_out show_type show_id tree out =
+let rec tree_out (show_type:bool) (show_id:bool) (tree:tree) out =
let label typ id =
(if show_id then id else "") ^
(if show_type
@@ -53,20 +53,20 @@ let rec tree_out show_type show_id tree out =
(fun (out:out_channel) (t:tree) -> (tree_out show_type show_id t out))
"[" "," "]" ts ;;
-let file_of_tree show_type show_id fname tree =
+let file_of_tree (show_type:bool) (show_id:bool) (fname:string) (tree:tree) =
let out = open_out fname
in
tree_out show_type show_id tree out ;
close_out out
-let xml_of_tree t =
+let xml_of_tree (t:tree) =
let rec aux = function
| Leaf(typ,id) -> "<leaf type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\"/>"
| Node(typ,id,ts) -> "<node type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\">" ^ (string_of_list aux "" "" "</node>" ts)
in "<?xml version=\"1.0\"?><tree>" ^ (aux t) ^ "</tree>"
-let indent_xml_of_tree t =
+let indent_xml_of_tree (t:tree) =
let rec tree level t = match t with
| Leaf(typ,id) -> (indent_string level) ^ "<leaf type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\"/>"
| Node(typ,id,ts) ->
@@ -77,7 +77,7 @@ let indent_xml_of_tree t =
| t::f' -> (tree level t) ^ "\n" ^ (forest level f')
in "<?xml version=\"1.0\"?>\n<tree>\n" ^ (tree 1 t) ^ "\n</tree>\n"
-let dot_of_tree show_type t =
+let dot_of_tree (show_type:bool) (t:tree) =
let rec nodes = function
| Leaf(typ,id) -> " " ^ id ^ (if show_type then (" [label=\"" ^ typ ^ "\"];\n") else " [shape=point];\n")
| Node(typ,id,ts) ->
@@ -94,13 +94,13 @@ let dot_of_tree show_type t =
| Node(_,id,ts) -> (string_of_list (fun t -> edges 1 id t) "" "" "" ts))
^ "}\n"
- let file_of_dot show_type fname tree =
+ let file_of_dot (show_type:bool) (fname:string) (tree:tree) =
let out = open_out fname
in
output_string out (dot_of_tree show_type tree);
close_out out
-let file_of_xml fname tree =
+let file_of_xml (fname:string) (tree:tree) =
let out = open_out fname
in
output_string out(xml_of_tree tree);
View
29 src/Util.ml
@@ -177,35 +177,6 @@ let ifAtLeast8Smallerin10OthersBigger (p1:int) (p2:int) (tab:int array) : bool
false
-(*
-let bernoulli (z:float) : bool =
- let rd = Random.float 1.0 in
- let afrd = string_of_float rd in
- if rd < z then
- true
- else
- false
- let r = bernoulli 0.5;;
-
-let af = string_of_bool r ;;
-
-print_endline af ;;
-
-"false"
-
-
-let r2 = bernoulli 0.5;;
-
-let af2 = string_of_bool r2 ;;
-
-print_endline af2 ;;
-
-"true" *)
-
-(*let gra_first ((st,ru):string*rule): string = st; *)
-
-
-
View
0  src/examples/binary.arb → src/examples/binary.spec
File renamed without changes
View
0  src/examples/binary100000.arb → src/examples/binary100000.spec
File renamed without changes
View
0  src/examples/binary1billion.arb → src/examples/binary1billion.spec
File renamed without changes
View
0  src/examples/binary1million.arb → src/examples/binary1million.spec
File renamed without changes
View
0  src/examples/nary.arb → src/examples/nary.spec
File renamed without changes
View
10 src/examples/seq.spec
@@ -0,0 +1,10 @@
+
+// grammar file for binary trees (counting leaves and internal nodes)
+// with parameters to obtain trees of size about 100000
+
+set zstart 0.1;
+set min 100;
+set max 200;
+set try 50;
+
+BinNode ::= SEQ(BinNode) * <z>;
View
9 src/examples/seq2.spec
@@ -0,0 +1,9 @@
+
+// grammar file for binary trees (counting leaves and internal nodes)
+// with parameters to obtain trees of size about 100000
+
+set min 100;
+set max 200;
+set try 500;
+
+Node ::= Leaf + Node * Node * SEQ(Node) * <z>;
View
0  src/examples/unarybinary.arb → src/examples/unarybinary.spec
File renamed without changes
View
0  src/examples/unarybinary2.arb → src/examples/unarybinary2.spec
File renamed without changes
Something went wrong with that request. Please try again.