├── src ├── lib │ ├── randtools │ │ ├── randnull.mli │ │ ├── randu.mli │ │ ├── ocamlRandom.mli │ │ ├── dune │ │ ├── ocamlRandom.ml │ │ ├── randu.ml │ │ ├── sig.mli │ │ ├── randtools.ml │ │ └── randnull.ml │ ├── grammar │ │ ├── dune │ │ ├── grammar.ml │ │ └── grammar.mli │ ├── tree │ │ ├── dune │ │ ├── tree.mli │ │ └── tree.ml │ ├── dune │ ├── boltzmann │ │ ├── dune │ │ ├── weightedGrammar.mli │ │ ├── boltzmann.mli │ │ ├── weightedGrammar.ml │ │ ├── boltzmann.ml │ │ └── oracle.ml │ ├── frontend │ │ ├── dune │ │ ├── parseTree.mli │ │ ├── frontend.ml │ │ ├── parser.mly │ │ ├── lexer.mll │ │ ├── parseTree.ml │ │ └── options.ml │ └── arbogen.ml └── bin │ ├── dune │ ├── genState.mli │ ├── genState.ml │ └── arbogen.ml ├── examples ├── sp.spec ├── seq.spec ├── nary.spec ├── unarybinary.spec ├── unarybinary2.spec ├── series-parallel.spec ├── shuffle_plus.spec ├── fjp.spec ├── nsparse.spec ├── nextendible.spec └── binary.spec ├── benchs ├── dune └── bench.ml ├── tests ├── seq.spec ├── sp.spec ├── seq2.spec ├── nary.spec ├── unarybinary.spec ├── dune ├── unarybinary2.spec ├── shuffle_plus.spec ├── binary.spec ├── test_parsing.ml ├── test_gen_sing.ml ├── test_gen_expect.ml └── test_oracle.ml ├── .ocamlformat ├── .gitignore ├── dune-project ├── AUTHORS ├── Makefile ├── arbogen.opam ├── README.md └── LICENSE.txt /src/lib/randtools/randnull.mli: -------------------------------------------------------------------------------- 1 | include Sig.S 2 | -------------------------------------------------------------------------------- /src/lib/randtools/randu.mli: -------------------------------------------------------------------------------- 1 | include Sig.S 2 | -------------------------------------------------------------------------------- /src/lib/randtools/ocamlRandom.mli: -------------------------------------------------------------------------------- 1 | include Sig.S 2 | -------------------------------------------------------------------------------- /examples/sp.spec: -------------------------------------------------------------------------------- 1 | T ::= + * T + * T * T * T 2 | -------------------------------------------------------------------------------- /benchs/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (libraries arbogen benchmark) 3 | (name bench)) 4 | -------------------------------------------------------------------------------- /tests/seq.spec: -------------------------------------------------------------------------------- 1 | // grammar file for plane trees 2 | 3 | Node ::= SEQ(Node) * 4 | -------------------------------------------------------------------------------- /src/lib/grammar/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name grammar) 3 | (public_name arbogen.grammar)) 4 | -------------------------------------------------------------------------------- /tests/sp.spec: -------------------------------------------------------------------------------- 1 | // Series-parallel graphs 2 | 3 | T ::= + * T + * T * T * T 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = ocamlformat 2 | sequence-style = terminator 3 | cases-exp-indent = 2 4 | -------------------------------------------------------------------------------- /src/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name arbogen) 3 | (public_name arbogen) 4 | (libraries arbogen)) 5 | -------------------------------------------------------------------------------- /src/lib/tree/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tree) 3 | (public_name arbogen.tree) 4 | (modules Tree)) 5 | -------------------------------------------------------------------------------- /tests/seq2.spec: -------------------------------------------------------------------------------- 1 | // grammar file for plane trees 2 | 3 | Node ::= Seq * 4 | Seq ::= <1> + Node * Seq 5 | -------------------------------------------------------------------------------- /examples/seq.spec: -------------------------------------------------------------------------------- 1 | // grammar file for n-ary trees using the SEQ operator 2 | 3 | Node ::= SEQ(Node) * 4 | -------------------------------------------------------------------------------- /tests/nary.spec: -------------------------------------------------------------------------------- 1 | // grammar file for n-ary trees 2 | 3 | NTree ::= * Seq 4 | Seq ::= Leaf + NTree * Seq 5 | -------------------------------------------------------------------------------- /examples/nary.spec: -------------------------------------------------------------------------------- 1 | // grammar file for n-ary trees 2 | 3 | NTree ::= * Seq 4 | Seq ::= Leaf + NTree * Seq 5 | -------------------------------------------------------------------------------- /tests/unarybinary.spec: -------------------------------------------------------------------------------- 1 | // grammar file for unary/binary trees 2 | 3 | UBTree ::= + UBTree * + UBTree * UBTree * 4 | -------------------------------------------------------------------------------- /examples/unarybinary.spec: -------------------------------------------------------------------------------- 1 | // grammar file for unary/binary trees 2 | 3 | UBTree ::= + UBTree * + UBTree * UBTree * 4 | -------------------------------------------------------------------------------- /src/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name arbogen) 3 | (public_name arbogen) 4 | (libraries grammar randtools tree frontend boltzmann)) 5 | -------------------------------------------------------------------------------- /src/lib/boltzmann/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name boltzmann) 3 | (public_name arbogen.boltzmann) 4 | (libraries grammar randtools tree)) 5 | -------------------------------------------------------------------------------- /src/lib/randtools/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name randtools) 3 | (public_name arbogen.randtools) 4 | (modules_without_implementation Sig)) 5 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_parsing test_oracle test_gen_sing test_gen_expect) 3 | (deps 4 | (glob_files *.spec)) 5 | (libraries arbogen alcotest)) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | #* 3 | *# 4 | *.arb 5 | *.dot 6 | *.jpg 7 | *.install 8 | .merlin 9 | /*.txt 10 | /gmon.out 11 | 12 | /_build 13 | /lib 14 | /bin 15 | /doc 16 | -------------------------------------------------------------------------------- /tests/unarybinary2.spec: -------------------------------------------------------------------------------- 1 | // grammar file for unary/binary trees 2 | 3 | UBTree ::= UBLeaf + Unary + Binary 4 | Unary ::= UBTree * 5 | Binary ::= UBTree * UBTree * 6 | UBLeaf ::= 7 | -------------------------------------------------------------------------------- /examples/unarybinary2.spec: -------------------------------------------------------------------------------- 1 | // Alternative grammar file for unary/binary trees 2 | 3 | UBTree ::= UBLeaf + Unary + Binary 4 | Unary ::= UBTree * 5 | Binary ::= UBTree * UBTree * 6 | UBLeaf ::= 7 | -------------------------------------------------------------------------------- /src/lib/frontend/dune: -------------------------------------------------------------------------------- 1 | (ocamlyacc 2 | (modules parser)) 3 | 4 | (ocamllex 5 | (modules lexer)) 6 | 7 | (library 8 | (name frontend) 9 | (public_name arbogen.frontend) 10 | (libraries grammar boltzmann)) 11 | -------------------------------------------------------------------------------- /examples/series-parallel.spec: -------------------------------------------------------------------------------- 1 | // Grammar for plane series-parallel graphs 2 | 3 | Tree ::= Serie + Parallel 4 | Serie ::= Leaf * + P * P * SEQ(P) 5 | P ::= Parallel + Leaf * 6 | Parallel ::= Leaf * + S * S * SEQ(S) 7 | S ::= Serie + Leaf * 8 | -------------------------------------------------------------------------------- /src/bin/genState.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { randgen: string 3 | ; rnd_state: Bytes.t 4 | ; weighted_grammar: Boltzmann.WeightedGrammar.t } 5 | 6 | val from_file : string -> t 7 | (** Load a generation state from a file *) 8 | 9 | val to_file : string -> t -> unit 10 | (** Dump a generation state into a file *) 11 | -------------------------------------------------------------------------------- /tests/shuffle_plus.spec: -------------------------------------------------------------------------------- 1 | // grammar for semantic trees of concurrent process 2 | // constructed with shuffle and non-determinism choice 3 | // see : http://www-apr.lip6.fr/~genitrini/publi/fsttcs13_genitrini.pdf 4 | 5 | A ::= Ashuffle + Aplus 6 | Ashuffle ::= SEQ(A) * 7 | Aplus ::= Ashuffle * Ashuffle * SEQ(Ashuffle) 8 | -------------------------------------------------------------------------------- /examples/shuffle_plus.spec: -------------------------------------------------------------------------------- 1 | // grammar for semantic trees of concurrent process 2 | // constructed with shuffle and non-determinism choice 3 | // see : http://www-apr.lip6.fr/~genitrini/publi/fsttcs13_genitrini.pdf 4 | 5 | A ::= Ashuffle + Aplus 6 | Ashuffle ::= SEQ(A) * 7 | Aplus ::= Ashuffle * Ashuffle * SEQ(Ashuffle) 8 | -------------------------------------------------------------------------------- /examples/fjp.spec: -------------------------------------------------------------------------------- 1 | // Fork-Join-Plus graphs, counting global choices 2 | 3 | E ::= Epar + Eplus 4 | Epar ::= + * E + * E * E * SEQ(E) * E 5 | Eplus ::= Epar * Fpar * SEQ(Fpar) * E 6 | + Fpar * SEQ(Fpar) * Epar * SEQ(Fpar) * E 7 | 8 | // Fork-Join-Plus graphs 9 | 10 | F ::= Fpar + Fplus 11 | Fpar ::= + * F + * F * F * SEQ(F) * F 12 | Fplus ::= Fpar * Fpar * SEQ(Fpar) * F 13 | -------------------------------------------------------------------------------- /src/bin/genState.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { randgen: string 3 | ; rnd_state: Bytes.t 4 | ; weighted_grammar: Boltzmann.WeightedGrammar.t } 5 | 6 | let from_file filename = 7 | let ic = open_in filename in 8 | try (input_value ic : t) with err -> close_in_noerr ic; raise err 9 | 10 | let to_file filename state = 11 | let oc = open_out filename in 12 | try output_value oc state with err -> close_out_noerr oc; raise err 13 | -------------------------------------------------------------------------------- /examples/nsparse.spec: -------------------------------------------------------------------------------- 1 | // N-sparse Posets represented by their modular decomposition tree 2 | 3 | N ::= Nseries + Nparallel + Nspider + Nsingle 4 | Nseries ::= * (Nseries + Nspider + Nsingle) * (Nparallel + Nspider + Nsingle) 5 | Nparallel ::= * (Nseries + Nspider + Nsingle) * (Nseries + Nspider + Nsingle) 6 | Nspider ::= * * * (Nseries + Nparallel + Nspider + Nsingle) * Nsingle * Nsingle * Nsingle * Nsingle 7 | Nsingle ::= 8 | -------------------------------------------------------------------------------- /src/lib/randtools/ocamlRandom.ml: -------------------------------------------------------------------------------- 1 | module State = struct 2 | type t = Random.State.t 3 | 4 | let to_bytes x = Marshal.to_bytes x [] 5 | 6 | let from_bytes buf = Marshal.from_bytes buf 0 7 | end 8 | 9 | let name = "ocaml" 10 | 11 | let init = Random.init 12 | 13 | let self_init = Random.self_init 14 | 15 | let int = Random.int 16 | 17 | let float = Random.float 18 | 19 | let get_state = Random.get_state 20 | 21 | let set_state = Random.set_state 22 | -------------------------------------------------------------------------------- /examples/nextendible.spec: -------------------------------------------------------------------------------- 1 | // N-extendible Posets represented by their modular decomposition tree 2 | 3 | N ::= Nseries + Nparallel + Nspider + Nleaf 4 | Nseries ::= * (Nseries + Nspider + Nleaf) * (Nparallel + Nspider + Nleaf) 5 | Nparallel ::= * (Nseries + Nspider + Nleaf) * (Nseries + Nspider + Nleaf) 6 | Nspider ::= * * * (Nseries + Nparallel + Nspider + Nleaf) * Nsingle * Nsingle * Nsingle * Ntwo 7 | Nleaf ::= Nsingle + NM + NW + NOC5 8 | 9 | Nsingle ::= 10 | NM ::= 11 | NW ::= 12 | NOC5 ::= 13 | 14 | Ntwo ::= Nsingle + Nanti + Nchain 15 | Nanti ::= 16 | Nchain ::= 17 | 18 | 19 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name arbogen) 3 | (version 1.0c) 4 | 5 | (generate_opam_files true) 6 | 7 | (source (github fredokun/arbogen)) 8 | (license GPL-2.0-only) 9 | (authors 10 | "Alexis Darasse" 11 | "Matthieu Dien" 12 | "Antoine Genitrini" 13 | "Marwan Ghanem" 14 | "Martin Pépin" 15 | "Frederic Peschanski" 16 | "Xuming Zhan") 17 | (maintainers "Martin Pépin ") 18 | 19 | (package 20 | (name arbogen) 21 | (synopsis "A fast uniform random generator of tree structures") 22 | (depends 23 | (ocaml (>= 4.03)) 24 | (dune (>= 2.0)) 25 | (alcotest :with-test) 26 | (benchmark :with-test) 27 | (odoc :with-doc))) 28 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | In alphabetical order 2 | ===================== 3 | 4 | Alexis Darrasse 5 | Underlying algorithmics 6 | 7 | Matthieu Dien 8 | Tail-recursive generator 9 | native SEQ implementation 10 | Many fixes and improvements 11 | 12 | Antoine Genitrini 13 | Algorithm design and tuning 14 | 15 | Marwan Ghanem 16 | finalization of SEQ 17 | various fixes 18 | packaging (source, Debian, Opam) 19 | 20 | Martin Pépin 21 | Maintainer 22 | Rewrite of the algorithms in persistant style 23 | Reorganisation of the code as library + executable 24 | Documentation 25 | 26 | Frederic Peschanski -- Firstname dot Name at lip6 dot fr 27 | General design 28 | Packaging and distribution 29 | 30 | Xuming Zhan 31 | Initial prototype 32 | -------------------------------------------------------------------------------- /src/lib/frontend/parseTree.mli: -------------------------------------------------------------------------------- 1 | (** High-level grammar definition *) 2 | 3 | (** {2 Grammar} *) 4 | 5 | (** Grammars are lists of rules. *) 6 | type t = rule list 7 | 8 | (** A rule binds a non-terminal symbol to an expression describing how to derive 9 | this symbol. *) 10 | and rule = string * string Grammar.expression 11 | 12 | (** {2 Grammar completion} *) 13 | 14 | val is_complete : t -> bool 15 | (** Whether all the symbols occurring in the grammar are bound. *) 16 | 17 | val completion : t -> t 18 | (** Add a rule for each unbound symbol, interpreting it as an atom of size 0. *) 19 | 20 | (** {2 Conversion to Grammars} *) 21 | 22 | val to_grammar : t -> Grammar.t 23 | 24 | (** {2 Pretty-printing} *) 25 | 26 | val pp : Format.formatter -> t -> unit 27 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build doc bench profile longtest test clean 2 | COMMIT = $(shell git log --pretty=format:'%h' -n 1) 3 | 4 | build: 5 | dune build @install 6 | [ -e bin ] || ln -sf _build/install/default/bin bin 7 | [ -e lib ] || ln -sf _build/install/default/lib/arbogen lib 8 | 9 | doc: 10 | dune build @doc 11 | [ -e doc ] || ln -sf _build/default/_doc/_html doc 12 | @echo Documentation available at doc/index.html 13 | 14 | test: build 15 | dune runtest --no-buffer 16 | 17 | bench: build 18 | dune exec benchs/bench.exe > bench-$(COMMIT).txt 19 | 20 | profile: 21 | dune clean 22 | dune build benchs/bench.exe 23 | perf record --call-graph=dwarg -- _build/default/benchs/bench.exe 24 | @echo Run `perf report` to see the profiling results 25 | 26 | clean: 27 | dune clean 28 | rm -f bin lib doc 29 | -------------------------------------------------------------------------------- /src/lib/randtools/randu.ml: -------------------------------------------------------------------------------- 1 | module State = struct 2 | type t = int 3 | 4 | let to_bytes x = Marshal.to_bytes x [] 5 | 6 | let from_bytes buf = Marshal.from_bytes buf 0 7 | end 8 | 9 | let name = "randu" 10 | 11 | let state = ref 3 12 | 13 | let max_mod = 2 lsl 31 14 | 15 | let max_mod_f = float_of_int max_mod 16 | 17 | let init n = state := n 18 | 19 | let self_init () = 20 | Random.self_init (); 21 | state := Random.int (2 lsl 20) 22 | 23 | let get_state () = !state 24 | 25 | let set_state s = state := s 26 | 27 | let int n = 28 | let r = 65539 * !state mod max_mod in 29 | state := r; 30 | r mod n 31 | 32 | (* FIXME: this is not uniform! *) 33 | 34 | let float f = 35 | let n = int max_mod in 36 | state := n; 37 | f *. (float_of_int n /. max_mod_f) 38 | 39 | (* XXX. Precision? *) 40 | -------------------------------------------------------------------------------- /src/lib/boltzmann/weightedGrammar.mli: -------------------------------------------------------------------------------- 1 | (** Grammars annotated with weight information *) 2 | 3 | (** {2 Type definitions} *) 4 | 5 | (** Analog of {!Grammar.t} with weight information *) 6 | type t = {rules: expression array; names: string array} 7 | 8 | (** Analog of {!Grammar.expression} with weight information. *) 9 | and expression = 10 | | Z of int 11 | | Product of expression list 12 | | Union of (float * expression) list 13 | | Seq of float * expression 14 | | Ref of int 15 | 16 | (** {2 Grammar annotations} *) 17 | 18 | val of_expression : Oracle.t -> int Grammar.expression -> expression 19 | (** Annotate an expression. *) 20 | 21 | val of_grammar : Oracle.t -> Grammar.t -> t 22 | (** Annotate a grammar. *) 23 | 24 | (** {2 Pretty printing} *) 25 | 26 | val pp : Format.formatter -> t -> unit 27 | (** Pretty print a weighted grammar *) 28 | -------------------------------------------------------------------------------- /arbogen.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "1.0c" 4 | synopsis: "A fast uniform random generator of tree structures" 5 | maintainer: ["Martin Pépin "] 6 | authors: [ 7 | "Alexis Darasse" 8 | "Matthieu Dien" 9 | "Antoine Genitrini" 10 | "Marwan Ghanem" 11 | "Martin Pépin" 12 | "Frederic Peschanski" 13 | "Xuming Zhan" 14 | ] 15 | license: "GPL-2.0-only" 16 | homepage: "https://github.com/fredokun/arbogen" 17 | bug-reports: "https://github.com/fredokun/arbogen/issues" 18 | depends: [ 19 | "ocaml" {>= "4.03"} 20 | "dune" {>= "2.0"} 21 | "alcotest" {with-test} 22 | "benchmark" {with-test} 23 | "odoc" {with-doc} 24 | ] 25 | build: [ 26 | ["dune" "subst"] {pinned} 27 | [ 28 | "dune" 29 | "build" 30 | "-p" 31 | name 32 | "-j" 33 | jobs 34 | "@install" 35 | "@runtest" {with-test} 36 | "@doc" {with-doc} 37 | ] 38 | ] 39 | dev-repo: "git+https://github.com/fredokun/arbogen.git" 40 | -------------------------------------------------------------------------------- /src/lib/tree/tree.mli: -------------------------------------------------------------------------------- 1 | (** Generic trees *) 2 | 3 | (** The type of trees *) 4 | type 'a t = Label of 'a * 'a t list | Tuple of 'a t list 5 | 6 | val annotate : 'a t -> ('a * string) t 7 | (** Annotate a tree with unique identifiers. *) 8 | 9 | (** {2 Iterators} *) 10 | 11 | val fold : label:('a -> 'b list -> 'b) -> tuple:('b list -> 'b) -> 'a t -> 'b 12 | 13 | (** A tail-recursive fold on trees. *) 14 | 15 | (** {2 Output functions} *) 16 | 17 | val output_arb : 18 | show_type:bool 19 | -> show_id:bool 20 | -> indent:bool 21 | -> out_channel 22 | -> (string * string) t 23 | -> unit 24 | (** Print a tree to an out channel in arb format *) 25 | 26 | val output_dot : 27 | show_type:bool 28 | -> show_id:bool 29 | -> indent:bool 30 | -> out_channel 31 | -> (string * string) t 32 | -> unit 33 | (** Print a tree to an out channel in dot format *) 34 | 35 | val output_xml : 36 | show_type:bool 37 | -> show_id:bool 38 | -> indent:bool 39 | -> out_channel 40 | -> (string * string) t 41 | -> unit 42 | (** Print a tree to an out channel in xml format *) 43 | -------------------------------------------------------------------------------- /src/lib/randtools/sig.mli: -------------------------------------------------------------------------------- 1 | (** A PRNG must implement this interface to be used for Boltzmann generation. *) 2 | 3 | (** The internal state of the RNG must be serializable. *) 4 | module type STATE = sig 5 | type t 6 | 7 | val to_bytes : t -> Bytes.t 8 | 9 | val from_bytes : Bytes.t -> t 10 | end 11 | 12 | module type S = sig 13 | module State : STATE 14 | 15 | val name : string 16 | (** A unique name for PRNG. *) 17 | 18 | val init : int -> unit 19 | (** Seed the random generator with an integer. *) 20 | 21 | val self_init : unit -> unit 22 | (** Let the generator self-seed itself. *) 23 | 24 | val int : int -> int 25 | (** [int bound] computes a random integer between [0] (inclusive) and [bound] 26 | (exclusive). *) 27 | 28 | val float : float -> float 29 | (** [float bound] computes a random float between [0.] (inclusive) and [bound] 30 | * (exclusive). *) 31 | 32 | val get_state : unit -> State.t 33 | (** Return the current state of the random generator. *) 34 | 35 | val set_state : State.t -> unit 36 | (** Change the current state of the random generator. *) 37 | end 38 | -------------------------------------------------------------------------------- /tests/binary.spec: -------------------------------------------------------------------------------- 1 | 2 | // grammar file for binary trees (counting leaves and internal nodes) 3 | 4 | BinNode ::= Leaf * + BinNode * BinNode * 5 | 6 | /* variant : binary trees (counting internal nodes) 7 | 8 | BinNode ::= Leaf + BinNode * BinNode * 9 | 10 | */ 11 | 12 | /* variant : binary trees (counting leaves) 13 | 14 | BinNode ::= Leaf * + BinNode * BinNode 15 | 16 | */ 17 | 18 | /* variant : binary trees (counting leaves and internal nodes but nodes count twice) 19 | 20 | BinNode ::= Leaf * + BinNode * BinNode * * 21 | 22 | */ 23 | 24 | /* Tree generation : 25 | 26 | arb. compact format 27 | 28 | BinNode[Leaf,BinNode[Leaf,Leaf]] 29 | 30 | xml. format 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | dot file (with or without labels) : 44 | 45 | digraph { 46 | // nodes 47 | node N1 [label="BinNode"] 48 | node N2 [label="Leaf"] 49 | node N3 [label="BinNode"] 50 | node N4 [label="Leaf"] 51 | node N5 [label="Leaf"] 52 | // edges 53 | N1 -> N2 54 | N1 -> N3 55 | N3 -> N4 56 | N3 -> N5 57 | } 58 | 59 | */ 60 | -------------------------------------------------------------------------------- /examples/binary.spec: -------------------------------------------------------------------------------- 1 | // Grammar file for binary trees (counting internal nodes) 2 | 3 | Bintree ::= <1> + Bintree * Bintree * 4 | 5 | /* Variant : binary trees (counting leaves) 6 | 7 | Bintree ::= + Bintree * Bintree 8 | 9 | */ 10 | 11 | /* Variant: binary trees (counting leaves once and internal nodes twice) 12 | 13 | Bintree ::= Leaf * + Bintree * Bintree * * 14 | 15 | */ 16 | 17 | /* Tree generation : 18 | 19 | arb. compact format 20 | 21 | Bintree[Bintree[],Bintree[Bintree[],Bintree[Bintree[],Bintree[Bintree[],Bintree[]]]]] 22 | 23 | xml. format 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | dot file (with or without labels) : 43 | 44 | digraph { 45 | 8 [label="Bintree"]; 46 | 0 [label="Bintree"]; 47 | 7 [label="Bintree"]; 48 | 1 [label="Bintree"]; 49 | 6 [label="Bintree"]; 50 | 2 [label="Bintree"]; 51 | 5 [label="Bintree"]; 52 | 3 [label="Bintree"]; 53 | 4 [label="Bintree"]; 54 | 8 -> 0; 55 | 8 -> 7; 56 | 7 -> 1; 57 | 7 -> 6; 58 | 6 -> 2; 59 | 6 -> 5; 60 | 5 -> 3; 61 | 5 -> 4; 62 | } 63 | 64 | */ 65 | -------------------------------------------------------------------------------- /benchs/bench.ml: -------------------------------------------------------------------------------- 1 | let generate ?(seed = 42424242) grammar ~size_min ~size_max = 2 | let oracle = Boltzmann.Oracle.Naive.make grammar in 3 | let module Rng = Randtools.OcamlRandom in 4 | Rng.init seed; 5 | match 6 | Boltzmann.generator grammar oracle 7 | (module Rng) 8 | ~size_min ~size_max ~max_try:10000 9 | with 10 | | Some (tree, size) -> 11 | (tree, size) 12 | | None -> 13 | assert false 14 | 15 | let bench ?(size_min = 100_000) ?(size_max = 200_000) ?(seed = 4242424242) 16 | grammar = 17 | ignore (Sys.opaque_identity (generate ~seed grammar ~size_min ~size_max)) 18 | 19 | let binary () = 20 | Grammar. 21 | { names= [|"B"|] 22 | ; rules= [|Union (Z 0, Product (Z 1, Product (Ref 0, Ref 0)))|] } 23 | |> bench 24 | 25 | let nary1 () = 26 | Grammar.{names= [|"T"|]; rules= [|Product (Z 1, Seq (Ref 0))|]} |> bench 27 | 28 | let nary2 () = 29 | Grammar. 30 | { names= [|"T"; "S"|] 31 | ; rules= [|Product (Z 1, Ref 1); Union (Z 0, Product (Ref 0, Ref 1))|] } 32 | |> bench 33 | 34 | let shuffle_plus () = 35 | Grammar. 36 | { names= [|"A"; "Aplus"; "Apar"|] 37 | ; rules= 38 | [| Union (Ref 1, Ref 2) 39 | ; Product (Ref 2, Product (Ref 2, Seq (Ref 2))) 40 | ; Product (Z 1, Seq (Ref 0)) |] } 41 | |> bench 42 | 43 | let () = 44 | let res = 45 | Benchmark.latencyN 4L 46 | [ ("binary", binary, ()) 47 | ; ("nary1", nary1, ()) 48 | ; ("nary2", nary2, ()) 49 | ; ("shuffle_plus", shuffle_plus, ()) ] 50 | in 51 | Benchmark.tabulate res 52 | -------------------------------------------------------------------------------- /src/lib/frontend/frontend.ml: -------------------------------------------------------------------------------- 1 | (********************************************************* 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: ParseUtil * 5 | * ------- * 6 | * Options Parser * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | (** Specification parsing and configuration options management *) 16 | 17 | (** {2 Configuration options management} *) 18 | 19 | (** Configuration options available on the command line of the executable, and 20 | in specification files in the form of `set option value` directives. *) 21 | module Options = Options 22 | 23 | (** {2 Parsing functions} *) 24 | 25 | (** Parse a specification, possibly preceded by configuration options, given via 26 | an stdlib input channel. *) 27 | let parse_from_channel chan = 28 | let lexbuf = Lexing.from_channel chan in 29 | let options, parsetree = Parser.start Lexer.token lexbuf in 30 | (options, ParseTree.to_grammar parsetree) 31 | 32 | (** Parse a specification, possibly preceded by configuration options, given via 33 | its file name. *) 34 | let parse_from_file filename = 35 | let chan = open_in filename in 36 | let res = parse_from_channel chan in 37 | close_in chan; res 38 | 39 | module ParseTree = ParseTree 40 | (** A user-friendly representation of grammars. *) 41 | -------------------------------------------------------------------------------- /src/lib/frontend/parser.mly: -------------------------------------------------------------------------------- 1 | %token UIDENT LIDENT 2 | %token EOF 3 | 4 | /* options tokens */ 5 | %token SET 6 | %token NUMI 7 | %token NUMF 8 | 9 | /* grammar tokens */ 10 | %token SEQ 11 | %token PLUS EQUAL TIMES LWEIGHT RWEIGHT LPAREN RPAREN ONE Z 12 | 13 | %start start 14 | %type start 15 | 16 | %% 17 | 18 | /* Grammar entry point */ 19 | 20 | start: 21 | option_list rule_list EOF { $1, $2 } 22 | 23 | 24 | /* Options ********************************************** */ 25 | 26 | /* Possibly empty list */ 27 | option_list: 28 | | { [] } 29 | | arbogen_option option_list { $1 :: $2 } 30 | 31 | arbogen_option: 32 | SET LIDENT value { ($2, $3) } 33 | 34 | value: 35 | | NUMF { Options.Value.Float $1 } 36 | | NUMI { Options.Value.Int $1 } 37 | | LIDENT { Options.Value.String $1 } 38 | 39 | 40 | /* Production rules ************************************* */ 41 | 42 | /* non-empty list */ 43 | rule_list: 44 | | rule { [$1] } 45 | | rule rule_list { $1 :: $2 } 46 | 47 | rule: 48 | UIDENT EQUAL expr { $1, $3 } 49 | 50 | /* Expressions ****************************************** */ 51 | 52 | expr: 53 | | union { Grammar.union $1 } 54 | | pof { $1 } 55 | 56 | union: 57 | | pof PLUS pof { [$1; $3] } 58 | | pof PLUS union { $1 :: $3 } 59 | 60 | /* Product or Factor */ 61 | pof: 62 | | product { Grammar.product $1 } 63 | | factor { $1 } 64 | 65 | product: 66 | | factor TIMES factor { [$1; $3] } 67 | | factor TIMES product { $1 :: $3 } 68 | 69 | factor: 70 | | LPAREN expr RPAREN { $2 } 71 | | UIDENT { Grammar.Ref $1 } 72 | | SEQ LPAREN expr RPAREN { Grammar.Seq $3 } 73 | | LWEIGHT NUMI RWEIGHT { Grammar.Z $2 } 74 | | Z { Grammar.Z 1 } 75 | | ONE { Grammar.Z 0 } 76 | -------------------------------------------------------------------------------- /src/lib/frontend/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Parser 3 | 4 | let lident_or_kw = 5 | let kw_table = Hashtbl.create 2 in 6 | List.iter (fun (kw, tok) -> Hashtbl.add kw_table kw tok) [ 7 | "set", SET 8 | ]; 9 | fun lid -> 10 | try Hashtbl.find kw_table lid 11 | with Not_found -> LIDENT lid 12 | 13 | let uident_or_kw = 14 | let kw_table = Hashtbl.create 2 in 15 | List.iter (fun (kw, tok) -> Hashtbl.add kw_table kw tok) [ 16 | "SEQ", SEQ 17 | ]; 18 | fun uid -> 19 | try Hashtbl.find kw_table uid 20 | with Not_found -> UIDENT uid 21 | 22 | } 23 | 24 | let uident = ['A'-'Z']['-' '_' 'a'-'z''0'-'9''A'-'Z']* 25 | let lident = ['a'-'z']['-' '_' 'a'-'z''0'-'9''A'-'Z']* 26 | let num_int = ['0'-'9']* 27 | let num_float = ['0'-'9']*'.'['0'-'9']['0'-'9']* 28 | 29 | let comment = "//" [^ '\n' '\r']* 30 | let newline = ['\n' '\r'] 31 | 32 | rule token = parse 33 | | [' ' '\t'] {token lexbuf} 34 | | newline {Lexing.new_line lexbuf; token lexbuf} 35 | | comment {token lexbuf} 36 | | uident as s {uident_or_kw s} 37 | | lident as s {lident_or_kw s} 38 | | num_int as n {NUMI (int_of_string n)} 39 | | num_float as n {NUMF (float_of_string n)} 40 | | "" { Z } 41 | | "<1>" { ONE } 42 | | "" { RWEIGHT } 44 | | "+" { PLUS } 45 | | "::=" { EQUAL } 46 | | "*" { TIMES } 47 | | "(" { LPAREN } 48 | | ")" { RPAREN } 49 | | "/*" { comment lexbuf } 50 | | eof { EOF } 51 | | _ { failwith ("Unknown symbol " ^ Lexing.lexeme lexbuf) } 52 | 53 | and comment = parse 54 | | "*/" { token lexbuf } 55 | | newline { Lexing.new_line lexbuf; comment lexbuf } 56 | | eof { failwith "unterminated comment" } 57 | | _ { comment lexbuf } 58 | -------------------------------------------------------------------------------- /src/lib/boltzmann/boltzmann.mli: -------------------------------------------------------------------------------- 1 | (** Boltzmann generation for tree-like structures. *) 2 | 3 | (** {2 Pre-processing phase} *) 4 | 5 | module WeightedGrammar = WeightedGrammar 6 | module Oracle = Oracle 7 | 8 | (** {2 Rejection sampling in a size window (high-level interface)} *) 9 | 10 | val search_seed : 11 | (module Randtools.S with type State.t = 'a) 12 | -> size_min:int 13 | -> size_max:int 14 | -> ?max_try:int 15 | -> WeightedGrammar.t 16 | -> (int * 'a) option 17 | (** Search for a tree in a specific size window by rejection sampling. 18 | Only the size of the tree is computed during the generation. 19 | This function returns the size of the found tree and the state of the PRNG 20 | just before generating this tree. *) 21 | 22 | val generator : 23 | Grammar.t 24 | -> Oracle.t 25 | -> (module Randtools.S) 26 | -> size_min:int 27 | -> size_max:int 28 | -> max_try:int 29 | -> (string Tree.t * int) option 30 | (** [generator grammar oracle rng ~size_max ~size_min ~max_try] generates trees 31 | until it finds one of size at least [size_min] and at most [size_max]. After 32 | [max_try] unsuccessful attempts, it returns [None]. *) 33 | 34 | (** {2 Free Bolzmann generators (low-level interface)} *) 35 | 36 | (** The "free" keyword means that no rejection is performed: these generators 37 | generate one object following the Boltzmann distribution. *) 38 | 39 | val free_size : (module Randtools.S) -> size_max:int -> WeightedGrammar.t -> int 40 | (** [free_size rng size_max rules] simulates the generation of a tree given the 41 | weighted grammar [rules] (starting by the first symbol) but only computes 42 | its size. The generation aborts early if the size goes beyond [size_max]. *) 43 | 44 | val free_gen : 45 | (module Randtools.S) -> WeightedGrammar.t -> string -> string Tree.t * int 46 | (** Generate a tree and its size, given weigthed grammar and the desired 47 | non-terminal. *) 48 | -------------------------------------------------------------------------------- /src/lib/grammar/grammar.ml: -------------------------------------------------------------------------------- 1 | (********************************************************* 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: Grammar * 5 | * ------- * 6 | * Internal representation of grammars * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | type t = {names: string array; rules: int expression array} 16 | 17 | and 'ref expression = 18 | | Z of int 19 | | Product of 'ref expression list 20 | | Union of 'ref expression list 21 | | Seq of 'ref expression 22 | | Ref of 'ref 23 | 24 | let product = function 25 | | [] | [_] -> 26 | invalid_arg "product with less that two arguments" 27 | | args -> 28 | Product args 29 | 30 | let union = function 31 | | [] | [_] -> 32 | invalid_arg "union with less that two arguments" 33 | | args -> 34 | Union args 35 | 36 | (* Pretty printing *) 37 | 38 | let pp_expression ~pp_ref = 39 | let rec aux fmt = function 40 | | Product args -> 41 | Format.fprintf fmt "(%a)" 42 | (Format.pp_print_list 43 | ~pp_sep:(fun fmt () -> Format.pp_print_string fmt " * ") 44 | aux ) 45 | args 46 | | Union args -> 47 | Format.fprintf fmt "(%a)" 48 | (Format.pp_print_list 49 | ~pp_sep:(fun fmt () -> Format.pp_print_string fmt " + ") 50 | aux ) 51 | args 52 | | Seq e -> 53 | Format.fprintf fmt "Seq(%a)" aux e 54 | | Ref name -> 55 | pp_ref fmt name 56 | | Z i -> 57 | Format.fprintf fmt "z^%d" i 58 | in 59 | aux 60 | 61 | let pp fmt {rules; names} = 62 | Array.iteri 63 | (fun i expr -> 64 | Format.fprintf fmt "%s ::= %a@\n" names.(i) 65 | (pp_expression ~pp_ref:Format.pp_print_int) 66 | expr ) 67 | rules 68 | -------------------------------------------------------------------------------- /src/lib/randtools/randtools.ml: -------------------------------------------------------------------------------- 1 | (** {2 Pseudo-random number generators (PRNG)} *) 2 | 3 | (** The internal state of a PRNG must be serialisable to be usable with Arbogen. 4 | This signature specifies serialisable types. *) 5 | module type STATE = sig 6 | type t 7 | 8 | val to_bytes : t -> Bytes.t 9 | 10 | val from_bytes : Bytes.t -> t 11 | end 12 | 13 | (** This is the types of a PRNG to be used with Arbogen. *) 14 | module type S = sig 15 | module State : STATE 16 | 17 | val name : string 18 | (** A unique name for the PRNG. *) 19 | 20 | val init : int -> unit 21 | (** Seed the random generator with an integer. *) 22 | 23 | val self_init : unit -> unit 24 | (** Let the generator self-seed itself. *) 25 | 26 | val int : int -> int 27 | (** [int bound] computes a random integer between [0] (inclusive) and [bound] 28 | (exclusive). *) 29 | 30 | val float : float -> float 31 | (** [float bound] computes a random float between [0.] (inclusive) and [bound] 32 | * (exclusive). *) 33 | 34 | val get_state : unit -> State.t 35 | (** Return the current state of the random generator. *) 36 | 37 | val set_state : State.t -> unit 38 | (** Change the current state of the random generator. *) 39 | end 40 | 41 | (** {3 Pre-defined PRNG} *) 42 | 43 | (** A thin wrapper around OCaml's {!Stdlib.Random} module *) 44 | module OcamlRandom : S = OcamlRandom 45 | 46 | (** A very bad PRNG with hardcoded values, for testing purposes only! *) 47 | module Randnull : S = Randnull 48 | 49 | (** The randu (https://en.wikipedia.org/wiki/RANDU) PRNG. This is a bad PRNG 50 | with respect to nowadays standards, don't use it in production. *) 51 | module Randu : S = Randu 52 | 53 | (** {2 Classical random distributions} *) 54 | 55 | (** The geometric distribution. If [0 < p <= 1], [geometric p] returns [n] with 56 | probability [p * (1-p)^n]. *) 57 | let geometric (module R : S) = 58 | let rec gen acc p = if R.float 1. < p then acc else gen (acc + 1) p in 59 | fun p -> 60 | if p <= 0. || p > 1. then 61 | invalid_arg "Randtools.geometric: argument must be in (0; 1]" 62 | else gen 0 p 63 | 64 | (* let geometric (module R: Sig.S) p = *) 65 | (* let rec gen r p_pow_i = *) 66 | (* let r = r -. p_pow_i in *) 67 | (* if r < 0. then 0 *) 68 | (* else 1 + gen r (p_pow_i *. p) *) 69 | (* in *) 70 | (* gen (R.float 1.) p *) 71 | -------------------------------------------------------------------------------- /src/lib/frontend/parseTree.ml: -------------------------------------------------------------------------------- 1 | type t = rule list 2 | 3 | and rule = string * string Grammar.expression 4 | 5 | (** {2 Grammar completion} *) 6 | 7 | module Sset = Set.Make (String) 8 | 9 | let rec expr_names set = function 10 | | Grammar.Product args | Grammar.Union args -> 11 | List.fold_left expr_names set args 12 | | Grammar.Seq e -> 13 | expr_names set e 14 | | Grammar.Z _ -> 15 | set 16 | | Grammar.Ref name -> 17 | Sset.add name set 18 | 19 | let names grammar = 20 | List.fold_left (fun set (_, expr) -> expr_names set expr) Sset.empty grammar 21 | 22 | let unbound_symbols grammar = 23 | let all_names = names grammar in 24 | let bound_names = List.map fst grammar |> Sset.of_list in 25 | Sset.diff all_names bound_names 26 | 27 | let is_complete grammar = Sset.is_empty (unbound_symbols grammar) 28 | 29 | let completion grammar = 30 | let unbound = unbound_symbols grammar in 31 | let extra_rules = 32 | let epsilon = Grammar.Z 0 in 33 | Sset.fold (fun name rules -> (name, epsilon) :: rules) unbound [] 34 | in 35 | grammar @ extra_rules 36 | 37 | (* Conversion to Grammars *) 38 | 39 | module Smap = Map.Make (String) 40 | 41 | let map_names_to_ids rules = 42 | let names = List.map fst rules |> Array.of_list in 43 | let _, indices = 44 | Array.fold_left 45 | (fun (i, map) name -> (i + 1, Smap.add name i map)) 46 | (0, Smap.empty) names 47 | in 48 | (names, indices) 49 | 50 | let expr_to_id indices = 51 | let rec aux : string Grammar.expression -> int Grammar.expression = function 52 | | Z n -> 53 | Z n 54 | | Product args -> 55 | Product (List.map aux args) 56 | | Union args -> 57 | Union (List.map aux args) 58 | | Seq e -> 59 | Seq (aux e) 60 | | Ref r -> 61 | Ref (Smap.find r indices) 62 | in 63 | aux 64 | 65 | let to_grammar t = 66 | let t = completion t in 67 | let names, indices = map_names_to_ids t in 68 | let rules = 69 | t |> List.map (fun (_, expr) -> expr_to_id indices expr) |> Array.of_list 70 | in 71 | Grammar.{rules; names} 72 | 73 | (** {2 Pretty-printing} *) 74 | 75 | let pp_rule fmt (name, expr) = 76 | let pp_expr = Grammar.pp_expression ~pp_ref:Format.pp_print_string in 77 | Format.fprintf fmt "%s ::= %a" name pp_expr expr 78 | 79 | let pp = 80 | Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n") pp_rule 81 | -------------------------------------------------------------------------------- /src/lib/grammar/grammar.mli: -------------------------------------------------------------------------------- 1 | (** The internal representation of grammars *) 2 | 3 | (** A grammar is an array of production rules. For performance reasons, the 4 | non-terminals of the grammars are represented by integers: - symbol [i] is 5 | defined in [rules.(i)] - the high level name of symbol [i] is [names.(i)] 6 | 7 | For instance, the grammar of binary trees [B ::= 1 + z * B * B] may be 8 | encoded as follows: 9 | {[ 10 | { rules = [|Union (Z 0, Product (Z 1, Product (Ref 0; Ref 0)))|] 11 | ; names = [|"B"|] } 12 | ]} 13 | 14 | As another example, the grammar of plane trees might be represented either 15 | using the sequence construction [T ::= z * Seq(T)]: 16 | {[ 17 | { rules = [|Product (Z 1, Seq (Ref 0))|] 18 | ; names = [|"T"|] } 19 | ]} 20 | Or using a two-rules grammar to explicitely express the sequence 21 | [T ::= z * S and S ::= 1 + T * S]: 22 | {[ 23 | { rules = [| Product (Z 1, Ref 1); Union (Z 0, Product (Ref 0, Ref 1)); |] 24 | ; names = \[|"T"; "S"|]; } 25 | ]} *) 26 | type t = {names: string array; rules: int expression array} 27 | 28 | (** The currently supported grammar expressions. *) 29 | and 'ref expression = 30 | | Z of int 31 | (** The atom, potentially elevated to the power of some integer. This 32 | accounts for the size of the generated object. *) 33 | | Product of 'ref expression list 34 | (** Cartesian product. The list must have at least two elements. *) 35 | | Union of 'ref expression list 36 | (** Disjoint unions (alternative between two or more derivations) *) 37 | | Seq of 'ref expression 38 | (** Sequence of objects. This behaves as a Kleene start, that is [Seq e] 39 | behaves as [Union (Z 0, Product (e, Seq e)] *) 40 | | Ref of 'ref 41 | (** A non-terminal symbol. The type of the references is left abstract in 42 | order to allow both integer references ([Ref i] refers to the [i]th 43 | non-terminal of the grammar) and strings (for use in the parser). *) 44 | 45 | val product : 'a expression list -> 'a expression 46 | (** Product constructor *) 47 | 48 | val union : 'a expression list -> 'a expression 49 | (** Union constructor *) 50 | 51 | (** {2 Pretty printing} *) 52 | 53 | val pp : Format.formatter -> t -> unit 54 | (** Pretty printer for grammars *) 55 | 56 | val pp_expression : 57 | pp_ref:(Format.formatter -> 'ref -> unit) 58 | -> Format.formatter 59 | -> 'ref expression 60 | -> unit 61 | (** Pretty printer for expressions *) 62 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ``` 2 | 3 | A ...:'....:'':...':...... 4 | R :'' ._ . `. \ , '': 5 | B ': . \" .| \ `>/ _.-': 6 | O .:' .`'. `-. '. /' ,.. .: 7 | G :' `. `\| \./ ' : 8 | E :. ,,-''''' \"-. | | ....: 9 | N '. ..''' `\ : | 10 | '''''''' \' | 11 | *fast* uniform random | =| 12 | tree generator | | 13 | |- | 14 | ''''''''''''''''''''''''''''''''''''''' 15 | (C) F. Peschanski et al. under the GPL 16 | ``` 17 | 18 | Arbogen is a fast uniform random generator of tree structures. 19 | The tool reads a grammar file describing a tree structure 20 | (e.g. binary trees, 2-3-4 trees, etc.) and a size interval 21 | (eg. trees of size 1000+-100). From the grammar one or 22 | many trees satisfying the structure and the size interval 23 | are produced (following simple file formats). 24 | The generated tree are generated with a guarantee of uniformity, 25 | which means that it is the "average" tree for the given size. 26 | 27 | ---- 28 | 29 | ![Tree example](https://github.com/fredokun/arbogen/wiki/images/tree_nary_seq_big.png) 30 | 31 | Note: this example is a plane rooted tree of more than 100.000 nodes obtained in a few seconds on a standard PC. 32 | 33 | ---- 34 | 35 | Internally, the tool is based on recent advances in analytic 36 | combinatorics and Boltzmann generators. The generation is 37 | roughly linear in the size of the trees, which means huge 38 | trees (e.g. of more than 1 millions nodes) can be generated 39 | in a few seconds, memory management being the main 40 | performance bottleneck. 41 | 42 | Arbogen can be used in the very many situations when tree-shaped 43 | data structures must be manipulated, e.g. in random testing. 44 | 45 | ---- 46 | 47 | This software was inspired by the research work of Alexis Darasse. 48 | It is distributed under the GNU Public license v.2 (cf. `LICENSE.txt`). 49 | 50 | ---- 51 | 52 | ## Build & install arbogen 53 | 54 | Arbogen is packaged as a library and command line tool. The library exposes the 55 | internal grammar representation, our oracle implementation and the random 56 | generator for use as part of other projects. Note that the library should be 57 | considered rather unstable and *will* change in the future. 58 | 59 | Arbogen is packaged for the `opam` package manager. This means that it can be 60 | installed in your current switch by running `opam install .`. Opam will resolve 61 | all the dependencies. 62 | 63 | If you just want opam to install the dependencies but don't want to install 64 | arbogen, run `opam install . --deps-only --with-test --with-doc`. The explicit 65 | list of all dependencies can be found in `dune-project`. 66 | 67 | To build arbogen manually, run `dune build @install` or `make build`. 68 | 69 | ### Documentation 70 | 71 | A documentation can be build using `dune build @doc` or `make doc`. Please feel 72 | free to open an issue if you need some parts of the documentation to be 73 | clarified. 74 | -------------------------------------------------------------------------------- /tests/test_parsing.ml: -------------------------------------------------------------------------------- 1 | let grammar = 2 | let pp = Grammar.pp in 3 | let equal g1 g2 = g1 = g2 in 4 | (* XXX *) 5 | Alcotest.testable pp equal 6 | 7 | let parse test_name = 8 | let _, grammar = Frontend.parse_from_file (test_name ^ ".spec") in 9 | grammar 10 | 11 | let binary () = 12 | let expected = 13 | Grammar. 14 | { names= [|"BinNode"; "Leaf"|] 15 | ; rules= [|Union [Product [Ref 1; Z 1]; Product [Ref 0; Ref 0; Z 1]]; Z 0|] 16 | } 17 | in 18 | Alcotest.check grammar "binary" expected (parse "binary") 19 | 20 | let nary () = 21 | let expected = 22 | Grammar. 23 | { names= [|"NTree"; "Seq"; "Leaf"|] 24 | ; rules= 25 | [|Product [Z 1; Ref 1]; Union [Ref 2; Product [Ref 0; Ref 1]]; Z 0|] 26 | } 27 | in 28 | Alcotest.check grammar "nary" expected (parse "nary") 29 | 30 | let seq () = 31 | let expected = 32 | Grammar.{names= [|"Node"|]; rules= [|Product [Seq (Ref 0); Z 1]|]} 33 | in 34 | Alcotest.check grammar "seq" expected (parse "seq") 35 | 36 | let seq2 () = 37 | let expected = 38 | Grammar. 39 | { names= [|"Node"; "Seq"|] 40 | ; rules= [|Product [Ref 1; Z 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 41 | in 42 | Alcotest.check grammar "seq2" expected (parse "seq2") 43 | 44 | let shuffle_plus () = 45 | let expected = 46 | Grammar. 47 | { names= [|"A"; "Ashuffle"; "Aplus"|] 48 | ; rules= 49 | [| Union [Ref 1; Ref 2] 50 | ; Product [Seq (Ref 0); Z 1] 51 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 52 | in 53 | Alcotest.check grammar "shuffle_plus" expected (parse "shuffle_plus") 54 | 55 | let sp () = 56 | let expected = 57 | Grammar. 58 | { names= [|"T"|] 59 | ; rules= 60 | [| Union 61 | [Z 1; Product [Z 1; Ref 0]; Product [Z 1; Ref 0; Ref 0; Ref 0]] 62 | |] } 63 | in 64 | Alcotest.check grammar "sp" expected (parse "sp") 65 | 66 | let unarybinary () = 67 | let expected = 68 | Grammar. 69 | { names= [|"UBTree"|] 70 | ; rules= [|Union [Z 1; Product [Ref 0; Z 1]; Product [Ref 0; Ref 0; Z 1]]|] 71 | } 72 | in 73 | Alcotest.check grammar "unarybinary" expected (parse "unarybinary") 74 | 75 | let unarybinary2 () = 76 | let expected = 77 | Grammar. 78 | { names= [|"UBTree"; "Unary"; "Binary"; "UBLeaf"|] 79 | ; rules= 80 | [| Union [Ref 3; Ref 1; Ref 2] 81 | ; Product [Ref 0; Z 1] 82 | ; Product [Ref 0; Ref 0; Z 1] 83 | ; Z 1 |] } 84 | in 85 | Alcotest.check grammar "unarybinary2" expected (parse "unarybinary2") 86 | 87 | let () = 88 | Alcotest.run "parsing" 89 | [ ( "parsing" 90 | , [ ("Parse binary.spec", `Quick, binary) 91 | ; ("Parse nary.spec", `Quick, nary) 92 | ; ("Parse seq.spec", `Quick, seq) 93 | ; ("Parse seq2.spec", `Quick, seq2) 94 | ; ("Parse shuffle_plus.spec", `Quick, shuffle_plus) 95 | ; ("Parse sp.spec", `Quick, sp) 96 | ; ("Parse unarybinary.spec", `Quick, unarybinary) 97 | ; ("Parse unarybinary2.spec", `Quick, unarybinary2) ] ) ] 98 | -------------------------------------------------------------------------------- /src/lib/boltzmann/weightedGrammar.ml: -------------------------------------------------------------------------------- 1 | (********************************************************* 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: WeightedGrammar * 5 | * ------- * 6 | * Internal representation of Weighted grammars * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | type t = {rules: expression array; names: string array} 16 | 17 | and expression = 18 | | Z of int 19 | | Product of expression list 20 | | Union of (float * expression) list 21 | | Seq of float * expression 22 | | Ref of int 23 | 24 | (** {2 Conversion from grammars} *) 25 | 26 | let of_expression (oracle : Oracle.t) = 27 | let rec aux = function 28 | | Grammar.Z n -> 29 | (Z n, oracle.z ** float_of_int n) 30 | | Grammar.Product args -> 31 | let args, weight = 32 | List.fold_right 33 | (fun e (args, w) -> 34 | let e', w' = aux e in 35 | (e' :: args, w *. w') ) 36 | args ([], 1.) 37 | in 38 | (Product args, weight) 39 | | Grammar.Union args -> 40 | let args, total = 41 | List.fold_right 42 | (fun e (args, tot) -> 43 | let e, w = aux e in 44 | ((w, e) :: args, tot +. w) ) 45 | args ([], 0.) 46 | in 47 | (Union (List.map (fun (w, e) -> (w /. total, e)) args), total) 48 | | Grammar.Seq e -> 49 | let e, w = aux e in 50 | (Seq (1. -. w, e), 1. /. (1. -. w)) 51 | | Grammar.Ref i -> 52 | (Ref i, oracle.values.(i)) 53 | in 54 | fun e -> fst (aux e) 55 | 56 | let of_grammar oracle grammar = 57 | let rules = grammar.Grammar.rules in 58 | let names = grammar.Grammar.names in 59 | let rules = Array.map (of_expression oracle) rules in 60 | {names; rules} 61 | 62 | (** {2 Pretty printing} *) 63 | 64 | let pp_expression = 65 | let rec pp fmt = function 66 | | Z n -> 67 | Format.fprintf fmt "z^%d" n 68 | | Product args -> 69 | Format.fprintf fmt "(%a)" 70 | (Format.pp_print_list 71 | ~pp_sep:(fun fmt () -> Format.pp_print_string fmt " * ") 72 | pp ) 73 | args 74 | | Union args -> 75 | Format.fprintf fmt "(%a)" 76 | (Format.pp_print_list 77 | ~pp_sep:(fun fmt () -> Format.pp_print_string fmt " | ") 78 | pp_weighted_pair ) 79 | args 80 | | Seq (w, e) -> 81 | Format.fprintf fmt "Seq(%F, %a)" w pp e 82 | | Ref i -> 83 | Format.fprintf fmt "Ref(%d)" i 84 | and pp_weighted_pair fmt (w, e) = Format.fprintf fmt "%F -> %a" w pp e in 85 | pp 86 | 87 | let pp fmt {rules; names} = 88 | Array.iteri 89 | (fun i expr -> 90 | Format.fprintf fmt "%s ::= %a@\n" names.(i) pp_expression expr ) 91 | rules 92 | -------------------------------------------------------------------------------- /src/lib/arbogen.ml: -------------------------------------------------------------------------------- 1 | (** Boltzmann random sampling of tree-like structures *) 2 | 3 | (** Arbogen provides efficient approximate size uniform samplers for structures 4 | that can be described by an unambiguous context-free grammar. Arbogen 5 | implements a generic Boltzmann sampler, as described in the paper 6 | ``Boltzmann Samplers for the Random Generation of Combinatorial Structures'' 7 | by Duchon, Flajolet, Louchard and Schaeffer. 8 | 9 | The algorithm offers two guarantees: - two objects of the same size have the 10 | same probability of being drawn; - given two integers [size_min] and 11 | [size_max] the algorithm will generate an object of size larger or equal to 12 | [size_min] and less or equal to [size_max] in linear time (in its size), 13 | provided that [size_max - size_min] grows linearly with [size_min]. 14 | 15 | The process of Boltzmann sampling consists in: 1. specifying the objects to 16 | be generated; 2. running a pre-processing step which computes some constants 17 | used in the generation; 3. generating objects in a size window using 18 | rejection sampling. At the moment, the objects produced by Arbogen all 19 | belong to the {!Tree.t} type. *) 20 | 21 | (** {2 Combinatorial specifications} *) 22 | 23 | (** They are two ways to specify the objects to be generated. 24 | 25 | When using Arbogen as a library, the simpler way is to write a grammar using 26 | the {!Grammar} module. Alternatively, one may describe the grammar in a 27 | .spec file (several examples are given in the [examples/] folder of the git 28 | repository). In that case, one must use the functions provided by the 29 | {!Frontend} to parse the file and obtain the corresponding grammar. 30 | 31 | In both cases, it is important to ensure that there exists a finite number 32 | of objects of each size. The size of an object is defined as the number of 33 | atoms ([Z n] in the grammar and [] in the .spec language) occurring in a 34 | derivation. For instance, in the following grammar describing binary trees, 35 | the size of a tree corresponds to its number of internal nodes: 36 | 37 | - in the .spec language: [B ::= <1> + * B * B] - as a {!Grammar.t} 38 | value: 39 | {[ 40 | { names = [|"B"|] 41 | ; rules = [| Union (Z 0, Product (Z 1, Product (Ref 0, Ref 0))) |] } 42 | ]} *) 43 | 44 | module Frontend = Frontend 45 | module Grammar = Grammar 46 | 47 | (** {2 Pre-processing} *) 48 | 49 | (** The preprocessing of a grammar is handled by the {!Boltzmann.Oracle} and 50 | {!Boltzmann.WeightedGrammar} modules. 51 | It consists in computing some weights (the values of the generating 52 | functions of the combinatorial classes at play) an annotating the grammar 53 | with theses weights. 54 | The current (only) implementation of this mechanism is available under the 55 | {!Boltzmann.Oracle.Naive} name. 56 | 57 | Obtaining an annotated grammar is achieved as follows: 58 | {[ 59 | let open Boltzmann in 60 | let oracle = Oracle.Naive.make grammar in 61 | WeightedGrammar.of_grammar oracle grammar 62 | ]} 63 | 64 | See the {!Boltzmann.Oracle} documentation for more options. 65 | *) 66 | 67 | (** {2 Random generation} *) 68 | 69 | (** Once the pre-processing of a grammar has been done, trees of constrained 70 | size can be generated using the {!Boltzmann} module. 71 | The main function of this module is the {!Boltzmann.generator} function, see 72 | the documentation of the module for more options. *) 73 | 74 | module Boltzmann = Boltzmann 75 | 76 | (** The structures generated by arbogen belong the {string Tree.t} type. 77 | These are n-ary trees whose nodes carry the name of the grammar rule used to 78 | generate it. *) 79 | 80 | module Tree = Tree 81 | 82 | (** The {!Randtools} module manages PRNGs and low level random sampling 83 | utilities. *) 84 | 85 | module Randtools = Randtools 86 | -------------------------------------------------------------------------------- /src/lib/frontend/options.ml: -------------------------------------------------------------------------------- 1 | let fail format = Format.kasprintf failwith format 2 | 3 | (** Values taken by configuration options *) 4 | module Value = struct 5 | type t = Int of int | Float of float | String of string 6 | 7 | (** {3 Conversion helpers} *) 8 | 9 | let as_int opt_name = function 10 | | Int n -> 11 | n 12 | | _ -> 13 | fail "type error: %s expects an integer" opt_name 14 | 15 | let as_float opt_name = function 16 | | Float f -> 17 | f 18 | | _ -> 19 | fail "type error: %s expects a float" opt_name 20 | 21 | let as_string opt_name = function 22 | | String s -> 23 | s 24 | | _ -> 25 | fail "type error: %s expects a string" opt_name 26 | end 27 | 28 | (** A configuration option is given by a name and a value *) 29 | type parameter = string * Value.t 30 | 31 | module WithDefault = struct 32 | (** Either a default value or a user-defined value *) 33 | type 'a t = Default of 'a | Value of 'a 34 | 35 | (** Get the value hold by a {!t} *) 36 | let value = function Default x | Value x -> x 37 | end 38 | 39 | type oracle_type = Expectation | Singular 40 | 41 | (** A record holding all the configuration options *) 42 | type t = 43 | { mutable grammar_file: string 44 | ; mutable verbosity: int 45 | ; mutable random_seed: int option 46 | ; mutable oracle_type: oracle_type 47 | ; mutable size_min: int WithDefault.t 48 | ; mutable size_max: int WithDefault.t 49 | ; mutable epsilon1: float WithDefault.t 50 | ; mutable epsilon2: float WithDefault.t 51 | ; mutable epsilon3: float WithDefault.t 52 | ; mutable with_id: bool 53 | ; mutable with_type: bool 54 | ; mutable max_try: int WithDefault.t 55 | ; mutable output_type: int 56 | ; mutable fileName: string 57 | ; mutable zstart: float WithDefault.t 58 | ; mutable with_state: bool 59 | ; mutable state_file: string 60 | ; mutable randgen: string 61 | ; mutable indent: bool 62 | ; mutable print_oracle: string 63 | ; mutable use_oracle: string } 64 | 65 | (** Global variable holding the current configuration *) 66 | let globals = 67 | { grammar_file= "" 68 | ; verbosity= 1 69 | ; random_seed= None 70 | ; oracle_type= Expectation 71 | ; size_min= Default 10 72 | ; size_max= Default 20 73 | ; epsilon1= Default Boltzmann.Oracle.Naive.default_config.epsilon1 74 | ; epsilon2= Default Boltzmann.Oracle.Naive.default_config.epsilon2 75 | ; epsilon3= Default Boltzmann.Oracle.Naive.default_config.epsilon3 76 | ; with_id= false 77 | ; with_type= false 78 | ; max_try= Default 100_000 79 | ; output_type= 0 80 | ; fileName= "" 81 | ; zstart= Default 0.0 82 | ; with_state= false 83 | ; state_file= "" 84 | ; randgen= "ocaml" 85 | ; indent= false 86 | ; print_oracle= "" 87 | ; use_oracle= "" } 88 | 89 | (** Helper function to sanitise config options and set them. The [preserve] flag 90 | tells whether an option that had previously been set should be preserved or 91 | erased by the new option. *) 92 | let set ?(preserve = false) name value = 93 | match name with 94 | | "min" -> ( 95 | let value = Value.as_int name value in 96 | if value < 0 then fail "min must be non-negative"; 97 | match globals.size_min with 98 | | Default _ -> 99 | globals.size_min <- Value value 100 | | Value _ -> 101 | if not preserve then globals.size_min <- Value value ) 102 | | "max" -> ( 103 | let value = Value.as_int name value in 104 | if value < 0 then fail "max must be non-negative"; 105 | match globals.size_max with 106 | | Default _ -> 107 | globals.size_max <- Value value 108 | | Value _ -> 109 | if not preserve then globals.size_max <- Value value ) 110 | | "seed" -> ( 111 | match globals.random_seed with 112 | | Some _ when preserve -> 113 | () 114 | | _ -> 115 | globals.random_seed <- Some (Value.as_int "seed" value) ) 116 | | "eps1" -> ( 117 | let value = Value.as_float name value in 118 | if value <= 0. then fail "eps1 must be positive"; 119 | match globals.epsilon1 with 120 | | Default _ -> 121 | globals.epsilon1 <- Value value 122 | | Value _ -> 123 | if not preserve then globals.epsilon1 <- Value value ) 124 | | "eps2" -> ( 125 | let value = Value.as_float name value in 126 | if value <= 0. then fail "eps2 must be positive"; 127 | match globals.epsilon2 with 128 | | Default _ -> 129 | globals.epsilon2 <- Value value 130 | | Value _ -> 131 | if not preserve then globals.epsilon2 <- Value value ) 132 | | "try" -> ( 133 | let value = Value.as_int name value in 134 | if value <= 0 then fail "try must be positive"; 135 | match globals.max_try with 136 | | Default _ -> 137 | globals.max_try <- Value value 138 | | Value _ -> 139 | if not preserve then globals.max_try <- Value value ) 140 | | "zstart" -> ( 141 | let value = Value.as_float name value in 142 | if value < 0. || value > 1. then fail "zstart must be between 0 and 1"; 143 | match globals.zstart with 144 | | Default _ -> 145 | globals.zstart <- Value value 146 | | Value _ -> 147 | if not preserve then globals.zstart <- Value value ) 148 | | "randgen" -> 149 | let value = Value.as_string name value in 150 | let valid_names = ["ocaml"; "randu"; "randnull"] in 151 | if not (List.mem value valid_names) then 152 | fail "rangen must belong to: %s" (String.concat "|" valid_names); 153 | globals.randgen <- value 154 | | _ -> 155 | fail "Unknown parameter: %s" name 156 | 157 | (** Same as {!set} but takes a list of parameters *) 158 | let set_all ?(preserve = false) parameters = 159 | List.iter (fun (name, value) -> set ~preserve name value) parameters 160 | 161 | (** Perform sanity checks involving several config values *) 162 | let extra_checks () = 163 | if globals.size_min > globals.size_max then 164 | fail "size_min must be smaller than size_max" 165 | -------------------------------------------------------------------------------- /src/lib/boltzmann/boltzmann.ml: -------------------------------------------------------------------------------- 1 | (******************************************************** 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: Gen * 5 | * ------- * 6 | * The Boltzmann random generator * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | (** {2 Free Bolzmann generators (low-level interface)} *) 16 | 17 | let rec list_make_append n x l = 18 | if n <= 0 then l else list_make_append (n - 1) x (x :: l) 19 | 20 | let free_size (module R : Randtools.S) ~size_max wgrm = 21 | let open WeightedGrammar in 22 | let rec gen_size s = function 23 | (* Generation complete *) 24 | | [] -> 25 | s 26 | (* Add the atom size to the total size and continue. *) 27 | | Z n :: next -> 28 | let s = s + n in 29 | if s > size_max then s else gen_size s next 30 | (* Lookup the definition of i and add it to the call stack *) 31 | | Ref i :: next -> 32 | gen_size s (wgrm.rules.(i) :: next) 33 | (* Draw the length of the list according to the geometric law and add the 34 | corresponding number of [expr] to the call stack *) 35 | | Seq (w, expr) :: next -> 36 | let n = Randtools.geometric (module R) w in 37 | gen_size s (list_make_append n expr next) 38 | (* Add all components of the product **in reverse order** to the call stack. *) 39 | | Product args :: next -> 40 | gen_size s (List.rev_append args next) 41 | (* Add one term of the union to the call stack and drop the other one. *) 42 | | Union args :: next -> 43 | gen_union_size s (R.float 1.) next args 44 | and gen_union_size s r next = function 45 | | [] -> 46 | assert false 47 | | (w, e) :: args -> 48 | if r <= w then gen_size s (e :: next) 49 | else gen_union_size s (r -. w) next args 50 | in 51 | gen_size 0 [wgrm.rules.(0)] 52 | 53 | type instr = 54 | | Gen of WeightedGrammar.expression 55 | | Label of string 56 | | Tuple of int 57 | 58 | let rec pop_n n acc xs = 59 | if n = 0 then (List.rev acc, xs) 60 | else 61 | match xs with 62 | | [] -> 63 | invalid_arg "pop_n" 64 | | x :: xs -> 65 | pop_n (n - 1) (x :: acc) xs 66 | 67 | let pop = function [] -> invalid_arg "pop" | x :: xs -> (x, xs) 68 | 69 | let relabel name : string Tree.t -> string Tree.t = function 70 | | Label _ as tree -> 71 | Label (name, [tree]) 72 | | Tuple children -> 73 | Label (name, children) 74 | 75 | let find_pos x xs = 76 | let len = Array.length xs in 77 | let rec aux i = 78 | if i = len then invalid_arg "find_pos" 79 | else if xs.(i) = x then i 80 | else aux (i + 1) 81 | in 82 | aux 0 83 | 84 | let free_gen (module R : Randtools.S) wgrm = 85 | let open WeightedGrammar in 86 | let rec gen_tree size built = function 87 | (* Generation complete *) 88 | | [] -> 89 | (built, size) 90 | (* Build a named node. *) 91 | | Label name :: next -> 92 | let tree, built = pop built in 93 | gen_tree size (relabel name tree :: built) next 94 | (* Built a tuple *) 95 | | Tuple arity :: next -> 96 | let children, built = pop_n arity [] built in 97 | gen_tree size (Tree.Tuple children :: built) next 98 | (* Add the atom size to the total size and generate an empty tuple. *) 99 | | Gen (Z n) :: next -> 100 | gen_tree (size + n) (Tree.Tuple [] :: built) next 101 | (* Lookup the definition of i and add it to the call stack *) 102 | | Gen (Ref i) :: next -> 103 | gen_tree size built (Gen wgrm.rules.(i) :: Label wgrm.names.(i) :: next) 104 | (* Draw the length of the list according to the geometric law and add the 105 | corresponding number of [expr] to the call stack *) 106 | | Gen (Seq (w, expr)) :: next -> 107 | let n = Randtools.geometric (module R) w in 108 | gen_tree size built (list_make_append n (Gen expr) (Tuple n :: next)) 109 | (* Add components of the product **in reverse order** to the call stack. *) 110 | | Gen (Product args) :: next -> 111 | gen_tree size built 112 | (List.fold_left 113 | (fun next e -> Gen e :: next) 114 | (Tuple (List.length args) :: next) 115 | args ) 116 | (* Add one term of the union to the call stack and drop the other ones. *) 117 | | Gen (Union args) :: next -> 118 | gen_union size built (R.float 1.) next args 119 | and gen_union size vals r next = function 120 | | [] -> 121 | assert false 122 | | (w, e) :: args -> 123 | if r <= w then gen_tree size vals (Gen e :: next) 124 | else gen_union size vals (r -. w) next args 125 | in 126 | fun name -> 127 | let i = find_pos name wgrm.names in 128 | match gen_tree 0 [] [Gen (Ref i)] with 129 | | [tree], size -> 130 | (tree, size) 131 | | _ -> 132 | failwith "internal error" 133 | 134 | (** {2 Rejection sampling in a size window (high-level interface)} *) 135 | 136 | let search_seed (type state) (module R : Randtools.S with type State.t = state) 137 | ~size_min ~size_max ?max_try rules : (int * state) option = 138 | let rec search nb_try = 139 | if nb_try = 0 then None 140 | else 141 | let state = R.get_state () in 142 | let size = free_size (module R) ~size_max rules in 143 | if size < size_min || size > size_max then search (nb_try - 1) 144 | else Some (size, state) 145 | in 146 | search (Option.fold ~none:(-1) ~some:Fun.id max_try) 147 | 148 | let generator grammar oracle rng ~size_min ~size_max ~max_try = 149 | let module R = (val rng : Randtools.S) in 150 | let wgrm = WeightedGrammar.of_grammar oracle grammar in 151 | match search_seed (module R) wgrm ~size_min ~size_max ~max_try with 152 | | Some (size, state) -> 153 | R.set_state state; 154 | let tree, size' = free_gen rng wgrm wgrm.names.(0) in 155 | assert (size = size'); 156 | (* sanity check *) 157 | Some (tree, size) 158 | | None -> 159 | None 160 | 161 | module WeightedGrammar = WeightedGrammar 162 | module Oracle = Oracle 163 | -------------------------------------------------------------------------------- /src/lib/tree/tree.ml: -------------------------------------------------------------------------------- 1 | (********************************************************* 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: Tree * 5 | * ------- * 6 | * Internal representation of trees and export tools * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | type 'a t = Label of 'a * 'a t list | Tuple of 'a t list 16 | 17 | (** {2 Iterators} *) 18 | 19 | let fold ~label ~tuple = 20 | let rec dfs k = function 21 | | Label (l, children) -> 22 | dfs_forest (fun xs -> k (label l xs)) children 23 | | Tuple children -> 24 | dfs_forest (fun xs -> k (tuple xs)) children 25 | and dfs_forest k = function 26 | | [] -> 27 | k [] 28 | | tree :: forest -> 29 | dfs (fun x -> dfs_forest (fun xs -> k (x :: xs)) forest) tree 30 | in 31 | dfs Fun.id 32 | 33 | (** {2 Output functions} *) 34 | 35 | (* temporary workaround *) 36 | let annotate tree = 37 | let id = ref (-1) in 38 | let next () = incr id; !id in 39 | fold 40 | ~label:(fun l children -> Label ((l, next () |> string_of_int), children)) 41 | ~tuple:(fun children -> Tuple children) 42 | tree 43 | 44 | (* Some pretty printing utilities *) 45 | 46 | let print_list ~print_elem ~print_op ~print_dl ~print_cl xs = 47 | let rec aux = function 48 | | [] -> 49 | () 50 | | [x] -> 51 | print_elem x 52 | | x :: xs -> 53 | print_elem x; print_dl (); aux xs 54 | in 55 | print_op (); aux xs; print_cl () 56 | 57 | let string_of_list_buf print_elem buf op dl cl = 58 | print_list ~print_elem 59 | ~print_op:(fun () -> Buffer.add_string buf op) 60 | ~print_dl:(fun () -> Buffer.add_string buf dl) 61 | ~print_cl:(fun () -> Buffer.add_string buf cl) 62 | 63 | let output_list out output_elem op dl cl = 64 | print_list 65 | ~print_elem:(fun x -> output_elem out x) 66 | ~print_op:(fun () -> output_string out op) 67 | ~print_dl:(fun () -> output_string out dl) 68 | ~print_cl:(fun () -> output_string out cl) 69 | 70 | let add_indent = 71 | let s = ref (String.make 16 ' ') in 72 | let grow n = 73 | let len = String.length !s in 74 | s := String.make (max n (2 * (len + 1))) ' ' 75 | in 76 | fun buf n -> 77 | let len = String.length !s in 78 | if 2 * n >= len then grow (2 * n); 79 | Buffer.add_substring buf !s 0 (2 * n) 80 | 81 | (* .arb *) 82 | 83 | let tree_out (show_type : bool) (show_id : bool) = 84 | let label typ id = 85 | if show_type then if show_id then typ ^ ":" ^ id else typ 86 | else if show_id then id 87 | else "" 88 | in 89 | let rec print_tree out = function 90 | | Label ((typ, id), ts) -> 91 | output_string out (label typ id); 92 | output_list out 93 | (fun (out : out_channel) t -> print_tree out t) 94 | "[" "," "]" ts 95 | | Tuple ts -> 96 | output_list out 97 | (fun (out : out_channel) t -> print_tree out t) 98 | "[" "," "]" ts 99 | in 100 | fun tree out -> print_tree out tree 101 | 102 | (* .xml *) 103 | 104 | let attributes buf typ id show_type show_id = 105 | Buffer.add_string buf (if show_type then " type=\"" ^ typ ^ "\"" else ""); 106 | Buffer.add_string buf (if show_id then " id=\"" ^ id ^ "\"" else "") 107 | 108 | let xml_of_tree (show_type : bool) (show_id : bool) t = 109 | let buf = Buffer.create 1024 in 110 | let rec aux = function 111 | | Label ((typ, id), ts) -> 112 | Buffer.add_string buf ""; 115 | string_of_list_buf aux buf "" "" "" ts 116 | | Tuple ts -> 117 | Buffer.add_string buf ""; 118 | string_of_list_buf aux buf "" "" "" ts 119 | in 120 | Buffer.add_string buf ""; 121 | aux t; 122 | Buffer.add_string buf ""; 123 | buf 124 | 125 | let indent_xml_of_tree (show_type : bool) (show_id : bool) t = 126 | let buf = Buffer.create 1024 in 127 | let rec tree level = function 128 | | Label ((typ, id), ts) -> 129 | add_indent buf level; 130 | Buffer.add_string buf "\n"; 133 | forest (level + 1) ts; 134 | add_indent buf level; 135 | Buffer.add_string buf "\n" 136 | | Tuple ts -> 137 | add_indent buf level; 138 | Buffer.add_string buf ""; 139 | forest (level + 1) ts; 140 | add_indent buf level; 141 | Buffer.add_string buf "\n" 142 | and forest level = function 143 | | [] -> 144 | () 145 | | [t] -> 146 | tree level t 147 | | t :: f' -> 148 | tree level t; forest level f' 149 | in 150 | Buffer.add_string buf "\n\n"; 151 | tree 1 t; 152 | Buffer.add_string buf "\n"; 153 | buf 154 | 155 | (* .dot *) 156 | 157 | let dot_of_tree (show_type : bool) (show_id : bool) (indent : bool) t = 158 | let label typ id = 159 | let aux typ id = 160 | if show_type then if show_id then typ ^ ":" ^ id else typ 161 | else if show_id then id 162 | else "" 163 | in 164 | let l = aux typ id in 165 | if l = "" then " [shape=point];\n" else " [label=\"" ^ l ^ "\"];\n" 166 | in 167 | let buf = Buffer.create 1024 in 168 | let rec nodes tid = function 169 | | Label ((typ, id), ts) -> 170 | Buffer.add_string buf " "; 171 | Buffer.add_string buf id; 172 | Buffer.add_string buf (label typ id); 173 | nodes_forest tid ts 174 | | Tuple ts -> 175 | Buffer.add_string buf " "; 176 | Buffer.add_string buf ("t" ^ string_of_int tid); 177 | Buffer.add_char buf '\n'; 178 | nodes_forest (tid + 1) ts 179 | and nodes_forest tid = function 180 | | [] -> 181 | tid 182 | | t :: ts -> 183 | let tid = nodes tid t in 184 | nodes_forest tid ts 185 | in 186 | let rec edges level tid parent = function 187 | | Label ((_, id), ts) -> 188 | if indent then add_indent buf level; 189 | Buffer.add_string buf parent; 190 | Buffer.add_string buf " -> "; 191 | Buffer.add_string buf id; 192 | Buffer.add_string buf ";\n"; 193 | edges_forest (level + 1) tid id ts 194 | | Tuple ts -> 195 | let id = "t" ^ string_of_int tid in 196 | if indent then add_indent buf level; 197 | Buffer.add_string buf parent; 198 | Buffer.add_string buf " -> "; 199 | Buffer.add_string buf id; 200 | Buffer.add_string buf ";\n"; 201 | edges_forest (level + 1) (tid + 1) id ts 202 | and edges_forest level tid parent = function 203 | | [] -> 204 | tid 205 | | t :: ts -> 206 | let tid = edges level tid parent t in 207 | edges_forest level tid parent ts 208 | in 209 | Buffer.add_string buf "digraph {\n"; 210 | let _ = nodes 0 t in 211 | let _ = 212 | match t with 213 | | Label ((_, id), ts) -> 214 | let level = 1 in 215 | let parent = id in 216 | let tid = 0 in 217 | edges_forest level tid parent ts 218 | | Tuple ts -> 219 | let level = 1 in 220 | let parent = "t0" in 221 | let tid = 1 in 222 | edges_forest level tid parent ts 223 | in 224 | Buffer.add_string buf "}\n"; 225 | buf 226 | 227 | (* public functions *) 228 | 229 | let output_arb ~show_type ~show_id ~indent out tree = 230 | if indent then 231 | Format.printf "Warning: -indent not supported for the arb format@."; 232 | tree_out show_type show_id tree out; 233 | output_string out "\n" 234 | 235 | let output_dot ~show_type ~show_id ~indent out tree = 236 | let buf = dot_of_tree show_type show_id indent tree in 237 | Buffer.output_buffer out buf 238 | 239 | let output_xml ~show_type ~show_id ~indent out tree = 240 | let buf = 241 | if indent then indent_xml_of_tree show_type show_id tree 242 | else xml_of_tree show_type show_id tree 243 | in 244 | Buffer.output_buffer out buf 245 | -------------------------------------------------------------------------------- /src/lib/boltzmann/oracle.ml: -------------------------------------------------------------------------------- 1 | (** Singularity search and approximation of generating functions *) 2 | 3 | (** For the grammars supported by Arbogen, it is enough to know the 4 | values of the different generating functions at one point [z]. *) 5 | type t = {z: float; values: float array; derivate_values: float array} 6 | 7 | let init n z = {z; values= Array.make n 0.; derivate_values= Array.make n 0.} 8 | 9 | let copy oracle = 10 | { z= oracle.z 11 | ; values= Array.copy oracle.values 12 | ; derivate_values= Array.copy oracle.derivate_values } 13 | 14 | (** {2 Generating function evaluation} *) 15 | 16 | (** Evaluation of generating functions of grammar elements based on the values 17 | provided by an oracle. *) 18 | module Eval = struct 19 | (** Evaluate an expression. *) 20 | let expression oracle = 21 | let rec aux : int Grammar.expression -> float = function 22 | | Z n -> 23 | oracle.z ** float_of_int n 24 | | Product args -> 25 | List.fold_left (fun p e -> p *. aux e) 1. args 26 | | Union args -> 27 | List.fold_left (fun s e -> s +. aux e) 0. args 28 | | Seq e -> 29 | 1. /. (1. -. aux e) 30 | | Ref i -> 31 | oracle.values.(i) 32 | in 33 | aux 34 | 35 | let deriv_expression oracle = 36 | let rec aux : int Grammar.expression -> float = function 37 | | Z n -> 38 | if n == 0 then 0. 39 | else float_of_int n *. (oracle.z ** float_of_int (n - 1)) 40 | | Product args -> 41 | let factors = List.map (fun e -> (expression oracle e, aux e)) args in 42 | let product = List.fold_left (fun p (e, _) -> p *. e) 1. factors in 43 | List.fold_left 44 | (fun res (e, e') -> res +. (product *. e' /. e)) 45 | 0. factors 46 | | Union args -> 47 | List.fold_left (fun s e -> s +. aux e) 0. args 48 | | Seq e -> 49 | aux e /. ((1. -. expression oracle e) ** 2.) 50 | | Ref i -> 51 | oracle.derivate_values.(i) 52 | in 53 | aux 54 | 55 | (** Same as [!grammar] but the result of the evaluation is stored in the array 56 | passed as first argument. *) 57 | let grammar_inplace oracle_dest oracle (grammar : Grammar.t) = 58 | Array.iteri 59 | (fun i r -> oracle_dest.values.(i) <- expression oracle r) 60 | grammar.rules; 61 | Array.iteri 62 | (fun i r -> oracle_dest.derivate_values.(i) <- deriv_expression oracle r) 63 | grammar.rules 64 | 65 | (** Evaluate each rule of the grammar. *) 66 | let grammar oracle (grammar : Grammar.t) = 67 | let dest = init (Array.length grammar.rules) oracle.z in 68 | grammar_inplace dest oracle grammar; 69 | dest 70 | end 71 | 72 | (** {2 Naive oracle implementation} *) 73 | 74 | (** Naive oracle obtained by approximating fix points by simple iteration *) 75 | module Naive = struct 76 | type value = Val of t | Diverge 77 | 78 | type config = 79 | {epsilon1: float; epsilon2: float; epsilon3: float; zstart: float} 80 | 81 | (** The distance for the uniform norm *) 82 | let distance (v1 : float array) (v2 : float array) = 83 | let dist = ref 0. in 84 | Array.iter2 (fun x y -> dist := max !dist (abs_float (x -. y))) v1 v2; 85 | !dist 86 | 87 | let diverge (epsilon2 : float) : float array -> bool = 88 | (* XXX. dangerous but letting too_big grow too much is dangerous too *) 89 | let too_big = min (1.0 /. epsilon2) 1000. in 90 | let is_nan x = x <> x in 91 | Array.exists (fun x -> x > too_big || x < 0. || is_nan x) 92 | 93 | let iteration_simple grammar init_values epsilon2 = 94 | (* Format.eprintf "COUCOU !!! @."; *) 95 | let rec iterate v1 v2 = 96 | (* Array.iter (Format.eprintf "%f,") v1.values; *) 97 | (* Format.eprintf "@."; *) 98 | Eval.grammar_inplace v2 v1 grammar; 99 | if diverge epsilon2 v2.values then Diverge 100 | else if distance v1.values v2.values <= epsilon2 then Val v2 101 | else iterate v2 v1 102 | in 103 | (* Only allocate to arrays and swap them at each iteration *) 104 | let v1 = copy init_values in 105 | let v2 = copy init_values in 106 | iterate v1 v2 107 | 108 | let search_singularity {epsilon1; epsilon2; zstart; _} grammar = 109 | let len = Array.length grammar.Grammar.rules in 110 | let rec search init_values zmin zmax = 111 | if zmax -. zmin < epsilon1 then 112 | ( zmin 113 | , zmax 114 | , iteration_simple grammar {init_values with z= zmin} epsilon2 ) 115 | else 116 | match iteration_simple grammar init_values epsilon2 with 117 | | Val values -> 118 | search {values with z= (values.z +. zmax) /. 2.} values.z zmax 119 | | Diverge -> 120 | let init_values' = init len ((zmin +. init_values.z) /. 2.) in 121 | search init_values' zmin init_values.z 122 | in 123 | let init_values = init len zstart in 124 | match search init_values 0. 1. with 125 | | _, _, Diverge -> 126 | failwith "search_singularity failed to find the singularity" 127 | | zmin, zmax, Val v -> 128 | (zmin, zmax, v) 129 | 130 | (* Find the parameter such that size of `Ref 0` is at `epsilon3 * n` of `n` *) 131 | let search_expectation {epsilon1; epsilon2; epsilon3; zstart} n grammar = 132 | let len = Array.length grammar.Grammar.rules in 133 | let rec search init_values zmin zmax = 134 | if zmax -. zmin < epsilon1 then 135 | ( zmin 136 | , zmax 137 | , iteration_simple grammar {init_values with z= zmin} epsilon2 ) 138 | else 139 | let eval = iteration_simple grammar init_values epsilon2 in 140 | match eval with 141 | | Diverge -> 142 | let init_values' = init len ((zmin +. init_values.z) /. 2.) in 143 | search init_values' zmin init_values.z 144 | | Val v -> 145 | let expectation = v.z *. v.derivate_values.(0) /. v.values.(0) in 146 | let diff = (float_of_int n -. expectation) /. float_of_int n in 147 | if abs_float diff < epsilon3 then (zmin, zmax, eval) 148 | else if diff < 0. then 149 | let init_values' = init len ((zmin +. init_values.z) /. 2.) in 150 | search init_values' zmin init_values.z 151 | else 152 | let init_values' = init len ((zmax +. init_values.z) /. 2.) in 153 | search init_values' init_values.z zmax 154 | in 155 | let init_values = init len zstart in 156 | match search init_values 0. 1. with 157 | | _, _, Diverge -> 158 | failwith "search_singularity failed to find the singularity" 159 | | zmin, zmax, Val v -> 160 | (zmin, zmax, v) 161 | 162 | let default_config = 163 | {epsilon1= 1e-9; epsilon2= 1e-9; zstart= 0.; epsilon3= 0.001} 164 | 165 | let make_singular ?(config = default_config) grammar = 166 | let _, _, values = search_singularity config grammar in 167 | values 168 | 169 | let make_expectation ?(config = default_config) n grammar = 170 | let _, _, values = search_expectation config n grammar in 171 | values 172 | end 173 | 174 | (** Dump an oracle *) 175 | let dump fmt {z; values; derivate_values} = 176 | let dump_floats fmt floats = 177 | (Format.pp_print_list 178 | ~pp_sep:(fun fmt () -> Format.pp_print_char fmt ' ') 179 | (fun fmt -> Format.fprintf fmt "%.18g") ) 180 | fmt (Array.to_list floats) 181 | in 182 | Format.fprintf fmt "z: %.18g\n" z; 183 | Format.fprintf fmt "values: %a\n" dump_floats values; 184 | Format.fprintf fmt "derivatives: %a" dump_floats derivate_values 185 | 186 | (** Dump an oracle to a string *) 187 | let dumps = Format.asprintf "%a" dump 188 | 189 | let loads : string -> t = 190 | let strip_prefix string prefix = 191 | let prefix_len = String.length prefix in 192 | let string_len = String.length string in 193 | if prefix_len > string_len && String.sub string 0 prefix_len <> prefix then 194 | invalid_arg ("Oracle.loads / " ^ prefix); 195 | String.sub string prefix_len (string_len - prefix_len) 196 | in 197 | let parse_floats s = 198 | s |> String.split_on_char ' ' |> List.map float_of_string |> Array.of_list 199 | in 200 | fun s -> 201 | let lines = String.split_on_char '\n' s in 202 | match lines with 203 | | [z; values; derivatives] | [z; values; derivatives; ""] -> 204 | { z= float_of_string (strip_prefix z "z: ") 205 | ; values= parse_floats (strip_prefix values "values: ") 206 | ; derivate_values= parse_floats (strip_prefix derivatives "derivatives: ") 207 | } 208 | | lines -> 209 | Format.ksprintf invalid_arg "Oracle.loads (found %d lines)" 210 | (List.length lines) 211 | -------------------------------------------------------------------------------- /tests/test_gen_sing.ml: -------------------------------------------------------------------------------- 1 | let fail format = Format.kasprintf (fun s -> Alcotest.fail s) format 2 | 3 | (* XXX. *) 4 | let rec pp_tree fmt = function 5 | | Tree.Label (typ, children) -> 6 | let pp_sep fmt () = Format.fprintf fmt ",@," in 7 | Format.fprintf fmt "%s[%a]" typ 8 | (Format.pp_print_list ~pp_sep pp_tree) 9 | children 10 | | Tree.Tuple children -> 11 | let pp_sep fmt () = Format.fprintf fmt ",@," in 12 | Format.fprintf fmt "[%a]" (Format.pp_print_list ~pp_sep pp_tree) children 13 | 14 | let check_size size_min size_max expected actual = 15 | if actual <> expected then 16 | fail "the size computed by arbogen is wrong: %d <> %d" actual expected 17 | else if actual < size_min || actual > size_max then 18 | fail "wrong size: %d not in [%d, %d]" actual size_min size_max 19 | 20 | let generate_from_wg wg ~size_min ~size_max = 21 | let module Rng = Randtools.OcamlRandom in 22 | let max_try = 1_000_000 in 23 | match Boltzmann.search_seed (module Rng) ~size_min ~size_max ~max_try wg with 24 | | Some (_, state) -> 25 | Rng.set_state state; 26 | Boltzmann.free_gen (module Rng) wg wg.names.(0) 27 | | None -> 28 | assert false 29 | 30 | let generate ?(seed = 42424242) grammar = 31 | let oracle = Boltzmann.Oracle.Naive.make_singular grammar in 32 | Randtools.OcamlRandom.init seed; 33 | let wg = Boltzmann.WeightedGrammar.of_grammar oracle grammar in 34 | generate_from_wg wg 35 | 36 | (** {2 Correctness tests} *) 37 | 38 | exception Invalid 39 | 40 | let valid_binary () = 41 | let size_min, size_max = (20, 30) in 42 | let grammar = 43 | Grammar.{names= [|"B"|]; rules= [|Union [Z 0; Product [Z 1; Ref 0; Ref 0]]|]} 44 | in 45 | let rec size = function 46 | | Tree.Label ("B", [Tuple []; l; r]) -> 47 | 1 + size l + size r 48 | | Tree.Label ("B", []) -> 49 | 0 50 | | _ -> 51 | raise Invalid 52 | in 53 | let tree, gen_size = generate grammar ~size_min ~size_max in 54 | try check_size size_min size_max gen_size (size tree) 55 | with Invalid -> fail "not a binary tree: %a" pp_tree tree 56 | 57 | let valid_nary () = 58 | let size_min, size_max = (20, 30) in 59 | let grammar = 60 | Grammar. 61 | { names= [|"T"; "S"|] 62 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 63 | in 64 | let rec size = function 65 | | Tree.Label ("T", [Tuple []; s]) -> 66 | 1 + size s 67 | | Tree.Label ("S", []) -> 68 | 0 69 | | Tree.Label ("S", [x; xs]) -> 70 | size x + size xs 71 | | _ -> 72 | raise Invalid 73 | in 74 | let tree, gen_size = generate grammar ~size_min ~size_max in 75 | try check_size size_min size_max gen_size (size tree) 76 | with Invalid -> fail "not an nary tree: %a" pp_tree tree 77 | 78 | let valid_nary_bis () = 79 | let size_min, size_max = (20, 30) in 80 | let grammar = 81 | Grammar.{names= [|"T"|]; rules= [|Product [Z 1; Seq (Ref 0)]|]} 82 | in 83 | let rec size = function 84 | | Tree.Label ("T", [Tuple []]) -> 85 | 1 86 | | Tree.Label ("T", [Tuple []; Tuple children]) -> 87 | List.fold_left (fun acc t -> acc + size t) 1 children 88 | | _ -> 89 | raise Invalid 90 | in 91 | let tree, gen_size = generate grammar ~size_min ~size_max in 92 | try check_size size_min size_max gen_size (size tree) 93 | with Invalid -> fail "not an nary tree (bis): %a" pp_tree tree 94 | 95 | let valid_motzkin () = 96 | let size_min, size_max = (40, 50) in 97 | let grammar = 98 | Grammar. 99 | { names= [|"M"|] 100 | ; rules= [|Union [Z 0; Product [Z 1; Ref 0]; Product [Z 1; Ref 0; Ref 0]]|] 101 | } 102 | in 103 | let rec size = function 104 | | Tree.Label ("M", []) -> 105 | 0 106 | | Tree.Label ("M", [Tuple []; t]) -> 107 | 1 + size t 108 | | Tree.Label ("M", [Tuple []; l; r]) -> 109 | 1 + size l + size r 110 | | _ -> 111 | raise Invalid 112 | in 113 | let tree, gen_size = generate grammar ~size_min ~size_max in 114 | try check_size size_min size_max gen_size (size tree) 115 | with Invalid -> fail "not a Motzkin tree: %a" pp_tree tree 116 | 117 | let valid_shuffle_plus () = 118 | let size_min, size_max = (10, 100) in 119 | let grammar = 120 | Grammar. 121 | { names= [|"A"; "Ashuffle"; "Aplus"|] 122 | ; rules= 123 | [| Union [Ref 1; Ref 2] 124 | ; Product [Z 1; Seq (Ref 0)] 125 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 126 | in 127 | let get_type = function 128 | | Tree.Label ("Aplus", _) -> 129 | `plus 130 | | Tree.Label ("Ashuffle", _) -> 131 | `shuffle 132 | | _ -> 133 | raise Invalid 134 | in 135 | let sum size_fun = List.fold_left (fun acc t -> acc + size_fun t) 0 in 136 | let rec size typ tree = 137 | match (typ, tree) with 138 | | `A, Tree.Label ("A", [t]) -> 139 | size (get_type t) t 140 | | `plus, Tree.Label ("Aplus", [x; x'; Tuple xs]) -> 141 | sum (size `shuffle) (x :: x' :: xs) 142 | | `shuffle, Tree.Label ("Ashuffle", [Tuple []; Tuple children]) -> 143 | 1 + sum (size `A) children 144 | | _ -> 145 | raise Invalid 146 | in 147 | let tree, gen_size = generate ~seed:1234512345 grammar ~size_min ~size_max in 148 | try check_size size_min size_max gen_size (size `A tree) 149 | with Invalid -> fail "not a shuffle+ tree: %a" pp_tree tree 150 | 151 | let correctness = 152 | [ ("binary trees", `Quick, valid_binary) 153 | ; ("nary trees", `Quick, valid_nary) 154 | ; ("nary trees (bis)", `Quick, valid_nary_bis) 155 | ; ("Motzkin trees", `Quick, valid_motzkin) 156 | ; ("shuffle+ trees", `Quick, valid_shuffle_plus) ] 157 | 158 | (** {2 Statistical tests} *) 159 | 160 | (** Chi square test of adequation. *) 161 | let chi_square degree ~expected ~actual = 162 | let chi2 = [|0.; 3.84; 5.99; 7.81; 9.49; 11.07|] in 163 | if 164 | degree >= Array.length chi2 165 | || Array.length expected <> degree + 1 166 | || Array.length actual <> degree + 1 167 | then invalid_arg "chi_square"; 168 | let _, test = 169 | Array.fold_left 170 | (fun (i, t) ni -> 171 | let actual = float_of_int ni in 172 | (i + 1, t +. (((expected.(i) -. actual) ** 2.) /. expected.(i))) ) 173 | (0, 0.) actual 174 | in 175 | test <= chi2.(degree) 176 | 177 | module Binary = struct 178 | let catalan = [|1; 1; 2; 5; 14; 42|] 179 | 180 | let grammar = 181 | Boltzmann.WeightedGrammar. 182 | { names= [|"B"|] 183 | ; rules= [|Union [(0.5, Z 0); (0.5, Product [Z 1; Ref 0; Ref 0])]|] } 184 | 185 | let rank = 186 | let convolution n k = 187 | let rec sum acc i = 188 | if i > k then acc 189 | else sum (acc + (catalan.(i) * catalan.(n - 1 - i))) (i + 1) 190 | in 191 | sum 0 0 192 | in 193 | let rec size_and_rank : string Tree.t -> int * int = function 194 | | Label ("B", []) -> 195 | (0, 0) 196 | | Label ("B", [Tuple []; l; r]) -> 197 | let s1, r1 = size_and_rank l in 198 | let s2, r2 = size_and_rank r in 199 | let size = s1 + s2 + 1 in 200 | let rank = convolution size (s1 - 1) + (r1 * catalan.(s2)) + r2 in 201 | (size, rank) 202 | | _ -> 203 | assert false 204 | in 205 | fun tree -> snd (size_and_rank tree) 206 | 207 | (** Adequation with the Boltzmann distribution. *) 208 | let boltzmann_dist () = 209 | let store = Array.make 6 0 in 210 | let nb_iterations = 50000 in 211 | for _ = 1 to nb_iterations do 212 | let _, size = generate_from_wg grammar ~size_min:0 ~size_max:5 in 213 | store.(size) <- store.(size) + 1 214 | done; 215 | (* Chi-square test *) 216 | let expected = 217 | let foi = float_of_int in 218 | let arr = Array.init 6 (fun i -> foi catalan.(i) *. (0.25 ** foi i)) in 219 | let total_weight = Array.fold_left ( +. ) 0. arr in 220 | Array.iteri 221 | (fun i x -> arr.(i) <- x /. total_weight *. foi nb_iterations) 222 | arr; 223 | arr 224 | in 225 | Alcotest.(check bool) 226 | "distribution(size(binary))" true 227 | (chi_square 5 ~expected ~actual:store) 228 | 229 | (** Adequation with the uniform distribution at fixed size. *) 230 | let unif_dist () = 231 | let len = catalan.(3) in 232 | let store = Array.make len 0 in 233 | let nb_iterations = 5000 in 234 | for _ = 1 to nb_iterations do 235 | let tree, _ = generate_from_wg grammar ~size_min:3 ~size_max:3 in 236 | let r = rank tree in 237 | store.(r) <- store.(r) + 1 238 | done; 239 | (* Chi-square test *) 240 | let expected = 241 | Array.make len (float_of_int nb_iterations /. float_of_int len) 242 | in 243 | Alcotest.(check bool) 244 | "distribution(size(binary))" true 245 | (chi_square (len - 1) ~expected ~actual:store) 246 | end 247 | 248 | let statistical_tests = 249 | [ ("binary / boltz", `Quick, Binary.boltzmann_dist) 250 | ; ("binary / unif", `Quick, Binary.unif_dist) ] 251 | 252 | (** {2 All the tests} *) 253 | 254 | let () = 255 | Random.self_init (); 256 | Alcotest.run "gen_sing" 257 | [("correctness", correctness); ("statistical_tests", statistical_tests)] 258 | -------------------------------------------------------------------------------- /tests/test_gen_expect.ml: -------------------------------------------------------------------------------- 1 | let fail format = Format.kasprintf (fun s -> Alcotest.fail s) format 2 | 3 | (* XXX. *) 4 | let rec pp_tree fmt = function 5 | | Tree.Label (typ, children) -> 6 | let pp_sep fmt () = Format.fprintf fmt ",@," in 7 | Format.fprintf fmt "%s[%a]" typ 8 | (Format.pp_print_list ~pp_sep pp_tree) 9 | children 10 | | Tree.Tuple children -> 11 | let pp_sep fmt () = Format.fprintf fmt ",@," in 12 | Format.fprintf fmt "[%a]" (Format.pp_print_list ~pp_sep pp_tree) children 13 | 14 | let check_size size_min size_max expected actual = 15 | if actual <> expected then 16 | fail "the size computed by arbogen is wrong: %d <> %d" actual expected 17 | else if actual < size_min || actual > size_max then 18 | fail "wrong size: %d not in [%d, %d]" actual size_min size_max 19 | 20 | let generate_from_wg wg ~size_min ~size_max = 21 | let module Rng = Randtools.OcamlRandom in 22 | let max_try = 1_000_000 in 23 | match Boltzmann.search_seed (module Rng) ~size_min ~size_max ~max_try wg with 24 | | Some (_, state) -> 25 | Rng.set_state state; 26 | Boltzmann.free_gen (module Rng) wg wg.names.(0) 27 | | None -> 28 | assert false 29 | 30 | let generate ?(seed = 42424242) grammar size_min size_max = 31 | let expectation = (size_min + size_max) / 2 in 32 | let oracle = Boltzmann.Oracle.Naive.make_expectation expectation grammar in 33 | Randtools.OcamlRandom.init seed; 34 | let wg = Boltzmann.WeightedGrammar.of_grammar oracle grammar in 35 | generate_from_wg wg ~size_min ~size_max 36 | 37 | (** {2 Correctness tests} *) 38 | 39 | exception Invalid 40 | 41 | let valid_binary () = 42 | let size_min, size_max = (20, 30) in 43 | let grammar = 44 | Grammar.{names= [|"B"|]; rules= [|Union [Z 0; Product [Z 1; Ref 0; Ref 0]]|]} 45 | in 46 | let rec size = function 47 | | Tree.Label ("B", [Tuple []; l; r]) -> 48 | 1 + size l + size r 49 | | Tree.Label ("B", []) -> 50 | 0 51 | | _ -> 52 | raise Invalid 53 | in 54 | let tree, gen_size = generate grammar size_min size_max in 55 | try check_size size_min size_max gen_size (size tree) 56 | with Invalid -> fail "not a binary tree: %a" pp_tree tree 57 | 58 | let valid_nary () = 59 | let size_min, size_max = (20, 30) in 60 | let grammar = 61 | Grammar. 62 | { names= [|"T"; "S"|] 63 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 64 | in 65 | let rec size = function 66 | | Tree.Label ("T", [Tuple []; s]) -> 67 | 1 + size s 68 | | Tree.Label ("S", []) -> 69 | 0 70 | | Tree.Label ("S", [x; xs]) -> 71 | size x + size xs 72 | | _ -> 73 | raise Invalid 74 | in 75 | let tree, gen_size = generate grammar size_min size_max in 76 | try check_size size_min size_max gen_size (size tree) 77 | with Invalid -> fail "not an nary tree: %a" pp_tree tree 78 | 79 | let valid_nary_bis () = 80 | let size_min, size_max = (20, 30) in 81 | let grammar = 82 | Grammar.{names= [|"T"|]; rules= [|Product [Z 1; Seq (Ref 0)]|]} 83 | in 84 | let rec size = function 85 | | Tree.Label ("T", [Tuple []; Tuple []]) -> 86 | 1 87 | | Tree.Label ("T", [Tuple []; Tuple children]) -> 88 | List.fold_left (fun acc t -> acc + size t) 1 children 89 | | _ -> 90 | raise Invalid 91 | in 92 | let tree, gen_size = generate grammar size_min size_max in 93 | try check_size size_min size_max gen_size (size tree) 94 | with Invalid -> fail "not an nary tree (bis): %a" pp_tree tree 95 | 96 | let valid_motzkin () = 97 | let size_min, size_max = (40, 50) in 98 | let grammar = 99 | Grammar. 100 | { names= [|"M"|] 101 | ; rules= [|Union [Z 0; Product [Z 1; Ref 0]; Product [Z 1; Ref 0; Ref 0]]|] 102 | } 103 | in 104 | let rec size = function 105 | | Tree.Label ("M", []) -> 106 | 0 107 | | Tree.Label ("M", [Tuple []; t]) -> 108 | 1 + size t 109 | | Tree.Label ("M", [Tuple []; l; r]) -> 110 | 1 + size l + size r 111 | | _ -> 112 | raise Invalid 113 | in 114 | let tree, gen_size = generate grammar size_min size_max in 115 | try check_size size_min size_max gen_size (size tree) 116 | with Invalid -> fail "not a Motzkin tree: %a" pp_tree tree 117 | 118 | let valid_shuffle_plus () = 119 | let size_min, size_max = (10, 100) in 120 | let grammar = 121 | Grammar. 122 | { names= [|"A"; "Ashuffle"; "Aplus"|] 123 | ; rules= 124 | [| Union [Ref 1; Ref 2] 125 | ; Product [Z 1; Seq (Ref 0)] 126 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 127 | in 128 | let get_type = function 129 | | Tree.Label ("Aplus", _) -> 130 | `plus 131 | | Tree.Label ("Ashuffle", _) -> 132 | `shuffle 133 | | _ -> 134 | raise Invalid 135 | in 136 | let sum size_fun = List.fold_left (fun acc t -> acc + size_fun t) 0 in 137 | let rec size typ tree = 138 | match (typ, tree) with 139 | | `A, Tree.Label ("A", [t]) -> 140 | size (get_type t) t 141 | | `plus, Tree.Label ("Aplus", [x; x'; Tuple children]) -> 142 | sum (size `shuffle) (x :: x' :: children) 143 | | `shuffle, Tree.Label ("Ashuffle", [Tuple []; Tuple children]) -> 144 | 1 + sum (size `A) children 145 | | _ -> 146 | raise Invalid 147 | in 148 | let tree, gen_size = generate ~seed:1234512345 grammar size_min size_max in 149 | try check_size size_min size_max gen_size (size `A tree) 150 | with Invalid -> fail "not a shuffle+ tree: %a" pp_tree tree 151 | 152 | let correctness = 153 | [ ("binary trees", `Quick, valid_binary) 154 | ; ("nary trees", `Quick, valid_nary) 155 | ; ("nary trees (bis)", `Quick, valid_nary_bis) 156 | ; ("Motzkin trees", `Quick, valid_motzkin) 157 | ; ("shuffle+ trees", `Quick, valid_shuffle_plus) ] 158 | 159 | (** {2 Statistical tests} *) 160 | 161 | (** Chi square test of adequation. *) 162 | let chi_square degree ~expected ~actual = 163 | Format.eprintf "expected = "; 164 | Array.iter (Format.eprintf "%F ") expected; 165 | Format.eprintf "\n"; 166 | let chi2 = [|0.; 3.84; 5.99; 7.81; 9.49; 11.07|] in 167 | if 168 | degree >= Array.length chi2 169 | || Array.length expected <> degree + 1 170 | || Array.length actual <> degree + 1 171 | then invalid_arg "chi_square"; 172 | let _, test = 173 | Array.fold_left 174 | (fun (i, t) ni -> 175 | let actual = float_of_int ni in 176 | (i + 1, t +. (((expected.(i) -. actual) ** 2.) /. expected.(i))) ) 177 | (0, 0.) actual 178 | in 179 | Format.eprintf "(%F <= %F) ?@\n" test chi2.(degree); 180 | test <= chi2.(degree) 181 | 182 | module Binary = struct 183 | let catalan = [|1; 1; 2; 5; 14; 42|] 184 | 185 | let oracle, grammar = 186 | let g = 187 | Grammar. 188 | {names= [|"B"|]; rules= [|Union [Z 0; Product [Z 1; Ref 0; Ref 0]]|]} 189 | in 190 | let oracle = Boltzmann.Oracle.Naive.make_expectation 3 g in 191 | (oracle, Boltzmann.WeightedGrammar.of_grammar oracle g) 192 | 193 | let rank = 194 | let convolution n k = 195 | let rec sum acc i = 196 | if i > k then acc 197 | else sum (acc + (catalan.(i) * catalan.(n - 1 - i))) (i + 1) 198 | in 199 | sum 0 0 200 | in 201 | let rec size_and_rank : string Tree.t -> int * int = function 202 | | Label ("B", []) -> 203 | (0, 0) 204 | | Label ("B", [Tuple []; l; r]) -> 205 | let s1, r1 = size_and_rank l in 206 | let s2, r2 = size_and_rank r in 207 | let size = s1 + s2 + 1 in 208 | let rank = convolution size (s1 - 1) + (r1 * catalan.(s2)) + r2 in 209 | (size, rank) 210 | | _ -> 211 | assert false 212 | in 213 | fun tree -> snd (size_and_rank tree) 214 | 215 | (** Adequation with the Boltzmann distribution. *) 216 | let boltzmann_dist () = 217 | let store = Array.make 6 0 in 218 | let nb_iterations = 50000 in 219 | for _ = 1 to nb_iterations do 220 | let _, size = generate_from_wg grammar ~size_min:0 ~size_max:5 in 221 | store.(size) <- store.(size) + 1 222 | done; 223 | (* Chi-square test *) 224 | Format.eprintf "z = %F@." oracle.z; 225 | let expected = 226 | let foi = float_of_int in 227 | let arr = 228 | Array.init 6 (fun i -> foi catalan.(i) *. (oracle.z ** foi i)) 229 | in 230 | let total_weight = Array.fold_left ( +. ) 0. arr in 231 | Array.iteri 232 | (fun i x -> arr.(i) <- x /. total_weight *. foi nb_iterations) 233 | arr; 234 | arr 235 | in 236 | Alcotest.(check bool) 237 | "distribution(size(binary))" true 238 | (chi_square 5 ~expected ~actual:store) 239 | 240 | (** Adequation with the uniform distribution at fixed size. *) 241 | let unif_dist () = 242 | let len = catalan.(3) in 243 | let store = Array.make len 0 in 244 | let nb_iterations = 5000 in 245 | for _ = 1 to nb_iterations do 246 | let tree, _ = generate_from_wg grammar ~size_min:3 ~size_max:3 in 247 | let r = rank tree in 248 | store.(r) <- store.(r) + 1 249 | done; 250 | (* Chi-square test *) 251 | let expected = 252 | Array.make len (float_of_int nb_iterations /. float_of_int len) 253 | in 254 | Alcotest.(check bool) 255 | "distribution(size(binary))" true 256 | (chi_square (len - 1) ~expected ~actual:store) 257 | end 258 | 259 | let statistical_tests = 260 | [ ("binary / boltz", `Quick, Binary.boltzmann_dist) 261 | ; ("binary / unif", `Quick, Binary.unif_dist) ] 262 | 263 | (** {2 All the tests} *) 264 | 265 | let () = 266 | Random.self_init (); 267 | Alcotest.run "gen_expect" 268 | [("correctness", correctness); ("statistical_tests", statistical_tests)] 269 | -------------------------------------------------------------------------------- /tests/test_oracle.ml: -------------------------------------------------------------------------------- 1 | open Boltzmann.Oracle 2 | 3 | let checkf tolerance = Alcotest.(check (float tolerance)) 4 | 5 | let checkfa tolerance s a b = Alcotest.(check (array (float tolerance))) s a b 6 | 7 | let foi = float_of_int 8 | 9 | let iteration grammar z epsilon2 = 10 | let len = Array.length grammar.Grammar.rules in 11 | let init_values = init len z in 12 | match Naive.iteration_simple grammar init_values epsilon2 with 13 | | Diverge -> 14 | Alcotest.fail "diverge" 15 | | Val v -> 16 | v 17 | 18 | (** {2 tests for simple evaluations} *) 19 | 20 | let eval_elem () = 21 | let oracle = {z= 0.; values= [|0.23|]; derivate_values= [|0.|]} in 22 | checkf 0. "eval(Ref 0)" 0.23 (Eval.expression oracle (Ref 0)); 23 | let oracle = {z= 0.; values= [|0.8|]; derivate_values= [|0.|]} in 24 | checkf 1e-12 "eval(Seq)" 5. (Eval.expression oracle (Seq (Ref 0))) 25 | 26 | let eval_powers_of_z () = 27 | let test n z = 28 | let name = Format.sprintf "eval(z^%d)" n in 29 | let oracle = {z; values= [|0.|]; derivate_values= [|0.|]} in 30 | checkf 1e-12 name (z ** foi n) (Eval.expression oracle (Z n)) 31 | in 32 | test 5 0.8; test 10 0.95; test 3 0.01; test 1 0.4 33 | 34 | let eval_products () = 35 | let prod = Grammar.Product [Z 1; Ref 0; Ref 0] in 36 | let oracle = {z= 0.25; values= [|2.|]; derivate_values= [|0.|]} in 37 | checkf 1e-12 "eval(z*A*A)" 1. (Eval.expression oracle prod); 38 | let prod = Grammar.Product [Z 1; Ref 1; Ref 2] in 39 | let oracle = {z= 0.5; values= [|20.; 3.; 4.|]; derivate_values= [|0.|]} in 40 | checkf 1e-12 "eval(B*C*z)" 6. (Eval.expression oracle prod); 41 | let prod = Grammar.Product [Z 1; Ref 1; Seq (Ref 3)] in 42 | let oracle = 43 | {z= 0.4; values= [|20.; 1.234; 4.; 0.8|]; derivate_values= [|0.|]} 44 | in 45 | checkf 1e-12 "eval(B*z*Seq(D)*1)" 2.468 (Eval.expression oracle prod) 46 | 47 | let eval_sums () = 48 | let sum = Grammar.Union [Z 1; Z 1; Z 1] in 49 | let z = 0.34567 in 50 | let oracle = {z; values= [||]; derivate_values= [|0.|]} in 51 | checkf 1e-12 "eval(z + z + z)" (3. *. z) (Eval.expression oracle sum); 52 | let sum = Grammar.Union [Ref 0; Seq (Ref 3); Z 1] in 53 | let oracle = 54 | {z= 0.11; values= [|0.33; 10.; 20.; 0.2|]; derivate_values= [|0.|]} 55 | in 56 | checkf 1e-12 "eval(A + Seq(D) + z)" 1.69 (Eval.expression oracle sum); 57 | let sum = Grammar.Union [Product [Ref 0; Ref 0]; Z 0; Z 1] in 58 | let oracle = {z= 0.87; values= [|0.7|]; derivate_values= [|0.|]} in 59 | let expected = (oracle.values.(0) ** 2.) +. 1. +. oracle.z in 60 | checkf 1e-12 "eval(A^2 + 1 + z)" expected (Eval.expression oracle sum) 61 | 62 | let eval_plane_trees () = 63 | let grammar = 64 | Grammar. 65 | { names= [|"T"; "S"|] 66 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 67 | in 68 | (* at a random point / context *) 69 | let z = 0.28 in 70 | let values = [|2.3; 8.1|] in 71 | let oracle = {z; values; derivate_values= [|0.; 0.|]} in 72 | let expected = [|z *. 8.1; 1. +. (2.3 *. 8.1)|] in 73 | checkfa 1e-12 "eval(plane tree)" expected (Eval.grammar oracle grammar).values; 74 | (* at the singularity *) 75 | let z = 0.25 in 76 | let values = [|0.5; 2.|] in 77 | let oracle = {z; values; derivate_values= [|0.; 0.|]} in 78 | let expected = values in 79 | checkfa 1e-12 "eval(plane tree)@singularity" expected 80 | (Eval.grammar oracle grammar).values 81 | 82 | let simple_evaluation_tests = 83 | [ ("Evaluate atomic elements", `Quick, eval_elem) 84 | ; ("Evaluate z^n", `Quick, eval_powers_of_z) 85 | ; ("Evaluate various products", `Quick, eval_products) 86 | ; ("Evaluate various sums", `Quick, eval_sums) 87 | ; ("Evaluate the system for plane trees", `Quick, eval_plane_trees) ] 88 | 89 | (** {2 Tests for generating function evaluation} *) 90 | 91 | let eval_binary () = 92 | let grammar = 93 | Grammar.{names= [|"B"|]; rules= [|Union [Z 1; Product [Z 1; Ref 0; Ref 0]]|]} 94 | in 95 | let oracle z = (1. -. sqrt (1. -. (4. *. z *. z))) /. (2. *. z) in 96 | let test z = 97 | let name = Format.sprintf "binary(%F)" z in 98 | checkf 5e-9 name (oracle z) (iteration grammar z 1e-9).values.(0) 99 | in 100 | test 0.1; test 0.3; test 0.4 101 | 102 | (* TODO: test 0.5 *) 103 | 104 | let eval_nary () = 105 | let grammar = 106 | Grammar. 107 | { names= [|"T"; "S"|] 108 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 109 | in 110 | let oracle z = 111 | let b z = (1. -. sqrt (1. -. (4. *. z))) /. (2. *. z) in 112 | [|z *. b z; b z|] 113 | in 114 | let test z = 115 | let name = Format.sprintf "nary(%F)" z in 116 | checkfa 5e-9 name (oracle z) (iteration grammar z 1e-9).values 117 | in 118 | test 0.1; test 0.2 119 | 120 | (* TODO: test 0.25 *) 121 | 122 | let eval_seq () = 123 | let grammar = 124 | Grammar.{names= [|"S"|]; rules= [|Product [Z 1; Seq (Ref 0)]|]} 125 | in 126 | let oracle z = (1. -. sqrt (1. -. (4. *. z))) /. 2. in 127 | let test z = 128 | let name = Format.sprintf "seq2(%F)" z in 129 | checkf 5e-9 name (oracle z) (iteration grammar z 1e-9).values.(0) 130 | in 131 | test 0.1; test 0.2 132 | 133 | (* TODO: test 0.25 *) 134 | 135 | let eval_shuffle_plus () = 136 | let grammar = 137 | Grammar. 138 | { names= [|"A"; "Ashuffle"; "Aplus"|] 139 | ; rules= 140 | [| Union [Ref 1; Ref 2] 141 | ; Product [Z 1; Seq (Ref 0)] 142 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 143 | in 144 | let oracle z = 145 | let par z = (1. +. z -. sqrt (((1. +. z) ** 2.) -. (8. *. z))) /. 4. in 146 | [|par z /. (1. -. par z); par z; par z *. par z /. (1. -. par z)|] 147 | in 148 | let test z = 149 | let name = Format.sprintf "shuffle_plus(%F)" z in 150 | checkfa 5e-9 name (oracle z) (iteration grammar z 1e-9).values 151 | in 152 | test 0.05; test 0.1; test 0.15 153 | 154 | (* TODO: test (2. -. sqrt 8.) *) 155 | 156 | (* TODO: sp *) 157 | (* TODO: unarybinary *) 158 | (* TODO: unarybinary2 *) 159 | 160 | let evaluation_tests = 161 | [ ("Eval binary(z)", `Quick, eval_binary) 162 | ; ("Eval nary(z)", `Quick, eval_nary) 163 | ; ("Eval seq(z)", `Quick, eval_seq) 164 | ; ("Eval shuffle_plus(z)", `Quick, eval_shuffle_plus) ] 165 | 166 | (** {2 Tests for the singularity search} *) 167 | 168 | let search grammar = 169 | let oracle = Naive.make_singular grammar in 170 | oracle.z 171 | 172 | let binary_singularity () = 173 | let grammar = 174 | Grammar.{names= [|"B"|]; rules= [|Union [Z 1; Product [Z 1; Ref 0; Ref 0]]|]} 175 | in 176 | checkf 5e-9 "singularity(binary)" 0.5 (search grammar) 177 | 178 | let nary_singularity () = 179 | let grammar = 180 | Grammar. 181 | { names= [|"T"; "S"|] 182 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 183 | in 184 | checkf 5e-9 "singularity(nary)" 0.25 (search grammar) 185 | 186 | let seq_singularity () = 187 | let grammar = 188 | Grammar.{names= [|"S"|]; rules= [|Product [Z 1; Seq (Ref 0)]|]} 189 | in 190 | checkf 5e-9 "singularity(seq)" 0.25 (search grammar) 191 | 192 | let shuffle_plus_singularity () = 193 | let grammar = 194 | Grammar. 195 | { names= [|"A"; "Ashuffle"; "Aplus"|] 196 | ; rules= 197 | [| Union [Ref 1; Ref 2] 198 | ; Product [Z 1; Seq (Ref 0)] 199 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 200 | in 201 | let singularity = 3. -. sqrt 8. in 202 | checkf 5e-9 "singularity(shuffle_plus)" singularity (search grammar) 203 | 204 | (* TODO: sp *) 205 | (* TODO: unarybinary *) 206 | (* TODO: unarybinary2 *) 207 | 208 | let singularity_tests = 209 | [ ("Search singularity for binary.spec", `Quick, binary_singularity) 210 | ; ("Search singularity for nary.spec", `Quick, nary_singularity) 211 | ; ("Search singularity for seq.spec", `Quick, seq_singularity) 212 | ; ( "Search singularity for shuffle_plus.spec" 213 | , `Quick 214 | , shuffle_plus_singularity ) ] 215 | 216 | (** {2 Tests for the expectation search} *) 217 | 218 | let search grammar = 219 | let oracle = Naive.make_expectation 1000 grammar in 220 | oracle.z 221 | 222 | let binary_expectation () = 223 | (* B(z) = (1 - sqrt(1 - 4z^2)) / (2 z) 224 | z B'(z) = B(z) / (1 - 2 z B(z)) 225 | = B(z) / sqrt(1 - 4 z^2) 226 | 227 | expectation = N => z = 0.5 * sqrt(1 - 1 / N^2) *) 228 | let grammar = 229 | Grammar.{names= [|"B"|]; rules= [|Union [Z 1; Product [Z 1; Ref 0; Ref 0]]|]} 230 | in 231 | let tuned_z = sqrt (1. -. (1. /. (1000. ** 2.))) /. 2. in 232 | checkf 1e-6 "expectation(binary)" tuned_z (search grammar) 233 | 234 | let nary_expectation () = 235 | (* T(z) = (1 - sqrt(1 - 4 z)) / 2 236 | T'(z) = 1 / sqrt(1 - 4 z) 237 | 238 | expectation = N => z = 0.25 * (1 - 1 / (2 N - 1)^2) *) 239 | let grammar = 240 | Grammar. 241 | { names= [|"T"; "S"|] 242 | ; rules= [|Product [Z 1; Ref 1]; Union [Z 0; Product [Ref 0; Ref 1]]|] } 243 | in 244 | let tuned_z = (1. -. (1. /. (((2. *. 1000.) -. 1.) ** 2.))) /. 4. in 245 | checkf 1e-6 "expectation(nary)" tuned_z (search grammar) 246 | 247 | let seq_expectation () = 248 | (* same as above *) 249 | let grammar = 250 | Grammar.{names= [|"S"|]; rules= [|Product [Z 1; Seq (Ref 0)]|]} 251 | in 252 | let tuned_z = (1. -. (1. /. (((2. *. 1000.) -. 1.) ** 2.))) /. 4. in 253 | checkf 1e-6 "expectation(seq)" tuned_z (search grammar) 254 | 255 | let shuffle_plus_expectation () = 256 | (* A(z) = (1 - z - sqrt((1 - z)^2 - 4 z)) / 2 257 | z A'(z) = (A + A^2) / (1 - A^2 / z) *) 258 | let grammar = 259 | Grammar. 260 | { names= [|"A"; "Ashuffle"; "Aplus"|] 261 | ; rules= 262 | [| Union [Ref 1; Ref 2] 263 | ; Product [Z 1; Seq (Ref 0)] 264 | ; Product [Ref 1; Ref 1; Seq (Ref 1)] |] } 265 | in 266 | (* Solved by dichotomy using sage and a the explicit formulas given above. *) 267 | let tuned_z = 0.171572814532940 in 268 | checkf 1e-6 "expectation(shuffle_plus)" tuned_z (search grammar) 269 | 270 | let expectation_tests = 271 | [ ("Search expectation for binary.spec", `Quick, binary_expectation) 272 | ; ("Search expectation for nary.spec", `Quick, nary_expectation) 273 | ; ("Search expectation for seq.spec", `Quick, seq_expectation) 274 | ; ( "Search expectation for shuffle_plus.spec" 275 | , `Quick 276 | , shuffle_plus_expectation ) ] 277 | 278 | (** {2 All the oracle-related tests} *) 279 | 280 | let () = 281 | eval_plane_trees (); 282 | Alcotest.run "oracle" 283 | [ ("simple evaluation", simple_evaluation_tests) 284 | ; ("function approximation", evaluation_tests) 285 | ; ("singularity search", singularity_tests) 286 | ; ("expectation search", expectation_tests) ] 287 | -------------------------------------------------------------------------------- /src/bin/arbogen.ml: -------------------------------------------------------------------------------- 1 | (********************************************************* 2 | * Arbogen-lib : fast uniform random generation of trees * 3 | ********************************************************* 4 | * Module: Arbogen * 5 | * ------- * 6 | * Main module and Argument parser * 7 | * ------- * 8 | * (C) 2011, Xuming Zhan, Frederic Peschanski * 9 | * Antonine Genitrini, Matthieu Dien * 10 | * Marwan Ghanem * 11 | * under the * 12 | * GNU GPL v.3 licence (cf. LICENSE file) * 13 | *********************************************************) 14 | 15 | module WeightedGrammar = Boltzmann.WeightedGrammar 16 | module Options = Frontend.Options 17 | 18 | let version_str = "arbogen v1.0c" 19 | 20 | let usage = "Usage: arbogen .spec" 21 | 22 | let banner = 23 | "\n\ 24 | \ A ...:'....:'':...':......\n\ 25 | \ R :'' ._ . `. \\ , '':\n\ 26 | \ B ': . \" .| \\ `>/ _.-':\n\ 27 | \ O .:' .`'. `-. '. /' ,.. .:\n\ 28 | \ G :' `. `\\| \\./ ' :\n\ 29 | \ E :. ,,-''''' \"-. | | ....:\n\ 30 | \ N '. ..''' `\\ : |\n\ 31 | \ '''''''' \\' |\n\ 32 | \ *fast* uniform random | =|\n\ 33 | \ tree generator | |\n\ 34 | \ |- |\n\ 35 | \ '''''''''''''''''''''''''''''''''''''''\n\ 36 | \ (C) F. Peschanski et al. under the GPL\n" 37 | 38 | let speclist = 39 | let set_verbosity n = 40 | if n < 0 then ( 41 | Format.eprintf "Error: wrong verbosity level %d => must be positive@." n; 42 | exit 1 ) 43 | else Options.globals.verbosity <- n 44 | in 45 | [ ( "-version" 46 | , Arg.Unit 47 | (fun () -> 48 | Format.printf "%s@." version_str; 49 | exit 0 ) 50 | , "print version information" ) 51 | ; ( "-verbose" 52 | , Arg.Int set_verbosity 53 | , " : set the verbosity level to (a non-negative positive integer)" 54 | ) 55 | ; ("-v", Arg.Int set_verbosity, " : same as -verbose ") 56 | ; ( "-min" 57 | , Arg.Int (fun n -> Options.set "min" (Int n)) 58 | , " : set the minimum size for the generated tree to (a \ 59 | non-negative integer)" ) 60 | ; ( "-max" 61 | , Arg.Int (fun n -> Options.set "max" (Int n)) 62 | , " : set the maximum size for the generated tree to (a \ 63 | non-negative integer)" ) 64 | ; ( "-oracle" 65 | , Arg.String 66 | (function 67 | | "singular" -> 68 | Options.globals.oracle_type <- Options.Singular 69 | | "expectation" -> 70 | Options.globals.oracle_type <- Options.Expectation 71 | | _ -> 72 | Format.eprintf "Error: oracle must be `singular` or `expectation`@."; 73 | exit 1 ) 74 | , ": set the oracle to use `singular` or `expectation`" ) 75 | ; ( "-seed" 76 | , Arg.Int (fun n -> Options.set "seed" (Int n)) 77 | , " : set the random generator seed to " ) 78 | ; ( "-eps1" 79 | , Arg.Float (fun f -> Options.set "eps1" (Float f)) 80 | , " : set the epsilon for singularity search (a positive float number)" 81 | ) 82 | ; ( "-eps2" 83 | , Arg.Float (fun f -> Options.set "eps2" (Float f)) 84 | , " : set the epsilon for simple iteration (a positive float number)" ) 85 | ; ( "-eps3" 86 | , Arg.Float (fun f -> Options.set "eps3" (Float f)) 87 | , " : with the expectation oracle, set the epsilon between the targeted \ 88 | expectation and the computed one (a positive float number)" ) 89 | ; ( "-try" 90 | , Arg.Int (fun n -> Options.set "try" (Int n)) 91 | , " : set the maximum of tries when generating trees" ) 92 | ; ( "-otype" 93 | , Arg.String 94 | (function 95 | | "arb" -> 96 | Options.globals.output_type <- 0 97 | | "dot" -> 98 | Options.globals.output_type <- 1 99 | | "xml" -> 100 | Options.globals.output_type <- 2 101 | | "all" -> 102 | Options.globals.output_type <- 3 103 | | _ -> 104 | Format.eprintf "Error: otype must be in [arb|dot|xml|all]@."; 105 | exit 1 ) 106 | , ": set the type [arb|dot|xml|all] of the generated tree" ) 107 | ; ( "-o" 108 | , Arg.String (fun x -> Options.globals.fileName <- x) 109 | , ": set the name of the file to be created at end of execution" ) 110 | ; ( "-zstart" 111 | , Arg.Float (fun f -> Options.set "zstart" (Float f)) 112 | , ": sets the value of zstart" ) 113 | ; ( "-state" 114 | , Arg.String 115 | (fun x -> 116 | Options.globals.state_file <- x; 117 | Options.globals.with_state <- true ) 118 | , ": set the name of state file" ) 119 | ; ( "-id" 120 | , Arg.Unit (fun () -> Options.globals.with_id <- true) 121 | , ": number the nodes" ) 122 | ; ( "-typ" 123 | , Arg.Unit (fun () -> Options.globals.with_type <- true) 124 | , ": show the type of nodes" ) 125 | ; ( "-randgen" 126 | , Arg.String (fun s -> Options.set "randgen" (String s)) 127 | , "[ocaml|randu|randnull] : set the random number generator" ) 128 | ; ( "-print-oracle" 129 | , Arg.String (fun s -> Options.globals.print_oracle <- s) 130 | , ": output an oracle" ) 131 | ; ( "-use-oracle" 132 | , Arg.String (fun s -> Options.globals.use_oracle <- s) 133 | , ": use an oracle as generated by -print-oracle" ) 134 | ; ( "-indent" 135 | , Arg.Unit (fun () -> Options.globals.indent <- true) 136 | , ": indent the output" ) ] 137 | 138 | let print_tree tree = 139 | (* XXX. ugly workaround *) 140 | let tree = Tree.annotate tree in 141 | let Options.{with_type; with_id; indent; _} = Options.globals in 142 | let arb_printer = 143 | Tree.output_arb ~show_type:with_type ~show_id:with_id ~indent 144 | in 145 | let dot_printer = 146 | Tree.output_dot ~show_type:with_type ~show_id:with_id ~indent 147 | in 148 | let xml_printer = 149 | Tree.output_xml ~show_type:with_type ~show_id:with_id ~indent 150 | in 151 | let print printer filename typ = 152 | if filename = "" then printer stdout tree 153 | else ( 154 | Format.printf "Saving file to '%s%s'@." filename typ; 155 | let out = open_out (filename ^ typ) in 156 | printer out tree; close_out out ) 157 | in 158 | match Options.globals.output_type with 159 | | 0 -> 160 | print arb_printer Options.globals.fileName ".arb" 161 | | 1 -> 162 | print dot_printer Options.globals.fileName ".dot" 163 | | 2 -> 164 | print xml_printer Options.globals.fileName ".xml" 165 | | 3 -> 166 | let filename = 167 | if Options.globals.fileName = "" then "tree" else Options.globals.fileName 168 | in 169 | print arb_printer filename ".arb"; 170 | print dot_printer filename ".dot"; 171 | print xml_printer filename ".xml" 172 | | _ -> 173 | failwith "unreachable case" 174 | 175 | let parse_grammar () = 176 | let opts, g = Frontend.parse_from_file Options.globals.grammar_file in 177 | Options.set_all ~preserve:true opts; 178 | g 179 | 180 | let make_oracle grammar = 181 | if Options.globals.use_oracle = "" then 182 | let open Boltzmann.Oracle.Naive in 183 | let oracle_config = 184 | { epsilon1= Options.(WithDefault.value globals.epsilon1) 185 | ; epsilon2= Options.(WithDefault.value globals.epsilon2) 186 | ; epsilon3= Options.(WithDefault.value globals.epsilon3) 187 | ; zstart= Options.(WithDefault.value globals.zstart) } 188 | in 189 | match Options.globals.oracle_type with 190 | | Options.Singular -> 191 | make_singular ~config:oracle_config grammar 192 | | Options.Expectation -> 193 | let expectation = 194 | ( Options.(WithDefault.value globals.size_min) 195 | + Options.(WithDefault.value globals.size_min) ) 196 | / 2 197 | in 198 | make_expectation ~config:oracle_config expectation grammar 199 | else 200 | let ic = open_in Options.globals.use_oracle in 201 | let n = in_channel_length ic in 202 | let b = Bytes.create n in 203 | really_input ic b 0 n; 204 | close_in ic; 205 | Bytes.unsafe_to_string b |> Boltzmann.Oracle.loads 206 | 207 | let get_rng : string -> (module Randtools.S) = function 208 | | "ocaml" -> 209 | (module Randtools.OcamlRandom) 210 | | "randu" -> 211 | (module Randtools.Randu) 212 | | "randnull" -> 213 | (module Randtools.Randnull) 214 | | name -> 215 | Format.kasprintf invalid_arg "Unknown PRNG: %s" name 216 | 217 | let init_rng () = 218 | let module Rand = (val get_rng Options.globals.randgen) in 219 | let seed = 220 | match Options.globals.random_seed with 221 | | Some seed -> 222 | seed 223 | | None -> 224 | Rand.self_init (); Rand.int 274537 225 | in 226 | if Options.globals.verbosity >= 2 then 227 | Format.printf "[SEED] starting seed = %d@." seed; 228 | Rand.init seed; 229 | (module Rand : Randtools.S) 230 | 231 | let () = 232 | Arg.parse speclist 233 | (fun arg -> 234 | if Options.globals.grammar_file = "" then 235 | Options.globals.grammar_file <- arg 236 | else ( 237 | Format.eprintf 238 | "Error: grammar file already set, argument '%s' rejected@." arg; 239 | exit 1 ) ) 240 | usage; 241 | Options.extra_checks (); 242 | if Options.globals.verbosity > 0 then Format.printf "%s@." banner; 243 | if Options.globals.print_oracle <> "" then ( 244 | let filename = Options.globals.print_oracle in 245 | let fmt = 246 | if filename = "-" then Format.std_formatter 247 | else Format.formatter_of_out_channel (open_out filename) 248 | in 249 | let grammar = parse_grammar () in 250 | let oracle = make_oracle grammar in 251 | Format.fprintf fmt "%a@?" Boltzmann.Oracle.dump oracle; 252 | if Options.globals.verbosity > 0 && filename <> "-" then 253 | Format.printf "Oracle written to %s@." filename; 254 | exit 0 ); 255 | let state = 256 | if Options.globals.with_state then ( 257 | if Options.globals.verbosity > 0 then 258 | Format.printf "Loading state file: %s@." Options.globals.state_file; 259 | let state = GenState.from_file Options.globals.state_file in 260 | Options.globals.randgen <- state.randgen; 261 | Some state ) 262 | else None 263 | in 264 | let module Rng = 265 | (val match state with Some s -> get_rng s.randgen | None -> init_rng ()) 266 | in 267 | let result, wgrm = 268 | match state with 269 | | None -> 270 | let grammar = parse_grammar () in 271 | let oracle = make_oracle grammar in 272 | if Options.globals.verbosity > 0 then Format.printf "Generating tree...@."; 273 | let tree = 274 | Boltzmann.generator grammar oracle 275 | (module Rng) 276 | ~size_min:Options.(WithDefault.value globals.size_min) 277 | ~size_max:Options.(WithDefault.value globals.size_max) 278 | ~max_try:Options.(WithDefault.value globals.max_try) 279 | in 280 | (tree, WeightedGrammar.of_grammar oracle grammar) 281 | | Some state -> 282 | Rng.(State.from_bytes state.rnd_state |> set_state); 283 | let tree = 284 | Boltzmann.free_gen 285 | (module Rng) 286 | state.weighted_grammar 287 | state.weighted_grammar.names.(0) 288 | in 289 | (Some tree, state.weighted_grammar) 290 | in 291 | match result with 292 | | None -> 293 | Format.eprintf "No tree generated ==> try to use different parameters@."; 294 | exit 1 295 | | Some (tree, size) -> 296 | let final_state = 297 | GenState. 298 | { randgen= Rng.name 299 | ; rnd_state= Rng.(State.to_bytes (get_state ())) 300 | ; weighted_grammar= wgrm } 301 | in 302 | if Options.globals.verbosity > 0 then 303 | Format.eprintf "generated_size: %d@." size; 304 | if Options.globals.with_state then begin 305 | let filename = Options.globals.state_file in 306 | if Options.globals.verbosity > 1 then 307 | Format.printf "==> Saving state to file '%s'@." filename; 308 | GenState.to_file filename final_state; 309 | end; 310 | print_tree tree 311 | -------------------------------------------------------------------------------- /src/lib/randtools/randnull.ml: -------------------------------------------------------------------------------- 1 | (*****************************) 2 | (* *) 3 | (* https://www.xkcd.com/221/ *) 4 | (* *) 5 | (*****************************) 6 | 7 | module State = struct 8 | type t = int 9 | 10 | let to_bytes x = Marshal.to_bytes x [] 11 | 12 | let from_bytes buf = Marshal.from_bytes buf 0 13 | end 14 | 15 | let name = "randnull" 16 | 17 | let state = ref 0 18 | 19 | let max_mod = 1000 20 | 21 | let l = 22 | [| 90 23 | ; 27 24 | ; 757 25 | ; 338 26 | ; 760 27 | ; 84 28 | ; 865 29 | ; 310 30 | ; 949 31 | ; 161 32 | ; 404 33 | ; 696 34 | ; 243 35 | ; 739 36 | ; 380 37 | ; 459 38 | ; 4 39 | ; 340 40 | ; 658 41 | ; 305 42 | ; 22 43 | ; 749 44 | ; 53 45 | ; 938 46 | ; 793 47 | ; 225 48 | ; 819 49 | ; 236 50 | ; 32 51 | ; 333 52 | ; 677 53 | ; 753 54 | ; 68 55 | ; 520 56 | ; 215 57 | ; 624 58 | ; 449 59 | ; 443 60 | ; 400 61 | ; 51 62 | ; 971 63 | ; 541 64 | ; 521 65 | ; 620 66 | ; 130 67 | ; 716 68 | ; 87 69 | ; 26 70 | ; 887 71 | ; 863 72 | ; 242 73 | ; 747 74 | ; 581 75 | ; 267 76 | ; 312 77 | ; 856 78 | ; 256 79 | ; 12 80 | ; 674 81 | ; 826 82 | ; 808 83 | ; 582 84 | ; 635 85 | ; 959 86 | ; 810 87 | ; 627 88 | ; 602 89 | ; 596 90 | ; 803 91 | ; 343 92 | ; 850 93 | ; 125 94 | ; 77 95 | ; 861 96 | ; 415 97 | ; 104 98 | ; 292 99 | ; 990 100 | ; 482 101 | ; 574 102 | ; 272 103 | ; 636 104 | ; 158 105 | ; 691 106 | ; 606 107 | ; 532 108 | ; 204 109 | ; 446 110 | ; 136 111 | ; 972 112 | ; 708 113 | ; 369 114 | ; 556 115 | ; 552 116 | ; 124 117 | ; 742 118 | ; 598 119 | ; 156 120 | ; 210 121 | ; 778 122 | ; 148 123 | ; 21 124 | ; 929 125 | ; 183 126 | ; 19 127 | ; 494 128 | ; 897 129 | ; 108 130 | ; 159 131 | ; 777 132 | ; 485 133 | ; 672 134 | ; 862 135 | ; 509 136 | ; 376 137 | ; 896 138 | ; 444 139 | ; 252 140 | ; 378 141 | ; 628 142 | ; 436 143 | ; 518 144 | ; 585 145 | ; 682 146 | ; 720 147 | ; 160 148 | ; 639 149 | ; 569 150 | ; 138 151 | ; 67 152 | ; 96 153 | ; 814 154 | ; 166 155 | ; 273 156 | ; 604 157 | ; 707 158 | ; 427 159 | ; 647 160 | ; 944 161 | ; 907 162 | ; 394 163 | ; 41 164 | ; 254 165 | ; 432 166 | ; 370 167 | ; 931 168 | ; 346 169 | ; 155 170 | ; 384 171 | ; 558 172 | ; 712 173 | ; 115 174 | ; 223 175 | ; 855 176 | ; 787 177 | ; 497 178 | ; 452 179 | ; 772 180 | ; 992 181 | ; 886 182 | ; 259 183 | ; 122 184 | ; 756 185 | ; 316 186 | ; 385 187 | ; 293 188 | ; 650 189 | ; 748 190 | ; 956 191 | ; 547 192 | ; 709 193 | ; 245 194 | ; 744 195 | ; 74 196 | ; 402 197 | ; 734 198 | ; 235 199 | ; 925 200 | ; 419 201 | ; 260 202 | ; 617 203 | ; 873 204 | ; 503 205 | ; 851 206 | ; 507 207 | ; 586 208 | ; 893 209 | ; 505 210 | ; 643 211 | ; 417 212 | ; 798 213 | ; 123 214 | ; 858 215 | ; 989 216 | ; 119 217 | ; 45 218 | ; 336 219 | ; 46 220 | ; 50 221 | ; 522 222 | ; 107 223 | ; 306 224 | ; 291 225 | ; 134 226 | ; 563 227 | ; 957 228 | ; 154 229 | ; 669 230 | ; 513 231 | ; 979 232 | ; 13 233 | ; 430 234 | ; 611 235 | ; 844 236 | ; 695 237 | ; 314 238 | ; 109 239 | ; 773 240 | ; 458 241 | ; 775 242 | ; 476 243 | ; 791 244 | ; 356 245 | ; 597 246 | ; 781 247 | ; 6 248 | ; 878 249 | ; 888 250 | ; 750 251 | ; 538 252 | ; 641 253 | ; 529 254 | ; 687 255 | ; 29 256 | ; 462 257 | ; 864 258 | ; 654 259 | ; 655 260 | ; 474 261 | ; 950 262 | ; 287 263 | ; 322 264 | ; 383 265 | ; 948 266 | ; 790 267 | ; 416 268 | ; 615 269 | ; 980 270 | ; 275 271 | ; 769 272 | ; 42 273 | ; 341 274 | ; 288 275 | ; 227 276 | ; 872 277 | ; 849 278 | ; 327 279 | ; 651 280 | ; 663 281 | ; 921 282 | ; 592 283 | ; 933 284 | ; 725 285 | ; 101 286 | ; 216 287 | ; 405 288 | ; 368 289 | ; 523 290 | ; 782 291 | ; 736 292 | ; 679 293 | ; 998 294 | ; 815 295 | ; 499 296 | ; 824 297 | ; 767 298 | ; 914 299 | ; 941 300 | ; 630 301 | ; 1 302 | ; 164 303 | ; 900 304 | ; 960 305 | ; 905 306 | ; 528 307 | ; 668 308 | ; 894 309 | ; 483 310 | ; 568 311 | ; 536 312 | ; 671 313 | ; 290 314 | ; 847 315 | ; 261 316 | ; 524 317 | ; 738 318 | ; 8 319 | ; 129 320 | ; 885 321 | ; 666 322 | ; 173 323 | ; 975 324 | ; 307 325 | ; 963 326 | ; 177 327 | ; 135 328 | ; 30 329 | ; 762 330 | ; 713 331 | ; 550 332 | ; 414 333 | ; 922 334 | ; 908 335 | ; 883 336 | ; 412 337 | ; 692 338 | ; 703 339 | ; 584 340 | ; 319 341 | ; 576 342 | ; 361 343 | ; 397 344 | ; 601 345 | ; 351 346 | ; 665 347 | ; 377 348 | ; 128 349 | ; 754 350 | ; 926 351 | ; 591 352 | ; 890 353 | ; 561 354 | ; 222 355 | ; 608 356 | ; 269 357 | ; 331 358 | ; 143 359 | ; 535 360 | ; 752 361 | ; 329 362 | ; 289 363 | ; 761 364 | ; 342 365 | ; 345 366 | ; 420 367 | ; 226 368 | ; 241 369 | ; 947 370 | ; 422 371 | ; 577 372 | ; 965 373 | ; 583 374 | ; 207 375 | ; 367 376 | ; 278 377 | ; 765 378 | ; 70 379 | ; 106 380 | ; 901 381 | ; 974 382 | ; 296 383 | ; 467 384 | ; 805 385 | ; 463 386 | ; 137 387 | ; 325 388 | ; 317 389 | ; 2 390 | ; 827 391 | ; 629 392 | ; 472 393 | ; 33 394 | ; 845 395 | ; 768 396 | ; 930 397 | ; 406 398 | ; 848 399 | ; 121 400 | ; 85 401 | ; 457 402 | ; 539 403 | ; 47 404 | ; 442 405 | ; 373 406 | ; 212 407 | ; 224 408 | ; 802 409 | ; 958 410 | ; 869 411 | ; 98 412 | ; 3 413 | ; 699 414 | ; 141 415 | ; 61 416 | ; 800 417 | ; 232 418 | ; 565 419 | ; 320 420 | ; 910 421 | ; 321 422 | ; 163 423 | ; 570 424 | ; 196 425 | ; 358 426 | ; 955 427 | ; 238 428 | ; 100 429 | ; 646 430 | ; 928 431 | ; 578 432 | ; 726 433 | ; 391 434 | ; 498 435 | ; 843 436 | ; 644 437 | ; 995 438 | ; 895 439 | ; 670 440 | ; 986 441 | ; 5 442 | ; 846 443 | ; 190 444 | ; 309 445 | ; 951 446 | ; 448 447 | ; 675 448 | ; 221 449 | ; 330 450 | ; 95 451 | ; 469 452 | ; 564 453 | ; 867 454 | ; 688 455 | ; 710 456 | ; 978 457 | ; 202 458 | ; 172 459 | ; 263 460 | ; 728 461 | ; 220 462 | ; 496 463 | ; 286 464 | ; 318 465 | ; 250 466 | ; 398 467 | ; 599 468 | ; 912 469 | ; 891 470 | ; 295 471 | ; 300 472 | ; 365 473 | ; 201 474 | ; 562 475 | ; 706 476 | ; 923 477 | ; 623 478 | ; 899 479 | ; 732 480 | ; 408 481 | ; 689 482 | ; 339 483 | ; 701 484 | ; 870 485 | ; 763 486 | ; 614 487 | ; 943 488 | ; 403 489 | ; 297 490 | ; 939 491 | ; 525 492 | ; 389 493 | ; 169 494 | ; 502 495 | ; 65 496 | ; 117 497 | ; 797 498 | ; 913 499 | ; 151 500 | ; 587 501 | ; 441 502 | ; 548 503 | ; 189 504 | ; 838 505 | ; 924 506 | ; 434 507 | ; 834 508 | ; 976 509 | ; 473 510 | ; 920 511 | ; 83 512 | ; 251 513 | ; 344 514 | ; 719 515 | ; 813 516 | ; 179 517 | ; 660 518 | ; 214 519 | ; 206 520 | ; 311 521 | ; 758 522 | ; 62 523 | ; 812 524 | ; 193 525 | ; 279 526 | ; 816 527 | ; 714 528 | ; 423 529 | ; 335 530 | ; 379 531 | ; 776 532 | ; 387 533 | ; 435 534 | ; 717 535 | ; 355 536 | ; 233 537 | ; 741 538 | ; 506 539 | ; 57 540 | ; 545 541 | ; 78 542 | ; 116 543 | ; 771 544 | ; 88 545 | ; 796 546 | ; 20 547 | ; 99 548 | ; 31 549 | ; 618 550 | ; 465 551 | ; 526 552 | ; 966 553 | ; 447 554 | ; 993 555 | ; 904 556 | ; 832 557 | ; 167 558 | ; 71 559 | ; 607 560 | ; 280 561 | ; 438 562 | ; 649 563 | ; 139 564 | ; 622 565 | ; 11 566 | ; 302 567 | ; 673 568 | ; 879 569 | ; 145 570 | ; 81 571 | ; 514 572 | ; 580 573 | ; 531 574 | ; 854 575 | ; 268 576 | ; 559 577 | ; 952 578 | ; 544 579 | ; 399 580 | ; 764 581 | ; 409 582 | ; 804 583 | ; 715 584 | ; 985 585 | ; 779 586 | ; 213 587 | ; 994 588 | ; 936 589 | ; 969 590 | ; 911 591 | ; 73 592 | ; 661 593 | ; 852 594 | ; 940 595 | ; 553 596 | ; 460 597 | ; 537 598 | ; 93 599 | ; 915 600 | ; 439 601 | ; 455 602 | ; 120 603 | ; 723 604 | ; 573 605 | ; 431 606 | ; 877 607 | ; 795 608 | ; 836 609 | ; 631 610 | ; 200 611 | ; 511 612 | ; 388 613 | ; 554 614 | ; 737 615 | ; 676 616 | ; 91 617 | ; 489 618 | ; 830 619 | ; 946 620 | ; 382 621 | ; 868 622 | ; 637 623 | ; 495 624 | ; 150 625 | ; 681 626 | ; 428 627 | ; 935 628 | ; 113 629 | ; 751 630 | ; 902 631 | ; 866 632 | ; 199 633 | ; 258 634 | ; 745 635 | ; 840 636 | ; 334 637 | ; 10 638 | ; 392 639 | ; 308 640 | ; 82 641 | ; 662 642 | ; 246 643 | ; 982 644 | ; 837 645 | ; 988 646 | ; 332 647 | ; 253 648 | ; 277 649 | ; 149 650 | ; 59 651 | ; 743 652 | ; 549 653 | ; 348 654 | ; 609 655 | ; 410 656 | ; 766 657 | ; 731 658 | ; 519 659 | ; 579 660 | ; 262 661 | ; 575 662 | ; 304 663 | ; 15 664 | ; 684 665 | ; 265 666 | ; 470 667 | ; 466 668 | ; 371 669 | ; 996 670 | ; 337 671 | ; 884 672 | ; 491 673 | ; 626 674 | ; 34 675 | ; 780 676 | ; 889 677 | ; 248 678 | ; 859 679 | ; 38 680 | ; 208 681 | ; 357 682 | ; 680 683 | ; 638 684 | ; 418 685 | ; 981 686 | ; 829 687 | ; 324 688 | ; 197 689 | ; 205 690 | ; 171 691 | ; 234 692 | ; 315 693 | ; 987 694 | ; 527 695 | ; 170 696 | ; 517 697 | ; 678 698 | ; 916 699 | ; 453 700 | ; 652 701 | ; 374 702 | ; 23 703 | ; 880 704 | ; 168 705 | ; 299 706 | ; 600 707 | ; 711 708 | ; 247 709 | ; 16 710 | ; 917 711 | ; 909 712 | ; 789 713 | ; 605 714 | ; 657 715 | ; 44 716 | ; 882 717 | ; 876 718 | ; 515 719 | ; 454 720 | ; 730 721 | ; 360 722 | ; 792 723 | ; 285 724 | ; 450 725 | ; 86 726 | ; 871 727 | ; 705 728 | ; 881 729 | ; 733 730 | ; 157 731 | ; 542 732 | ; 501 733 | ; 683 734 | ; 76 735 | ; 821 736 | ; 686 737 | ; 937 738 | ; 999 739 | ; 694 740 | ; 724 741 | ; 237 742 | ; 353 743 | ; 127 744 | ; 942 745 | ; 774 746 | ; 165 747 | ; 425 748 | ; 642 749 | ; 366 750 | ; 231 751 | ; 112 752 | ; 984 753 | ; 718 754 | ; 659 755 | ; 0 756 | ; 94 757 | ; 97 758 | ; 492 759 | ; 464 760 | ; 49 761 | ; 182 762 | ; 131 763 | ; 451 764 | ; 488 765 | ; 964 766 | ; 954 767 | ; 55 768 | ; 386 769 | ; 195 770 | ; 625 771 | ; 209 772 | ; 478 773 | ; 105 774 | ; 839 775 | ; 534 776 | ; 40 777 | ; 828 778 | ; 303 779 | ; 919 780 | ; 613 781 | ; 229 782 | ; 727 783 | ; 759 784 | ; 176 785 | ; 927 786 | ; 175 787 | ; 79 788 | ; 857 789 | ; 395 790 | ; 934 791 | ; 192 792 | ; 806 793 | ; 218 794 | ; 363 795 | ; 693 796 | ; 817 797 | ; 187 798 | ; 244 799 | ; 188 800 | ; 589 801 | ; 786 802 | ; 685 803 | ; 479 804 | ; 842 805 | ; 484 806 | ; 590 807 | ; 7 808 | ; 219 809 | ; 634 810 | ; 203 811 | ; 401 812 | ; 132 813 | ; 52 814 | ; 249 815 | ; 153 816 | ; 424 817 | ; 456 818 | ; 874 819 | ; 853 820 | ; 413 821 | ; 906 822 | ; 977 823 | ; 294 824 | ; 326 825 | ; 14 826 | ; 69 827 | ; 656 828 | ; 475 829 | ; 697 830 | ; 560 831 | ; 546 832 | ; 898 833 | ; 35 834 | ; 481 835 | ; 36 836 | ; 557 837 | ; 970 838 | ; 704 839 | ; 825 840 | ; 217 841 | ; 396 842 | ; 198 843 | ; 997 844 | ; 230 845 | ; 603 846 | ; 860 847 | ; 822 848 | ; 510 849 | ; 140 850 | ; 283 851 | ; 276 852 | ; 967 853 | ; 746 854 | ; 594 855 | ; 735 856 | ; 323 857 | ; 133 858 | ; 530 859 | ; 274 860 | ; 174 861 | ; 645 862 | ; 721 863 | ; 390 864 | ; 477 865 | ; 75 866 | ; 362 867 | ; 504 868 | ; 755 869 | ; 25 870 | ; 807 871 | ; 186 872 | ; 892 873 | ; 146 874 | ; 178 875 | ; 349 876 | ; 973 877 | ; 181 878 | ; 612 879 | ; 500 880 | ; 194 881 | ; 440 882 | ; 56 883 | ; 633 884 | ; 493 885 | ; 566 886 | ; 667 887 | ; 621 888 | ; 185 889 | ; 571 890 | ; 740 891 | ; 375 892 | ; 875 893 | ; 437 894 | ; 516 895 | ; 58 896 | ; 126 897 | ; 111 898 | ; 191 899 | ; 648 900 | ; 180 901 | ; 328 902 | ; 80 903 | ; 783 904 | ; 255 905 | ; 393 906 | ; 72 907 | ; 468 908 | ; 313 909 | ; 103 910 | ; 92 911 | ; 480 912 | ; 640 913 | ; 799 914 | ; 595 915 | ; 811 916 | ; 350 917 | ; 152 918 | ; 144 919 | ; 239 920 | ; 114 921 | ; 17 922 | ; 953 923 | ; 983 924 | ; 429 925 | ; 24 926 | ; 28 927 | ; 162 928 | ; 702 929 | ; 426 930 | ; 543 931 | ; 184 932 | ; 619 933 | ; 540 934 | ; 147 935 | ; 588 936 | ; 282 937 | ; 54 938 | ; 9 939 | ; 770 940 | ; 228 941 | ; 833 942 | ; 945 943 | ; 118 944 | ; 551 945 | ; 142 946 | ; 240 947 | ; 66 948 | ; 284 949 | ; 352 950 | ; 110 951 | ; 461 952 | ; 63 953 | ; 788 954 | ; 281 955 | ; 616 956 | ; 407 957 | ; 823 958 | ; 572 959 | ; 43 960 | ; 690 961 | ; 610 962 | ; 809 963 | ; 508 964 | ; 266 965 | ; 271 966 | ; 841 967 | ; 784 968 | ; 257 969 | ; 298 970 | ; 64 971 | ; 918 972 | ; 632 973 | ; 835 974 | ; 264 975 | ; 820 976 | ; 831 977 | ; 421 978 | ; 903 979 | ; 347 980 | ; 48 981 | ; 381 982 | ; 102 983 | ; 486 984 | ; 411 985 | ; 354 986 | ; 490 987 | ; 37 988 | ; 60 989 | ; 961 990 | ; 785 991 | ; 794 992 | ; 359 993 | ; 932 994 | ; 700 995 | ; 801 996 | ; 270 997 | ; 533 998 | ; 301 999 | ; 818 1000 | ; 653 1001 | ; 991 1002 | ; 567 1003 | ; 968 1004 | ; 555 1005 | ; 729 1006 | ; 722 1007 | ; 89 1008 | ; 664 1009 | ; 593 1010 | ; 445 1011 | ; 211 1012 | ; 471 1013 | ; 18 1014 | ; 372 1015 | ; 962 1016 | ; 487 1017 | ; 433 1018 | ; 39 1019 | ; 512 1020 | ; 698 1021 | ; 364 |] 1022 | 1023 | let max_mod_f = float_of_int max_mod 1024 | 1025 | let init n = state := n mod max_mod 1026 | 1027 | let self_init () = 1028 | Random.self_init (); 1029 | state := Random.int 100 1030 | 1031 | let get_state () = !state 1032 | 1033 | let set_state s = state := s 1034 | 1035 | let int _ = 1036 | let i = !state in 1037 | state := (!state + 1) mod max_mod; 1038 | l.(i) 1039 | 1040 | let float f = 1041 | let n = int max_mod in 1042 | let r = f *. (float_of_int n /. max_mod_f) in 1043 | r 1044 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | --------------------------------------------------------------------------------