mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -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} *)
|
||||
|
||||
open CCShims_
|
||||
include Random
|
||||
|
||||
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 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
|
||||
let open Containers in
|
||||
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
|
||||
(** 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
|
||||
(name check_labelled_mods)
|
||||
(modules check_labelled_mods)
|
||||
(flags :standard -warn-error -a -w -3-33-35-27-39-50 -nolabels)
|
||||
(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
|
||||
(alias
|
||||
(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