Source file RandomBigInt.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
(******************************************************************************)
(*                                                                            *)
(*                                     Feat                                   *)
(*                                                                            *)
(*                        François Pottier, Inria Paris                       *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the MIT license, as described in the file LICENSE.               *)
(******************************************************************************)

(* Uniform random generation of large integers. Copied and adapted from Jane
   Street's bignum library. *)

(* [random state range] chooses a [depth] and generates random values using
   [R.bits state], called [1 lsl depth] times and concatenated. The
   preliminary result [n] therefore satisfies [0 <= n < 1 lsl (30 lsl depth)].

   In order for the random choice to be uniform between [0] and [range-1],
   there must exist [k > 0] such that [n < k * range <= 1 lsl (30 lsl depth)].
   If so, [n % range] is returned. Otherwise the random choice process is
   repeated from scratch.

   The [depth] value is chosen so that repeating is uncommon (1 in 1000 or
   less). *)

open Printf

module Make (Z : BigIntSig.EXTENDED) (R : RandomSig.S) = struct

let bits_at_depth (depth : int) : int =
  30 lsl depth

let range_at_depth (depth : int) : Z.t =
  Z.(one lsl (bits_at_depth depth))

let rec choose_bit_depth_for_range_from range depth =
  if Z.geq (range_at_depth depth) range then depth
  else choose_bit_depth_for_range_from range (depth + 1)

let choose_bit_depth_for_range (range : Z.t) : int =
  choose_bit_depth_for_range_from range 0

let rec random_bigint_at_depth (state : R.State.t) depth : Z.t =
  if depth = 0 then
    Z.of_int (R.State.bits state)
  else
    let depth = depth - 1 in
    let prefix = random_bigint_at_depth state depth in
    let suffix = random_bigint_at_depth state depth in
    Z.(prefix lsl (bits_at_depth depth) lor suffix)

let random_value_is_uniform_in_range range depth n =
  let k = Z.(range_at_depth depth / range) in
  Z.lt n Z.(k * range)

let rec large_random_at_depth state range depth =
  let result = random_bigint_at_depth state depth in
  if random_value_is_uniform_in_range range depth result
  then Z.(result mod range)
  else large_random_at_depth state range depth

let large_random state range =
  let tolerance_factor = Z.of_int 1000 in
  let depth = choose_bit_depth_for_range Z.(range * tolerance_factor) in
  large_random_at_depth state range depth

let random state range =
  if Z.leq range Z.zero then
    invalid_arg (sprintf "random: %s is not positive" (Z.to_string range))
  else if Z.lt range Z.(one lsl 30) then
    Z.of_int (R.State.int state (Z.to_int range))
  else
    large_random state range

let random range =
  random (R.get_state ()) range

end