Skip to content

Commit

Permalink
Deduplicate next_uint64 and next_uint32.
Browse files Browse the repository at this point in the history 
This commit decreases code duplication by generalizing
`next_uint32` and `next_uint64` implementations and places
them in a "common" module to be used by bitgenerator
implementations. The same is done for the subset of module
signatures shared amongst all bitgenerators.
  • Loading branch information
@zoj613
Pass Automated Testing Suite authored and zoj613 committed Apr 19, 2024
1 parent 657d551 commit eb86792
Show file tree
Hide file tree
Showing 6 changed files with 101 additions and 164 deletions.
3 changes: 2 additions & 1 deletion lib/bitgen.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,9 @@
]}
*)

module SeedSequence = Seed.SeedSequence

module SFC64 = Sfc.SFC64
module PCG64 = Pcg.PCG64
module SeedSequence = Seed.SeedSequence
module Xoshiro256 = Xoshiro.Xoshiro256StarStar
module Philox64 = Philox.Philox
51 changes: 51 additions & 0 deletions lib/common.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
open Stdint


type 'a store =
| Empty
| Value of 'a


let max_int = Int.max_int |> Uint32.of_int

(* [to_uint32 nxt s store] advances state [s] and optains a random uint64 integers
using function [nxt]. The resulting int is split into 2 uint32 integers where
one of them is returned to the caller while the next is put into [store]. If
[store] is not empty then the [nxt] is not called and the integer stored in
[store] is returned and an empty store is returned to the caller. A 3-tuple is
returned of the form: (new uint32, new state s, new store). *)
let next_uint32 ~next s = function
| Value x -> x, s, Empty
| Empty ->
let uint, s' = next s in
Uint64.(logand uint max_int |> to_uint32), s',
Value Uint64.(shift_right uint 32 |> to_uint32)


(* [next_double nextu64 t] returns a random float from bitgenerator [t] using
function [nextu64] and a new bitgenerator with its internal state advanced forward by a step. *)
let next_double ~nextu64 t = match nextu64 t with
| u, t' -> Uint64.(shift_right u 11 |> to_int) |> Float.of_int
|> ( *. ) (1.0 /. 9007199254740992.0), t'


module type BITGEN = sig
type t
(** [t] is the state of the bitgenerator. *)

val next_uint64 : t -> uint64 * t
(** [next_uint64 t] Generates a random unsigned 64-bit integer and a state
of the generator advanced forward by one step. *)

val next_uint32 : t -> uint32 * t
(** [next_uint32 t] Generates a random unsigned 32-bit integer and a state
of the generator advanced forward by one step. *)

val next_double : t -> float * t
(** [next_double t] Generates a random 64 bit float and a state of the
generator advanced forward by one step. *)

val initialize : Seed.SeedSequence.t -> t
(** [initialize s] Returns the initial state of the generator. The random stream
is determined by the initialization of the seed sequence [s] of {!SeedSequence.t} type. *)
end
46 changes: 10 additions & 36 deletions lib/pcg.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,23 +18,7 @@ module PCG64 : sig
The input seed is processed by {!SeedSequence} to generate both values. *)

type t
(** [t] is the state of the PCG64 bitgenerator *)

val next_uint64 : t -> uint64 * t
(** Generate a random unsigned 64-bit integer and return a state of the
generator advanced by one step forward *)

val next_uint32 : t -> uint32 * t
(** Generate a random unsigned 32-bit integer and return a state of the
generator advanced by one step forward *)

val next_double : t -> float * t
(** Generate a random 64 bit float and return a state of the
generator advanced by one step forward *)

val initialize : Seed.SeedSequence.t -> t
(** Get the initial state of the generator using a {!SeedSequence} type as input *)
include Common.BITGEN

val advance : int128 -> t -> t
(** [advance delta] Advances the underlying RNG as if [delta] draws have been made.
Expand All @@ -44,7 +28,7 @@ module PCG64 : sig
(** [next_bounded_uint64 bound t] returns an unsigned 64bit integers in the range
(0, bound) as well as the state of the generator advanced one step forward. *)
end = struct
type t = {s : setseq; has_uint32 : bool; uinteger : uint32}
type t = {s : setseq; ustore : uint32 Common.store}
and setseq = {state : uint128; increment : uint128}

let multiplier = Uint128.of_string "0x2360ed051fc65da44385df649fccf645"
Expand All @@ -55,7 +39,7 @@ end = struct
and r = Uint128.(shift_right state 122 |> to_int) in
let nr = Uint32.(of_int r |> neg |> logand (of_int 63) |> to_int) in
Uint64.(logor (shift_left v nr) (shift_right v r))


let next {state; increment} =
let state' = Uint128.(state * multiplier + increment) in
Expand All @@ -66,31 +50,23 @@ end = struct
| u, s' -> u, {t with s = s'}


let next_uint32 t = match t.has_uint32 with
| true -> t.uinteger, {t with has_uint32 = false}
| false ->
let uint, s' = next t.s in
Uint64.(of_int 0xffffffff |> logand uint |> to_uint32),
{uinteger = Uint64.(shift_right uint 32 |> to_uint32);
has_uint32 = true;
s = s'}
let next_uint32 t =
match Common.next_uint32 ~next:next t.s t.ustore with
| u, s, ustore -> u, {s; ustore}


let next_double t = match next_uint64 t with
| u, t' ->
Uint64.(shift_right u 11 |> to_int) |> Float.of_int |> ( *. ) (1.0 /. 9007199254740992.0), t'
let next_double t = Common.next_double ~nextu64:next_uint64 t


let advance delta {s = {state; increment}; has_uint32; uinteger} =
let advance delta {s = {state; increment}; ustore} =
let open Uint128 in
let rec lcg d am ap cm cp = (* advance state using LCG method *)
match d = zero, logand d one = one with
| true, _ -> am * state + ap
| false, true -> lcg (shift_right d 1) (am * cm) (ap * cm + cp) (cm * cm) (cp * (cm + one))
| false, false -> lcg (shift_right d 1) am ap (cm * cm) (cp * (cm + one))
in
{s = {state = lcg (Uint128.of_int128 delta) one zero multiplier increment; increment};
has_uint32; uinteger}
{s = {state = lcg (Uint128.of_int128 delta) one zero multiplier increment; increment}; ustore}


let set_seed (shi, slo, ihi, ilo) =
Expand All @@ -112,7 +88,5 @@ end = struct

let initialize seed =
let state = Seed.SeedSequence.generate_64bit_state 4 seed in
{s = set_seed (state.(0), state.(1), state.(2), state.(3));
uinteger = Uint32.zero;
has_uint32 = false}
{s = set_seed (state.(0), state.(1), state.(2), state.(3)); ustore = Common.Empty}
end
55 changes: 14 additions & 41 deletions lib/philox.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,23 +34,7 @@ module Philox : sig
|> List.map Philox64.initialize
]} *)

type t
(** [t] is the state of the Philox64 bitgenerator *)

val next_uint64 : t -> uint64 * t
(** Generate a random unsigned 64-bit integer and return a state of the
generator advanced by one step forward *)

val next_uint32 : t -> uint32 * t
(** Generate a random unsigned 32-bit integer and return a state of the
generator advanced by one step forward *)

val next_double : t -> float * t
(** Generate a random 64 bit float and return a state of the
generator advanced by one step forward *)

val initialize : Seed.SeedSequence.t -> t
(** Get the initial state of the generator using a {!SeedSequence} type as input *)
include Common.BITGEN

val initialize_ctr : counter:uint64 * uint64 * uint64 * uint64 -> Seed.SeedSequence.t -> t
(** Get the initial state of the generator using a 4-element unsigned 64-bit tuple as
Expand All @@ -59,17 +43,15 @@ module Philox : sig

val jump : t -> t
(** [jump t] is equivalent to {m 2^{128}} calls to {!Philox64.next_uint64}. *)

end = struct
type t = {
ctr : counter;
key: key;
buffer_pos : int;
buffer : uint64 * uint64 * uint64 * uint64;
has_uint32 : bool;
uinteger : uint32}
ctr : counter;
buffer : buffer;
ustore : uint32 Common.store}
and counter = uint64 * uint64 * uint64 * uint64
and key = uint64 * uint64
and buffer = Buffer of int * counter


let bumpk0 = Uint64.of_string "0x9E3779B97F4A7C15"
Expand Down Expand Up @@ -113,27 +95,20 @@ end = struct
| 0 -> b0 | 1 -> b1 | 2 -> b2 | _ -> b3


let next_uint64 t = match t.buffer_pos with
| i when i < 4 -> index t.buffer i, {t with buffer_pos = i + 1}
let next_uint64 t = match t.buffer with
| Buffer (i, buf) when i < 4 -> index buf i, {t with buffer = Buffer (i + 1, buf)}
| _ ->
let ctr' = next t.ctr in
let buf = ten_rounds ctr' t.key in
index buf 0, {t with ctr = ctr'; buffer = buf; buffer_pos = 1}
index buf 0, {t with ctr = ctr'; buffer = Buffer (1, buf)}


let next_uint32 t =
match t.has_uint32 with
| true -> t.uinteger, {t with has_uint32 = false}
| false ->
let uint, t' = next_uint64 t in
Uint64.(of_int 0xffffffff |> logand uint |> to_uint32), (* low 32 bits *)
{t' with has_uint32 = true;
uinteger = Uint64.(shift_right uint 32 |> to_uint32)} (* high 32 bits *)
match Common.next_uint32 ~next:next_uint64 t t.ustore with
| u, s, ustore -> u, {s with ustore = ustore}


let next_double t = match next_uint64 t with
| u, t' -> Uint64.(shift_right u 11 |> to_int)
|> Float.of_int |> ( *. ) (1.0 /. 9007199254740992.0), t'
let next_double t = Common.next_double ~nextu64:next_uint64 t


let jump t =
Expand All @@ -150,11 +125,9 @@ end = struct
let initialize_ctr ~counter seed =
let istate = Seed.SeedSequence.generate_64bit_state 2 seed in
{ctr = counter;
buffer = zeros;
key = (istate.(0), istate.(1));
uinteger = Uint32.zero;
has_uint32 = false;
buffer_pos = 4}
ustore = Common.Empty;
buffer = Buffer (4, zeros);
key = (istate.(0), istate.(1))}


let initialize seed = initialize_ctr ~counter:zeros seed
Expand Down
51 changes: 11 additions & 40 deletions lib/sfc.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,56 +16,28 @@ module SFC64 : sig
each iteration. The input seed is processed by {!SeedSequence} to generate
the first 3 values, then the algorithm is iterated a small number of times to mix.*)

type t
(** [t] is the state of the SFC64 bitgenerator *)

val next_uint64 : t -> uint64 * t
(** Generate a random unsigned 64-bit integer and return a state of the
generator advanced by one step forward *)

val next_uint32 : t -> uint32 * t
(** Generate a random unsigned 32-bit integer and return a state of the
generator advanced by one step forward *)

val next_double : t -> float * t
(** Generate a random 64 bit float and return a state of the
generator advanced by one step forward *)

val initialize : Seed.SeedSequence.t -> t
(** Get the initial state of the generator using a {!SeedSequence} type as input *)

include Common.BITGEN
end = struct
(* last uint64 value is the counter *)
type t = {s : state; has_uint32 : bool; uinteger : uint32}
type t = {s : state; ustore : uint32 Common.store}
and state = uint64 * uint64 * uint64 * uint64


let next (w, x, y, z) =
let uint = Uint64.(w + x + z)
and y' = Uint64.(logor (shift_left y 24) (shift_right y 40)) in
uint, Uint64.(shift_right x 11 |> logxor x, y + shift_left y 3, y' + uint, z + one)
let next (w, x, y, z) = match Uint64.(w + x + z) with
| u -> u, Uint64.(shift_right x 11 |> logxor x, y + shift_left y 3,
logor (shift_left y 24) (shift_right y 40) + u, z + one)


let next_uint64 t =
let uint, s' = next t.s in
uint, {t with s = s'}
let next_uint64 t = match next t.s with
| u, s' -> u, {t with s = s'}


let next_uint32 t =
match t.has_uint32 with
| true -> t.uinteger, {t with has_uint32 = false}
| false -> let uint, s' = next t.s in
Uint64.(of_int 0xffffffff |> logand uint |> to_uint32), {
uinteger = Uint64.(shift_right uint 32 |> to_uint32);
has_uint32 = true;
s = s'
}
match Common.next_uint32 ~next:next t.s t.ustore with
| u, s, ustore -> u, {s; ustore}


let next_double t =
let uint, t' = next_uint64 t in
let rnd = Uint64.(shift_right uint 11 |> to_int) |> Float.of_int in
rnd *. (1.0 /. 9007199254740992.0), t'
let next_double t = Common.next_double ~nextu64:next_uint64 t


let set_seed (w, x, y) =
Expand All @@ -78,6 +50,5 @@ end = struct

let initialize seed =
let istate = Seed.SeedSequence.generate_64bit_state 3 seed in
{s = set_seed (istate.(0), istate.(1), istate.(2));
has_uint32 = false; uinteger = Uint32.zero}
{s = set_seed (istate.(0), istate.(1), istate.(2)); ustore = Common.Empty}
end
Loading

0 comments on commit eb86792

Please sign in to comment.