123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374(**************************************************************************)(* *)(* OCaml *)(* *)(* Damien Doligez, projet Para, INRIA Rocquencourt *)(* Xavier Leroy, projet Cambium, College de France and Inria *)(* *)(* Copyright 1996 Institut National de Recherche en Informatique et *)(* en Automatique. *)(* *)(* All rights reserved. This file is distributed under the terms of *)(* the GNU Lesser General Public License version 2.1, with the *)(* special exception on linking described in the file LICENSE. *)(* *)(**************************************************************************)(* Pseudo-random number generator *)externalrandom_seed:unit->intarray="caml_sys_random_seed"moduleState=structopenBigarraytypet=(int64,int64_elt,c_layout)Array1.texternalnext:t->(int64[@unboxed])="caml_lxm_next""caml_lxm_next_unboxed"[@@noalloc]letcreate():t=Array1.createInt64C_layout4letsetsi1i2i3i4=Array1.unsafe_sets0(Int64.logori11L);(* must be odd *)Array1.unsafe_sets1i2;Array1.unsafe_sets2(ifi3<>0Ltheni3else1L);(* must not be 0 *)Array1.unsafe_sets3(ifi4<>0Ltheni4else2L)(* must not be 0 *)letmki1i2i3i4=lets=create()insetsi1i2i3i4;sletserialization_prefix="lxm1:"(* "lxm" denotes the algorithm currently in use, and '1' is
a version number. We should update this prefix if we change
the Random algorithm or the serialization format, so that users
get a clean error instead of believing that they faithfully
reproduce their previous state and in fact get a different
stream.
Note that there is no constraint to keep the same
"<name><ver>:<data>" format or message size in future versions,
we could change the format completely if we wanted as long
as there is no confusion possible with the previous formats. *)letserialization_prefix_len=String.lengthserialization_prefixletto_binary_strings=letprefix=serialization_prefixinletpreflen=serialization_prefix_leninletbuf=Bytes.create(preflen+4*8)inBytes.blit_stringprefix0buf0preflen;fori=0to3doBytes.set_int64_lebuf(preflen+i*8)(Array1.getsi)done;Bytes.unsafe_to_stringbufletof_binary_stringbuf=letprefix=serialization_prefixinletpreflen=serialization_prefix_leninifString.lengthbuf<>preflen+4*8||not(String.starts_with~prefixbuf)thenfailwith("Random.State.of_binary_string: expected a format \
compatible with OCaml "^Sys.ocaml_version);leti1=String.get_int64_lebuf(preflen+0*8)inleti2=String.get_int64_lebuf(preflen+1*8)inleti3=String.get_int64_lebuf(preflen+2*8)inleti4=String.get_int64_lebuf(preflen+3*8)inmki1i2i3i4letassign(dst:t)(src:t)=Array1.blitsrcdstletcopys=lets'=create()inassigns's;s'(* The seed is an array of integers. It can be just one integer,
but it can also be 12 or more bytes. To hide the difference,
we serialize the array as a sequence of bytes, then hash the
sequence with MD5 (Digest.bytes). MD5 gives only 128 bits while
we need 256 bits, so we hash twice with different suffixes. *)letreinitsseed=letn=Array.lengthseedinletb=Bytes.create(n*8+1)infori=0ton-1doBytes.set_int64_leb(i*8)(Int64.of_intseed.(i))done;Bytes.setb(n*8)'\x01';letd1=Digest.bytesbinBytes.setb(n*8)'\x02';letd2=Digest.bytesbinsets(String.get_int64_led10)(String.get_int64_led18)(String.get_int64_led20)(String.get_int64_led28)letmakeseed=lets=create()inreinitsseed;sletmake_self_init()=make(random_seed())letmin_int31=-0x4000_0000(* = -2{^30}, which is [min_int] for 31-bit integers *)letmax_int31=0x3FFF_FFFF(* = 2{^30}-1, which is [max_int] for 31-bit integers *)(* avoid integer literals for these, 32-bit OCaml would reject them: *)letmin_int32=-(1lsl31)(* = -0x8000_0000 on platforms where [Sys.int_size >= 32] *)letmax_int32=(1lsl31)-1(* = 0x7FFF_FFFF on platforms where [Sys.int_size >= 32] *)(* Return 30 random bits as an integer 0 <= x < 2^30 *)letbitss=Int64.to_int(nexts)landmax_int31(* Return an integer between 0 (included) and [n] (excluded).
[bound] may be any positive [int]. [mask] must be of the form [2{^i}-1]
and greater or equal to [n]. Larger values of [mask] make the function
run faster (fewer samples are rejected). Smaller values of [mask]
are usable on a wider range of OCaml implementations. *)letrecint_auxsnmask=(* We start by drawing a non-negative integer in the [ [0, mask] ] range *)letr=Int64.to_int(nexts)landmaskinletv=rmodnin(* For uniform distribution of the result between 0 included and [n]
* excluded, the random number [r] must have been drawn uniformly in
* an interval whose length is a multiple of [n]. To achieve this,
* we use rejection sampling on the greatest interval [ [0, k*n-1] ]
* that fits in [ [0, mask] ]. That is, we reject the
* sample if it falls outside of this interval, and draw again.
* This is what the test below does, while carefuly avoiding
* overflows and sparing a division [mask / n]. *)ifr-v>mask-n+1thenint_auxsnmaskelsev(* Return an integer between 0 (included) and [bound] (excluded).
The bound must fit in 31-bit signed integers.
This function yields the same output regardless of the integer size. *)letintsbound=ifbound>max_int31||bound<=0theninvalid_arg"Random.int"elseint_auxsboundmax_int31(* Return an integer between 0 (included) and [bound] (excluded).
[bound] may be any positive [int]. *)letfull_intsbound=ifbound<=0theninvalid_arg"Random.full_int"(* When the bound fits in 31-bit signed integers, we use the same mask
as in function [int] so as to yield the same output on all platforms
supported by OCaml (32-bit OCaml, 64-bit OCaml, and JavaScript).
When the bound fits in 32-bit signed integers, we use [max_int32]
as the mask so as to yield the same output on all platforms where
[Sys.int_size >= 32] (i.e. JavaScript and 64-bit OCaml). *)elseint_auxsbound(ifbound<=max_int31thenmax_int31elseifbound<=max_int32thenmax_int32elsemax_int)(* Return an integer between [min] (included) and [max] (included).
The [nbits] parameter is the size in bits of the signed integers
we draw from [s].
We must have [-2{^nbits - 1} <= min <= max < 2{^nbits - 1}].
Moreover, for the iteration to converge quickly, the interval
[[min, max]] should have width at least [2{^nbits - 1}].
As the width approaches this lower limit, the average number of
draws approaches 2, with a quite high standard deviation (2 + epsilon). *)letrecint_in_large_ranges~min~max~nbits=letdrop=Sys.int_size-nbitsin(* The bitshifts replicate the [nbits]-th bit (sign bit) to higher bits: *)letr=((Int64.to_int(nexts))lsldrop)asrdropinifr<min||r>maxthenint_in_large_ranges~min~max~nbitselser(* Return an integer between [min] (included) and [max] (included).
[mask] is as described for [int_aux].
[nbits] is as described for [int_in_large_range]. *)letint_in_range_auxs~min~max~mask~nbits=letspan=max-min+1inifspan<=mask(* [span] is small enough *)&&span>0(* no overflow occurred when computing [span] *)then(* Just draw a number in [[0, span)] and shift it by [min]. *)min+int_auxsspanmaskelse(* Span too large, use the alternative drawing method. *)int_in_large_ranges~min~max~nbits(* Return an integer between [min] (included) and [max] (included).
We must have [min <= max]. *)letint_in_ranges~min~max=ifmin>maxtheninvalid_arg"Random.int_in_range";(* When both bounds fit in 31-bit signed integers, we use parameters
[mask] and [nbits] appropriate for 31-bit integers, so as to
yield the same output on all platforms supported by OCaml.
When both bounds fit in 32-bit signed integers, we use parameters
[mask] and [nbits] appropriate for 32-bit integers, so as to
yield the same output on JavaScript and on 64-bit OCaml. *)ifmin>=min_int31&&max<=max_int31thenint_in_range_auxs~min~max~mask:max_int31~nbits:31elseifmin>=min_int32&&max<=max_int32thenint_in_range_auxs~min~max~mask:max_int32~nbits:32elseint_in_range_auxs~min~max~mask:max_int~nbits:Sys.int_size(* Return 32 random bits as an [int32] *)letbits32s=Int64.to_int32(nexts)(* Return an [int32] between 0 (included) and [bound] (excluded). *)letrecint32auxsn=letr=Int32.shift_right_logical(bits32s)1inletv=Int32.remrnin(* Explanation of this test: see comment in [int_aux]. *)ifInt32.(subrv>add(submax_intn)1l)thenint32auxsnelsevletint32sbound=ifbound<=0ltheninvalid_arg"Random.int32"elseint32auxsbound(* Return an [int32] between [min] (included) and [max] (included).
We must have [min <= max]. *)letrecint32_in_range_auxs~min~max=letr=Int64.to_int32(nexts)inifr<min||r>maxthenint32_in_range_auxs~min~maxelserletint32_in_ranges~min~max=ifmin>maxtheninvalid_arg"Random.int32_in_range"elseletspan=Int32.succ(Int32.submaxmin)in(* Explanation of this test: see comment in [int_in_range_aux]. *)ifspan<=Int32.zerothenint32_in_range_auxs~min~maxelseInt32.addmin(int32auxsspan)(* Return 64 random bits as an [int64] *)letbits64s=nexts(* Return an [int64] between 0 (included) and [bound] (excluded). *)letrecint64auxsn=letr=Int64.shift_right_logical(bits64s)1inletv=Int64.remrnin(* Explanation of this test: see comment in [int_aux]. *)ifInt64.(subrv>add(submax_intn)1L)thenint64auxsnelsevletint64sbound=ifbound<=0Ltheninvalid_arg"Random.int64"elseint64auxsbound(* Return an [int64] between [min] (included) and [max] (included).
We must have [min <= max]. *)letrecint64_in_range_auxs~min~max=letr=nextsinifr<min||r>maxthenint64_in_range_auxs~min~maxelserletint64_in_ranges~min~max=ifmin>maxtheninvalid_arg"Random.int64_in_range"elseletspan=Int64.succ(Int64.submaxmin)in(* Explanation of this test: see comment in [int_in_range_aux]. *)ifspan<=Int64.zerothenint64_in_range_auxs~min~maxelseInt64.addmin(int64auxsspan)(* Return 32 or 64 random bits as a [nativeint] *)letnativebits=ifNativeint.size=32thenfuns->Nativeint.of_int32(bits32s)elsefuns->Int64.to_nativeint(bits64s)(* Return a [nativeint] between 0 (included) and [bound] (excluded). *)letnativeint=ifNativeint.size=32thenfunsbound->Nativeint.of_int32(int32s(Nativeint.to_int32bound))elsefunsbound->Int64.to_nativeint(int64s(Int64.of_nativeintbound))(* Return a [nativeint] between [min] (included) and [max] (included). *)letnativeint_in_range=ifNativeint.size=32thenfuns~min~max->Nativeint.of_int32(int32_in_ranges~min:(Nativeint.to_int32min)~max:(Nativeint.to_int32max))elsefuns~min~max->Int64.to_nativeint(int64_in_ranges~min:(Int64.of_nativeintmin)~max:(Int64.of_nativeintmax))(* Return a float 0 < x < 1 uniformly distributed among the
multiples of 2^-53 *)letrecrawfloats=letb=nextsinletn=Int64.shift_right_logicalb11inifn<>0LthenInt64.to_floatn*.0x1.p-53elserawfloats(* Return a float between 0 and [bound] *)letfloatsbound=rawfloats*.bound(* Return a random Boolean *)letbools=nexts<0L(* Split a new PRNG off the given PRNG *)letsplits=leti1=bits64sinleti2=bits64sinleti3=bits64sinleti4=bits64sinmki1i2i3i4endletmk_default()=(* This is the state obtained with [State.make [| 314159265 |]]. *)State.mk(-6196874289567705097L)586573249833713189L(-8591268803865043407L)6388613595849772044Lletrandom_key=Domain.DLS.new_key~split_from_parent:State.splitmk_defaultletbits()=State.bits(Domain.DLS.getrandom_key)letintbound=State.int(Domain.DLS.getrandom_key)boundletfull_intbound=State.full_int(Domain.DLS.getrandom_key)boundletint_in_range~min~max=State.int_in_range(Domain.DLS.getrandom_key)~min~maxletint32bound=State.int32(Domain.DLS.getrandom_key)boundletint32_in_range~min~max=State.int32_in_range(Domain.DLS.getrandom_key)~min~maxletnativeintbound=State.nativeint(Domain.DLS.getrandom_key)boundletnativeint_in_range~min~max=State.nativeint_in_range(Domain.DLS.getrandom_key)~min~maxletint64bound=State.int64(Domain.DLS.getrandom_key)boundletint64_in_range~min~max=State.int64_in_range(Domain.DLS.getrandom_key)~min~maxletfloatscale=State.float(Domain.DLS.getrandom_key)scaleletbool()=State.bool(Domain.DLS.getrandom_key)letbits32()=State.bits32(Domain.DLS.getrandom_key)letbits64()=State.bits64(Domain.DLS.getrandom_key)letnativebits()=State.nativebits(Domain.DLS.getrandom_key)letfull_initseed=State.reinit(Domain.DLS.getrandom_key)seedletinitseed=full_init[|seed|]letself_init()=full_init(random_seed())(* Splitting *)letsplit()=State.split(Domain.DLS.getrandom_key)(* Manipulating the current state. *)letget_state()=State.copy(Domain.DLS.getrandom_key)letset_states=State.assign(Domain.DLS.getrandom_key)s