mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
move uniformity tests out of CCRandom
This commit is contained in:
parent
7717cc13db
commit
238123b955
4 changed files with 46 additions and 39 deletions
|
|
@ -3,7 +3,6 @@
|
||||||
|
|
||||||
(** {1 Random Generators} *)
|
(** {1 Random Generators} *)
|
||||||
|
|
||||||
open CCShims_
|
|
||||||
include Random
|
include Random
|
||||||
|
|
||||||
type state = Random.State.t
|
type state = Random.State.t
|
||||||
|
|
@ -208,35 +207,6 @@ let __default_state = Random.State.make_self_init ()
|
||||||
|
|
||||||
let run ?(st=__default_state) g = g st
|
let run ?(st=__default_state) g = g st
|
||||||
|
|
||||||
let uniformity_test ?(size_hint=10) k rng st =
|
|
||||||
let histogram = Hashtbl.create size_hint in
|
|
||||||
let add x = let n = try Hashtbl.find histogram x with Not_found -> 0 in
|
|
||||||
Hashtbl.replace histogram x (n + 1) in
|
|
||||||
let () =
|
|
||||||
for _i = 0 to ( k - 1 ) do
|
|
||||||
add (rng st)
|
|
||||||
done in
|
|
||||||
let cardinal = float_of_int (Hashtbl.length histogram) in
|
|
||||||
let kf = float_of_int k in
|
|
||||||
(* average number of points assuming an uniform distribution *)
|
|
||||||
let average = kf /. cardinal in
|
|
||||||
(* The number of points is a sum of random variables with binomial distribution *)
|
|
||||||
let p = 1. /. cardinal in
|
|
||||||
(* The variance of a binomial distribution with average p is *)
|
|
||||||
let variance = p *. (1. -. p ) in
|
|
||||||
(* Central limit theorem: a confidence interval of 4σ provides a false positive rate
|
|
||||||
of 0.00634% *)
|
|
||||||
let confidence = 4. in
|
|
||||||
let std = confidence *. (sqrt (kf *. variance)) in
|
|
||||||
let predicate _key n acc =
|
|
||||||
let (<) (a : float) b = Stdlib.(<) a b in
|
|
||||||
acc && abs_float (average -. float_of_int n) < std in
|
|
||||||
Hashtbl.fold predicate histogram true
|
|
||||||
|
|
||||||
(*$T split_list
|
|
||||||
run ~st:(QCheck_runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) )
|
|
||||||
*)
|
|
||||||
|
|
||||||
(*$R
|
(*$R
|
||||||
let open Containers in
|
let open Containers in
|
||||||
ignore @@ List.random_choose [1;2;3] (Random.get_state())
|
ignore @@ List.random_choose [1;2;3] (Random.get_state())
|
||||||
|
|
|
||||||
|
|
@ -158,11 +158,3 @@ include CCShimsMkLet_.S with type 'a t_let := 'a t
|
||||||
|
|
||||||
val run : ?st:state -> 'a t -> 'a
|
val run : ?st:state -> 'a t -> 'a
|
||||||
(** Using a random state (possibly the one in argument) run a generator. *)
|
(** Using a random state (possibly the one in argument) run a generator. *)
|
||||||
|
|
||||||
(**/**)
|
|
||||||
|
|
||||||
val uniformity_test : ?size_hint:int -> int -> 'a t -> bool t
|
|
||||||
(** [uniformity_test k rng] tests the uniformity of the random generator [rng] using
|
|
||||||
[k] samples.
|
|
||||||
@since 0.15
|
|
||||||
*)
|
|
||||||
|
|
|
||||||
|
|
@ -2,9 +2,22 @@
|
||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name check_labelled_mods)
|
(name check_labelled_mods)
|
||||||
|
(modules check_labelled_mods)
|
||||||
(flags :standard -warn-error -a -w -3-33-35-27-39-50 -nolabels)
|
(flags :standard -warn-error -a -w -3-33-35-27-39-50 -nolabels)
|
||||||
(libraries containers))
|
(libraries containers))
|
||||||
|
|
||||||
|
(executable
|
||||||
|
(name test_hash)
|
||||||
|
(modules test_hash)
|
||||||
|
(flags :standard -warn-error -a+8)
|
||||||
|
(libraries containers))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
(name runtest)
|
||||||
|
(locks ctest)
|
||||||
|
(package containers)
|
||||||
|
(action (run ./test_random.exe)))
|
||||||
|
|
||||||
; what matters is that it compiles
|
; what matters is that it compiles
|
||||||
(alias
|
(alias
|
||||||
(name runtest)
|
(name runtest)
|
||||||
|
|
|
||||||
32
src/core/tests/test_random.ml
Normal file
32
src/core/tests/test_random.ml
Normal file
|
|
@ -0,0 +1,32 @@
|
||||||
|
|
||||||
|
open CCRandom
|
||||||
|
|
||||||
|
let uniformity_test ?(size_hint=10) k rng st =
|
||||||
|
let histogram = Hashtbl.create size_hint in
|
||||||
|
let add x = let n = try Hashtbl.find histogram x with Not_found -> 0 in
|
||||||
|
Hashtbl.replace histogram x (n + 1) in
|
||||||
|
let () =
|
||||||
|
for _i = 0 to ( k - 1 ) do
|
||||||
|
add (rng st)
|
||||||
|
done in
|
||||||
|
let cardinal = float_of_int (Hashtbl.length histogram) in
|
||||||
|
let kf = float_of_int k in
|
||||||
|
(* average number of points assuming an uniform distribution *)
|
||||||
|
let average = kf /. cardinal in
|
||||||
|
(* The number of points is a sum of random variables with binomial distribution *)
|
||||||
|
let p = 1. /. cardinal in
|
||||||
|
(* The variance of a binomial distribution with average p is *)
|
||||||
|
let variance = p *. (1. -. p ) in
|
||||||
|
(* Central limit theorem: a confidence interval of 4σ provides a false positive rate
|
||||||
|
of 0.00634% *)
|
||||||
|
let confidence = 4. in
|
||||||
|
let std = confidence *. (sqrt (kf *. variance)) in
|
||||||
|
let predicate _key n acc =
|
||||||
|
let (<) (a : float) b = Stdlib.(<) a b in
|
||||||
|
acc && abs_float (average -. float_of_int n) < std in
|
||||||
|
Hashtbl.fold predicate histogram true
|
||||||
|
|
||||||
|
let () =
|
||||||
|
let st = Random.State.make_self_init() in
|
||||||
|
let ok = run ~st ( uniformity_test 50_000 (split_list 10 ~len:3) ) in
|
||||||
|
if not ok then failwith "uniformity check failed"
|
||||||
Loading…
Add table
Reference in a new issue