From c8780cdfa72e6ff728375d2d2f0b402e301a6133 Mon Sep 17 00:00:00 2001 From: Mark Brown Date: Tue, 27 Aug 2019 01:24:06 +1000 Subject: [PATCH] Address more of Julien's review comments. library/random.m: Move the new code to the existing random module. Update names and typeclass methods. Add adaptors to attach any ground or shared generator to the I/O state. library/random.sfc{16,32,64}.m: Move sfc generators to here. Update for changes to interface. extras/README: extras/random/*.m: Move unused generators to a new directory under extras. library/uint32.m: Add cast_from_uint/1. library/MODULES_DOC: library/library.m: Update for the module changes. tests/hard_coded/*: Rename test cases to correspond with the library module name. Test the I/O adaptor. --- extras/README | 3 + .../rng.binfile.m => extras/random/binfile.m | 61 +- .../random/marsaglia.m | 93 ++- .../random/tausworthe.m | 191 ++--- library/MODULES_DOC | 8 +- library/library.m | 16 +- library/random.m | 671 +++++++++++++++++- library/random.sfc16.m | 141 ++++ library/random.sfc32.m | 184 +++++ library/random.sfc64.m | 182 +++++ library/rng.m | 352 --------- library/rng.sfc.m | 354 --------- library/uint32.m | 37 + tests/hard_coded/Mmakefile | 6 +- tests/hard_coded/random1.exp | 65 ++ tests/hard_coded/random1.m | 47 ++ tests/hard_coded/random2.exp | 65 ++ tests/hard_coded/random2.m | 49 ++ tests/hard_coded/random3.exp | 65 ++ tests/hard_coded/random3.m | 49 ++ tests/hard_coded/rng1.exp | 131 ---- tests/hard_coded/rng1.m | 55 -- tests/hard_coded/rng2.exp | 131 ---- tests/hard_coded/rng2.m | 59 -- tests/hard_coded/rng3.data | 1 - tests/hard_coded/rng3.exp | 20 - tests/hard_coded/rng3.m | 57 -- 27 files changed, 1758 insertions(+), 1335 deletions(-) rename library/rng.binfile.m => extras/random/binfile.m (61%) rename library/rng.marsaglia.m => extras/random/marsaglia.m (57%) rename library/rng.tausworthe.m => extras/random/tausworthe.m (63%) create mode 100644 library/random.sfc16.m create mode 100644 library/random.sfc32.m create mode 100644 library/random.sfc64.m delete mode 100644 library/rng.m delete mode 100644 library/rng.sfc.m create mode 100644 tests/hard_coded/random1.exp create mode 100644 tests/hard_coded/random1.m create mode 100644 tests/hard_coded/random2.exp create mode 100644 tests/hard_coded/random2.m create mode 100644 tests/hard_coded/random3.exp create mode 100644 tests/hard_coded/random3.m delete mode 100644 tests/hard_coded/rng1.exp delete mode 100644 tests/hard_coded/rng1.m delete mode 100644 tests/hard_coded/rng2.exp delete mode 100644 tests/hard_coded/rng2.m delete mode 100644 tests/hard_coded/rng3.data delete mode 100644 tests/hard_coded/rng3.exp delete mode 100644 tests/hard_coded/rng3.m diff --git a/extras/README b/extras/README index e4e50a8da..192e7f46c 100644 --- a/extras/README +++ b/extras/README @@ -80,6 +80,9 @@ old_term_parser A library containing versions of the the standard library's posix A Mercury interface to some of the POSIX (Portable Operating System Interface) APIs. +random Some additional instances of the random typeclasses from + the standard library. + references A library package containing modules for manipulating ML-style references (mutable state). diff --git a/library/rng.binfile.m b/extras/random/binfile.m similarity index 61% rename from library/rng.binfile.m rename to extras/random/binfile.m index 6defd2566..36be4f9ec 100644 --- a/library/rng.binfile.m +++ b/extras/random/binfile.m @@ -5,7 +5,7 @@ % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % -% File: rng.binfile.m +% File: binfile.m % Main author: Mark Brown % % "Random" number generator that reads numbers from a binary file. @@ -13,15 +13,16 @@ %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% -:- module rng.binfile. +:- module binfile. :- interface. :- import_module io. +:- import_module random. %---------------------------------------------------------------------------% :- type binfile. -:- instance urng(binfile, io). +:- instance urandom(binfile, io). % Open a binfile generator from a filename. This should be closed % when no longer needed. @@ -36,19 +37,16 @@ %---------------------------------------------------------------------------% - % Generate a number between 0 and max_uint64. This reads 8 bytes - % at a time from the binfile and interprets them as an unsigned, - % big-endian integer. + % Generate an unsigned integer of 8, 16, 32 or 64 bits, reespectively. + % This reads the required number of bytes from the file and interprets + % them as an unsigned, big-endian integer. % % Throws an exception if the end-of-file is reached. % -:- pred rand(binfile, uint64, io, io). -:- mode rand(in, out, di, uo) is det. - - % Returns max_uint64, the maximum number that can be returned by this - % generator. - % -:- func rand_max(binfile) = uint64. +:- pred gen_uint8(binfile::in, uint8::out, io::di, io::uo) is det. +:- pred gen_uint16(binfile::in, uint16::out, io::di, io::uo) is det. +:- pred gen_uint32(binfile::in, uint32::out, io::di, io::uo) is det. +:- pred gen_uint64(binfile::in, uint64::out, io::di, io::uo) is det. %---------------------------------------------------------------------------% @@ -62,9 +60,11 @@ :- type binfile ---> binfile(binary_input_stream). -:- instance urng(binfile, io) where [ - pred(urandom/4) is rand, - func(urandom_max/1) is rand_max +:- instance urandom(binfile, io) where [ + pred(gen_uint8/4) is binfile.gen_uint8, + pred(gen_uint16/4) is binfile.gen_uint16, + pred(gen_uint32/4) is binfile.gen_uint32, + pred(gen_uint64/4) is binfile.gen_uint64 ]. %---------------------------------------------------------------------------% @@ -84,8 +84,33 @@ close(binfile(Stream), !IO) :- %---------------------------------------------------------------------------% -rand(binfile(Stream), N, !IO) :- +gen_uint8(binfile(Stream), N, !IO) :- + io.read_binary_uint8(Stream, Res, !IO), + ( + Res = ok(N) + ; + Res = eof, + unexpected($pred, "end of file") + ; + Res = error(E), + unexpected($pred, io.error_message(E)) + ). + +gen_uint16(binfile(Stream), N, !IO) :- + io.read_binary_uint16_be(Stream, Res, !IO), + handle_res(Res, N). + +gen_uint32(binfile(Stream), N, !IO) :- + io.read_binary_uint32_be(Stream, Res, !IO), + handle_res(Res, N). + +gen_uint64(binfile(Stream), N, !IO) :- io.read_binary_uint64_be(Stream, Res, !IO), + handle_res(Res, N). + +:- pred handle_res(maybe_incomplete_result(T)::in, T::out) is det. + +handle_res(Res, N) :- ( Res = ok(N) ; @@ -98,6 +123,4 @@ rand(binfile(Stream), N, !IO) :- unexpected($pred, io.error_message(E)) ). -rand_max(_) = uint64.max_uint64. - %---------------------------------------------------------------------------% diff --git a/library/rng.marsaglia.m b/extras/random/marsaglia.m similarity index 57% rename from library/rng.marsaglia.m rename to extras/random/marsaglia.m index 25053f10d..14699f0da 100644 --- a/library/rng.marsaglia.m +++ b/extras/random/marsaglia.m @@ -5,7 +5,7 @@ % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % -% File: rng.marsaglia.m +% File: marsaglia.m % Main author: Mark Brown % % Very fast concatenation of two 16-bit MWC generators. @@ -17,67 +17,84 @@ %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% -:- module rng.marsaglia. +:- module marsaglia. :- interface. -%---------------------------------------------------------------------------% - -:- type marsaglia. - -:- instance rng(marsaglia). - - % Initialise a marsaglia RNG with the default seed. - % -:- func init = marsaglia. - - % Initialise a marsaglia RNG with the given seed. - % -:- func seed(uint32, uint32) = marsaglia. +:- import_module random. %---------------------------------------------------------------------------% - % Generate a random number between 0 and max_uint32. - % -:- pred rand(uint32, marsaglia, marsaglia). -:- mode rand(out, in, out) is det. +:- type random. - % Return max_uint32, the maximum number that can be returned by this - % generator. +:- instance random(random). + + % Initialise a marsaglia generator with the default seed. % -:- func rand_max(marsaglia) = uint32. +:- func init = random. + + % Initialise a marsaglia generator with the given seed. + % +:- func seed(uint32, uint32) = random. + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bytes, respectively. + % +:- pred gen_uint8(uint8::out, random::in, random::out) is det. +:- pred gen_uint16(uint16::out, random::in, random::out) is det. +:- pred gen_uint32(uint32::out, random::in, random::out) is det. +:- pred gen_uint64(uint64::out, random::in, random::out) is det. %---------------------------------------------------------------------------% :- implementation. +:- import_module uint8. +:- import_module uint16. :- import_module uint32. +:- import_module uint64. %---------------------------------------------------------------------------% -:- type marsaglia - ---> marsaglia(uint64). +:- type random + ---> random(uint64). -:- instance rng(marsaglia) where [ - ( random(N, !RNG) :- - rand(N0, !RNG), - N = uint32.cast_to_uint64(N0) - ), - ( random_max(RNG) = uint32.cast_to_uint64(rand_max(RNG)) ) +:- instance random(random) where [ + pred(gen_uint8/3) is marsaglia.gen_uint8, + pred(gen_uint16/3) is marsaglia.gen_uint16, + pred(gen_uint32/3) is marsaglia.gen_uint32, + pred(gen_uint64/3) is marsaglia.gen_uint64 ]. -%---------------------------------------------------------------------------% - init = seed(0u32, 0u32). -seed(SX0, SY0) = RNG :- +seed(SX0, SY0) = R :- SX = ( if SX0 = 0u32 then 521288629u32 else SX0 ), SY = ( if SY0 = 0u32 then 362436069u32 else SY0 ), - RNG = marsaglia(pack_uint64(SX, SY)). + R = random(pack_uint64(SX, SY)). %---------------------------------------------------------------------------% -rand(N, RNG0, RNG) :- - RNG0 = marsaglia(S0), +gen_uint8(N, !R) :- + marsaglia.gen_uint32(N0, !R), + N1 = uint32.cast_to_int(N0 >> 24), + N = uint8.cast_from_int(N1). + +gen_uint16(N, !R) :- + marsaglia.gen_uint32(N0, !R), + N1 = uint32.cast_to_int(N0 >> 16), + N = uint16.cast_from_int(N1). + +gen_uint64(N, !R) :- + marsaglia.gen_uint32(A0, !R), + marsaglia.gen_uint32(B0, !R), + A = uint32.cast_to_uint64(A0), + B = uint32.cast_to_uint64(B0), + N = A + (B << 32). + +%---------------------------------------------------------------------------% + +gen_uint32(N, R0, R) :- + R0 = random(S0), unpack_uint64(S0, SX0, SY0), A = 18000u32, B = 30903u32, @@ -86,9 +103,7 @@ rand(N, RNG0, RNG) :- SY = B * (SY0 /\ M) + (SY0 >> 16), N = (SX << 16) + (SY /\ M), S = pack_uint64(SX, SY), - RNG = marsaglia(S). - -rand_max(_) = uint32.max_uint32. + R = random(S). %---------------------------------------------------------------------------% diff --git a/library/rng.tausworthe.m b/extras/random/tausworthe.m similarity index 63% rename from library/rng.tausworthe.m rename to extras/random/tausworthe.m index a50624502..05c88f147 100644 --- a/library/rng.tausworthe.m +++ b/extras/random/tausworthe.m @@ -5,7 +5,7 @@ % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % -% File: rng.tausworthe.m +% File: tausworthe.m % Main author: Mark Brown % % Combined Tausworthe-type generators. See: @@ -21,63 +21,60 @@ %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% -:- module rng.tausworthe. +:- module tausworthe. :- interface. :- import_module maybe. +:- import_module random. %---------------------------------------------------------------------------% :- type params. -:- type state. +:- type ustate. -:- instance urng(params, state). -:- instance urng_dup(state). +:- instance urandom(params, ustate). +:- instance urandom_dup(ustate). - % Initialise a 3-combo tausworthe RNG with the default seed + % Initialise a 3-combo tausworthe generator with the default seed % and parameters. % -:- pred init_t3(params, state). -:- mode init_t3(out, uo) is det. +:- pred init_t3(params::out, ustate::uo) is det. - % Initialise a 4-combo tausworthe RNG with the default seed + % Initialise a 4-combo tausworthe generator with the default seed % and parameters. % -:- pred init_t4(params, state). -:- mode init_t4(out, uo) is det. +:- pred init_t4(params::out, ustate::uo) is det. - % Initialise a 3-combo tausworthe RNG with the given seed. + % Initialise a 3-combo tausworthe generator with the given seed. % If given, the first argument selects from one of two sets of % parameters, depending on its value modulo 2. % -:- pred seed_t3(maybe(int), uint32, uint32, uint32, params, state). -:- mode seed_t3(in, in, in, in, out, uo) is det. +:- pred seed_t3(maybe(int)::in, uint32::in, uint32::in, uint32::in, + params::out, ustate::uo) is det. - % Initialise a 4-combo tausworthe RNG with the given seed. + % Initialise a 4-combo tausworthe generator with the given seed. % If given, the first argument selects from one of 62 sets of % parameters, depending on its value modulo 62. % -:- pred seed_t4(maybe(int), uint32, uint32, uint32, uint32, params, state). -:- mode seed_t4(in, in, in, in, in, out, uo) is det. +:- pred seed_t4(maybe(int)::in, uint32::in, uint32::in, uint32::in, uint32::in, + params::out, ustate::uo) is det. %---------------------------------------------------------------------------% - % Generate a random number between 0 and max_uint32. Throws an - % exception if the params and state are not the same size (i.e., - % both 3-combo or both 4-combo). + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. % -:- pred rand(params, uint32, state, state). -:- mode rand(in, out, di, uo) is det. - - % Return max_uint32, the maximum number that can be returned by this - % generator. + % Throws an exception if the params and ustate are not the same size + % (i.e., both 3-combo or both 4-combo). % -:- func rand_max(params) = uint32. +:- pred gen_uint8(params::in, uint8::out, ustate::di, ustate::uo) is det. +:- pred gen_uint16(params::in, uint16::out, ustate::di, ustate::uo) is det. +:- pred gen_uint32(params::in, uint32::out, ustate::di, ustate::uo) is det. +:- pred gen_uint64(params::in, uint64::out, ustate::di, ustate::uo) is det. % Duplicate a tausworthe RNG state. % -:- pred dup(state, state, state). -:- mode dup(di, uo, uo) is det. +:- pred urandom_dup(ustate::di, ustate::uo, ustate::uo) is det. %---------------------------------------------------------------------------% @@ -87,7 +84,10 @@ :- import_module int. :- import_module list. :- import_module require. +:- import_module uint8. +:- import_module uint16. :- import_module uint32. +:- import_module uint64. %---------------------------------------------------------------------------% @@ -99,32 +99,79 @@ mask :: array(uint32) ). -:- type state - ---> state( +:- type ustate + ---> ustate( seed :: array(uint32) ). -:- instance urng(params, state) where [ - ( urandom(RP, N, !RS) :- - rand(RP, N0, !RS), - N = uint32.cast_to_uint64(N0) - ), - ( urandom_max(RP) = uint32.cast_to_uint64(rand_max(RP)) ) +:- instance urandom(params, ustate) where [ + pred(gen_uint8/4) is tausworthe.gen_uint8, + pred(gen_uint16/4) is tausworthe.gen_uint16, + pred(gen_uint32/4) is tausworthe.gen_uint32, + pred(gen_uint64/4) is tausworthe.gen_uint64 ]. -:- instance urng_dup(state) where [ - pred(urandom_dup/3) is dup +:- instance urandom_dup(ustate) where [ + pred(urandom_dup/3) is tausworthe.urandom_dup ]. -dup(S, S1, S2) :- - S = state(A), +urandom_dup(S, S1, S2) :- + S = ustate(A), + Sc = ustate(array.copy(A)), S1 = unsafe_promise_unique(S), - S2 = unsafe_promise_unique(state(array.copy(A))). + S2 = unsafe_promise_unique(Sc). %---------------------------------------------------------------------------% -:- pred seed(array(int), array(int), array(uint32), params, state). -:- mode seed(in, in, array_di, out, uo) is det. +gen_uint8(RP, N, !RS) :- + tausworthe.gen_uint32(RP, N0, !RS), + N1 = uint32.cast_to_int(N0 >> 24), + N = uint8.cast_from_int(N1). + +gen_uint16(RP, N, !RS) :- + tausworthe.gen_uint32(RP, N0, !RS), + N1 = uint32.cast_to_int(N0 >> 16), + N = uint16.cast_from_int(N1). + +gen_uint64(RP, N, !RS) :- + tausworthe.gen_uint32(RP, A0, !RS), + tausworthe.gen_uint32(RP, B0, !RS), + A = uint32.cast_to_uint64(A0), + B = uint32.cast_to_uint64(B0), + N = A + (B << 32). + +%---------------------------------------------------------------------------% + +gen_uint32(RP, N, RS0, RS) :- + RS0 = ustate(Seed0), + Size = array.size(Seed0), + rand(RP, 0, Size, 0u32, N, Seed0, Seed), + RS = unsafe_promise_unique(ustate(Seed)). + +:- pred rand(params::in, int::in, int::in, uint32::in, uint32::out, + array(uint32)::array_di, array(uint32)::array_uo) is det. + +rand(RP, I, Size, N0, N, !Seed) :- + ( if I < Size then + array.lookup(RP ^ qs, I, Q), + array.lookup(RP ^ ps, I, P), + array.lookup(RP ^ shft, I, Shft), + array.lookup(RP ^ mask, I, Mask), + array.lookup(!.Seed, I, S0), + B = ((S0 << Q) `xor` S0) >> Shft, + S = ((S0 /\ Mask) << P) `xor` B, + array.set(I, S, !Seed), + N1 = N0 `xor` S, + rand(RP, I + 1, Size, N1, N, !Seed) + else + N = N0 + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- pred seed(array(int)::in, array(int)::in, array(uint32)::array_di, + params::out, ustate::uo) is det. seed(Qs, Ps, Seed0, RP, RS) :- Size = array.size(Seed0), @@ -134,27 +181,26 @@ seed(Qs, Ps, Seed0, RP, RS) :- Mask0 = array.init(Size, 0u32), seed_2(0, Size, Ks, Ps, Ds, Shft0, Shft, Mask0, Mask, Seed0, Seed), RP = params(Qs, Ps, Shft, Mask), - RS0 = unsafe_promise_unique(state(Seed)), - rand(RP, _, RS0, RS). + RS0 = unsafe_promise_unique(ustate(Seed)), + tausworthe.gen_uint32(RP, _, RS0, RS). -:- pred seed_2(int, int, array(int), array(int), array(uint32), - array(int), array(int), array(uint32), array(uint32), - array(uint32), array(uint32)). -:- mode seed_2(in, in, in, in, in, - array_di, array_uo, array_di, array_uo, array_di, array_uo) is det. +:- pred seed_2(int::in, int::in, array(int)::in, array(int)::in, + array(uint32)::in, array(int)::array_di, array(int)::array_uo, + array(uint32)::array_di, array(uint32)::array_uo, + array(uint32)::array_di, array(uint32)::array_uo) is det. seed_2(I, Size, Ks, Ps, Ds, !Shft, !Mask, !Seed) :- ( if I < Size then - K = array.lookup(Ks, I), - P = array.lookup(Ps, I), - S = array.lookup(!.Seed, I), + array.lookup(Ks, I, K), + array.lookup(Ps, I, P), + array.lookup(!.Seed, I, S), J = 32 - K, array.set(I, K - P, !Shft), array.set(I, uint32.max_uint32 << J, !Mask), ( if S > (1u32 << J) then true else - D = array.lookup(Ds, I), + array.lookup(Ds, I, D), array.set(I, D, !Seed) ), seed_2(I + 1, Size, Ks, Ps, Ds, !Shft, !Mask, !Seed) @@ -164,36 +210,6 @@ seed_2(I, Size, Ks, Ps, Ds, !Shft, !Mask, !Seed) :- %---------------------------------------------------------------------------% -rand(RP, N, RS0, RS) :- - RS0 = state(Seed0), - Size = array.size(Seed0), - rand_2(RP, 0, Size, 0u32, N, Seed0, Seed), - RS = unsafe_promise_unique(state(Seed)). - -:- pred rand_2(params, int, int, uint32, uint32, array(uint32), array(uint32)). -:- mode rand_2(in, in, in, in, out, array_di, array_uo) is det. - -rand_2(RP, I, Size, N0, N, !Seed) :- - ( if I < Size then - Q = array.lookup(RP ^ qs, I), - P = array.lookup(RP ^ ps, I), - Shft = array.lookup(RP ^ shft, I), - Mask = array.lookup(RP ^ mask, I), - S0 = array.lookup(!.Seed, I), - B = ((S0 << Q) `xor` S0) >> Shft, - S = ((S0 /\ Mask) << P) `xor` B, - array.set(I, S, !Seed), - N1 = N0 `xor` S, - rand_2(RP, I + 1, Size, N1, N, !Seed) - else - N = N0 - ). - -rand_max(_) = uint32.max_uint32. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - init_t3(RP, RS) :- seed_t3(no, 0u32, 0u32, 0u32, RP, RS). @@ -213,8 +229,8 @@ seed_t3(MZ, A, B, C, RP, RS) :- Seed = array([A, B, C]), seed(Qs, Ps, Seed, RP, RS). -:- pred params_t3(int, int, int, int, int, int, int). -:- mode params_t3(in, out, out, out, out, out, out) is semidet. +:- pred params_t3(int::in, int::out, int::out, int::out, int::out, int::out, + int::out) is semidet. params_t3(0, 13, 2, 3, 12, 4, 17). params_t3(1, 3, 2, 13, 20, 16, 7). @@ -240,8 +256,7 @@ seed_t4(MZ, A, B, C, D, RP, RS) :- Seed = array([A, B, C, D]), seed(Qs, Ps, Seed, RP, RS). -:- pred params_t4(int, int, int, int, int). -:- mode params_t4(in, out, out, out, out) is semidet. +:- pred params_t4(int::in, int::out, int::out, int::out, int::out) is semidet. params_t4(0, 18, 2, 7, 13). params_t4(1, 13, 3, 4, 9). diff --git a/library/MODULES_DOC b/library/MODULES_DOC index 391c51e88..a96e5ee37 100644 --- a/library/MODULES_DOC +++ b/library/MODULES_DOC @@ -57,15 +57,13 @@ prolog.m psqueue.m queue.m random.m +random.sfc16.m +random.sfc32.m +random.sfc64.m ranges.m rational.m rbtree.m require.m -rng.m -rng.binfile.m -rng.marsaglia.m -rng.sfc.m -rng.tausworthe.m rtree.m set.m set_bbbtree.m diff --git a/library/library.m b/library/library.m index 9b438d9c4..ad7319220 100644 --- a/library/library.m +++ b/library/library.m @@ -120,15 +120,13 @@ :- import_module psqueue. :- import_module queue. :- import_module random. +:- import_module random.sfc16. +:- import_module random.sfc32. +:- import_module random.sfc64. :- import_module ranges. :- import_module rational. :- import_module rbtree. :- import_module require. -:- import_module rng. -:- import_module rng.binfile. -:- import_module rng.marsaglia. -:- import_module rng.sfc. -:- import_module rng.tausworthe. :- import_module robdd. :- import_module rtree. :- import_module set. @@ -309,16 +307,14 @@ mercury_std_library_module("prolog"). mercury_std_library_module("psqueue"). mercury_std_library_module("queue"). mercury_std_library_module("random"). +mercury_std_library_module("random.sfc16"). +mercury_std_library_module("random.sfc32"). +mercury_std_library_module("random.sfc64"). mercury_std_library_module("ranges"). mercury_std_library_module("rational"). mercury_std_library_module("rbtree"). mercury_std_library_module("region_builtin"). mercury_std_library_module("require"). -mercury_std_library_module("rng"). -mercury_std_library_module("rng.binfile"). -mercury_std_library_module("rng.marsaglia"). -mercury_std_library_module("rng.sfc"). -mercury_std_library_module("rng.tausworthe"). mercury_std_library_module("robdd"). mercury_std_library_module("rtree"). mercury_std_library_module("rtti_implementation"). diff --git a/library/random.m b/library/random.m index d49669d0d..8c1b54618 100644 --- a/library/random.m +++ b/library/random.m @@ -2,13 +2,339 @@ % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1994-1998,2001-2006, 2011 The University of Melbourne. -% Copyright (C) 2015-2016, 2018 The Mercury team. +% Copyright (C) 2015-2016, 2018-2019 The Mercury team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: random.m -% Main author: conway -% Stability: low +% Main author: Mark Brown +% +% This module provides interfaces to several random number generators, +% implementations of which can be found in the submodules. +% +% The interfaces can be used in three styles: +% +% - In the "ground" style, an instance of the random/1 typeclass is +% passed through the code using 'in' and 'out' modes. This can be used +% to generate random numbers, and since the value is ground it can also +% easily be stored in larger data structures. The major drawback is that +% generators in this style tend to be either fast or of good quality, +% but not both. +% +% - In the "unique" style, the urandom/2 typeclass is used instead. Each +% instance consists of a "params" type which is passed into the code +% using an 'in' mode, and a "state" type which is passed through the +% code using modes 'di' and 'uo'. The uniqueness allows destructive +% update, which means that these generators can be both fast and good. +% +% - A generator can be attached to the I/O state. In this case, the +% interface is the same as the unique style, with 'io' being used as +% the unique state. +% +% Each generator defined in the submodules is natively one of the first +% two styles. Adaptors are defined below for converting between these, +% or from either of these to the third style. +% +% +% Example, ground style: +% +% main(!IO) :- +% R0 = sfc16.init, +% roll(R0, R1, !IO), +% roll(R1, _, !IO). +% +% :- pred roll(R::in, R::out, io::di, io::uo) is det <= random(R). +% +% roll(!R, !IO) :- +% uniform_int_in_range(1, 6, N, !R), +% io.format("You rolled a %d\n", [i(N)], !IO). +% +% +% Example, unique style: +% +% main(!IO) :- +% sfc64.init(P, S0), +% roll(P, S0, S1, !IO), +% roll(P, S1, _, !IO). +% +% :- pred roll(P::in, S::di, S::uo, io::di, io::uo) is det <= urandom(P, S). +% +% roll(P, !S, !IO) :- +% uniform_int_in_range(P, 1, 6, N, !S), +% io.format("You rolled a %d\n", [i(N)], !IO). +% +% +% Example, attached to I/O state: +% +% main(!IO) :- +% % Using a ground generator. +% R = sfc16.init, +% make_io_random(R, M1, !IO), +% roll(M1, !IO), +% roll(M1, !IO), +% +% % Using a unique generator. +% sfc64.init(P, S), +% make_io_urandom(P, S, M2, !IO), +% roll(M2, !IO), +% roll(M2, !IO). +% +% :- pred roll(M::in, io::di, io::uo) is det <= urandom(M, io). +% +% roll(M, !IO) :- +% uniform_int_in_range(M, 1, 6, N, !IO), +% io.format("You rolled a %d\n", [i(N)], !IO). +% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- module random. +:- interface. + +:- include_module sfc16. +:- include_module sfc32. +:- include_module sfc64. + +:- import_module io. +:- import_module list. + +%---------------------------------------------------------------------------% + + % Interface to random number generators. + % +:- typeclass random(R) where [ + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % + pred gen_uint8(uint8::out, R::in, R::out) is det, + pred gen_uint16(uint16::out, R::in, R::out) is det, + pred gen_uint32(uint32::out, R::in, R::out) is det, + pred gen_uint64(uint64::out, R::in, R::out) is det + +]. + + % uniform_int_in_range(Start, Range, N, !R) + % + % Generate a pseudo-random integer that is uniformly distributed + % in the range Start to (Start + Range - 1), inclusive. + % + % Throws an exception if Range < 1 or Range > uint32_max. + % +:- pred uniform_int_in_range(int::in, int::in, int::out, R::in, R::out) + is det <= random(R). + + % uniform_uint_in_range(Start, Range, N, !R) + % + % Generate a pseudo-random unsigned integer that is uniformly + % distributed in the range Start to (Start + Range - 1), inclusive. + % + % Throws an exception if Range < 1 or Range > uint32_max. + % +:- pred uniform_uint_in_range(uint::in, uint::in, uint::out, R::in, R::out) + is det <= random(R). + + % uniform_float_in_range(Start, Range, N, !R) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval [Start, Start + Range). + % +:- pred uniform_float_in_range(float::in, float::in, float::out, R::in, R::out) + is det <= random(R). + + % uniform_float_around_mid(Mid, Delta, N, !R) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval (Mid - Delta, Mid + Delta). + % +:- pred uniform_float_around_mid(float::in, float::in, float::out, + R::in, R::out) is det <= random(R). + + % uniform_float_in_01(N, !R) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval [0.0, 1.0). + % +:- pred uniform_float_in_01(float::out, R::in, R::out) is det <= random(R). + + % normal_floats(M, SD, U, V, !R) + % + % Generate two pseudo-random floats from a normal (i.e., Gaussian) + % distribution with mean M and standard deviation SD, using the + % Box-Muller method. + % + % We generate two at a time for efficiency; they are independent of + % each other. + % +:- pred normal_floats(float::in, float::in, float::out, float::out, + R::in, R::out) is det <= random(R). + + % normal_floats(U, V, !R) + % + % Generate two pseudo-random floats from a normal (i.e., Gaussian) + % distribution with mean 0.0 and standard deviation 1.0, using the + % Nox-Muller method. + % + % We generate two at a time for efficiency; they are independent of + % each other. + % +:- pred normal_floats(float::out, float::out, R::in, R::out) is det + <= random(R). + +%---------------------------------------------------------------------------% + + % Interface to unique random number generators. Callers need to + % ensure they preserve the uniqueness of the random state, and in + % turn instances can use destructive update on it. + % +:- typeclass urandom(P, S) <= (P -> S) where [ + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % + pred gen_uint8(P::in, uint8::out, S::di, S::uo) is det, + pred gen_uint16(P::in, uint16::out, S::di, S::uo) is det, + pred gen_uint32(P::in, uint32::out, S::di, S::uo) is det, + pred gen_uint64(P::in, uint64::out, S::di, S::uo) is det + +]. + +:- typeclass urandom_dup(S) where [ + + % urandom_dup(!S, !:Sdup) + % + % Create a duplicate random state that will generate the same + % sequence of integers. + % + pred urandom_dup(S::di, S::uo, S::uo) is det + +]. + + % uniform_int_in_range(P, Start, Range, N, !S) + % + % Generate a pseudo-random integer that is uniformly distributed + % in the range Start to (Start + Range - 1), inclusive. + % + % Throws an exception if Range < 1 or Range > uint32_max. + % +:- pred uniform_int_in_range(P::in, int::in, int::in, int::out, S::di, S::uo) + is det <= urandom(P, S). + + % uniform_uint_in_range(P, Start, Range, N, !S) + % + % Generate a pseudo-random unsigned integer that is uniformly + % distributed in the range Start to (Start + Range - 1), inclusive. + % + % Throws an exception if Range < 1 or Range > uint32_max. + % +:- pred uniform_uint_in_range(P::in, uint::in, uint::in, uint::out, + S::di, S::uo) is det <= urandom(P, S). + + % uniform_float_in_range(P, Start, Range, N, !S) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval [Start, Start + Range). + % +:- pred uniform_float_in_range(P::in, float::in, float::in, float::out, + S::di, S::uo) is det <= urandom(P, S). + + % uniform_float_around_mid(P, Mid, Delta, N, !S) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval (Mid - Delta, Mid + Delta). + % +:- pred uniform_float_around_mid(P::in, float::in, float::in, float::out, + S::di, S::uo) is det <= urandom(P, S). + + % uniform_float_in_01(P, N, !S) + % + % Generate a pseudo-random float that is uniformly distributed + % in the interval [0.0, 1.0). + % +:- pred uniform_float_in_01(P::in, float::out, S::di, S::uo) is det + <= urandom(P, S). + + % normal_floats(P, M, S, U, V, !S) + % + % Generate two pseudo-random floats from a normal (i.e., Gaussian) + % distribution with mean M and standard deviation S, using the + % Box-Muller method. + % + % We generate two at a time for efficiency; they are independent of + % each other. + % +:- pred normal_floats(P::in, float::in, float::in, float::out, float::out, + S::di, S::uo) is det <= urandom(P, S). + + % normal_floats(P, U, V, !S) + % + % Generate two pseudo-random floats from a normal (i.e., Gaussian) + % distribution with mean 0.0 and standard deviation 1.0, using the + % Nox-Muller method. + % + % We generate two at a time for efficiency; they are independent of + % each other. + % +:- pred normal_floats(P::in, float::out, float::out, S::di, S::uo) is det + <= urandom(P, S). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % Convert any instance of random/1 into an instance of urandom/2. + % This creates additional overhead in the form of additional + % typeclass method calls. + % +:- type urandom_params(R). +:- type urandom_state(R). + +:- instance urandom(urandom_params(R), urandom_state(R)) <= random(R). +:- instance urandom_dup(urandom_state(R)) <= random(R). + +:- pred make_urandom(R::in, urandom_params(R)::out, urandom_state(R)::uo) + is det. + +%---------------------------------------------------------------------------% + + % Convert any instance of urandom/2 and urandom_dup/1 into an + % instance of random/1. This duplicates the state every time a + % random number is generated, hence may use significantly more + % memory than if the unique version were used directly. + % +:- type shared_random(P, S). + +:- instance random(shared_random(P, S)) <= (urandom(P, S), urandom_dup(S)). + +:- func make_shared_random(P::in, S::di) = (shared_random(P, S)::out) is det. + +%---------------------------------------------------------------------------% + + % Convert any instance of random/1 into an instance of urandom/2 + % where the state is the I/O state. + % +:- type io_random(R). + +:- instance urandom(io_random(R), io) <= random(R). + +:- pred make_io_random(R::in, io_random(R)::out, io::di, io::uo) is det + <= random(R). + +%---------------------------------------------------------------------------% + + % Convert any instance of urandom/2 into an instance of urandom/2 + % where the state is the I/O state. + % +:- type io_urandom(P, S). + +:- instance urandom(io_urandom(P, S), io) <= urandom(P, S). + +:- pred make_io_urandom(P::in, S::di, io_urandom(P, S)::out, io::di, io::uo) + is det <= urandom(P, S). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +% +% Interface to the older random number generator. This is now deprecated. % % Define a set of random number generator predicates. This implementation % uses a threaded random-number supply. The supply can be used in a @@ -45,14 +371,6 @@ % order. If you do, it is likely that the resulting sequence will % not cover the full range of possible tuples. % -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- module random. -:- interface. - -:- import_module list. - %---------------------------------------------------------------------------% % The type `supply' represents a supply of random numbers. @@ -63,6 +381,7 @@ % % Creates a supply of random numbers RS using the specified Seed. % +:- pragma obsolete(init/2). :- pred init(int::in, supply::uo) is det. % random(Num, !RS). @@ -129,7 +448,337 @@ :- implementation. :- import_module array. +:- import_module float. :- import_module int. +:- import_module math. +:- import_module mutvar. +:- import_module uint. +:- import_module uint32. + +%---------------------------------------------------------------------------% + +uniform_int_in_range(Start, Range0, N, !R) :- + Range = uint32.det_from_int(Range0), + Max = uint32.max_uint32, + gen_uint32(N0, !R), + N1 = N0 // (Max // Range), + ( if N1 < Range then + N = Start + uint32.cast_to_int(N1) + else + uniform_int_in_range(Start, Range0, N, !R) + ). + +uniform_uint_in_range(Start, Range0, N, !R) :- + Range = uint32.cast_from_uint(Range0), + Max = uint32.max_uint32, + gen_uint32(N0, !R), + N1 = N0 // (Max // Range), + ( if N1 < Range then + N = Start + uint32.cast_to_uint(N1) + else + uniform_uint_in_range(Start, Range0, N, !R) + ). + +uniform_float_in_range(Start, Range, N, !R) :- + uniform_float_in_01(N0, !R), + N = Start + (N0 * Range). + +uniform_float_around_mid(Mid, Delta, N, !R) :- + uniform_float_in_01(N0, !R), + ( if N0 = 0.0 then + uniform_float_around_mid(Mid, Delta, N, !R) + else + N = Mid + Delta * (2.0 * N0 - 1.0) + ). + +uniform_float_in_01(N, !R) :- + gen_uint64(N0, !R), + D = 18_446_744_073_709_551_616.0, % 2^64 + N = float.cast_from_uint64(N0) / D. + +normal_floats(M, SD, U, V, !R) :- + normal_floats(U0, V0, !R), + U = M + SD * U0, + V = M + SD * V0. + +normal_floats(U, V, !R) :- + uniform_float_in_range(-1.0, 2.0, X, !R), + uniform_float_in_range(-1.0, 2.0, Y, !R), + ( if uniform_to_normal(X, Y, U0, V0) then + U = U0, + V = V0 + else + normal_floats(U, V, !R) + ). + +%---------------------------------------------------------------------------% + +uniform_int_in_range(P, Start, Range0, N, !S) :- + Range = uint32.det_from_int(Range0), + Max = uint32.max_uint32, + gen_uint32(P, N0, !S), + N1 = N0 // (Max // Range), + ( if N1 < Range then + N = Start + uint32.cast_to_int(N1) + else + uniform_int_in_range(P, Start, Range0, N, !S) + ). + +uniform_uint_in_range(P, Start, Range0, N, !S) :- + Range = uint32.cast_from_uint(Range0), + Max = uint32.max_uint32, + gen_uint32(P, N0, !S), + N1 = N0 // (Max // Range), + ( if N1 < Range then + N = Start + uint32.cast_to_uint(N1) + else + uniform_uint_in_range(P, Start, Range0, N, !S) + ). + +uniform_float_in_range(P, Start, Range, N, !S) :- + uniform_float_in_01(P, N0, !S), + N = Start + (N0 * Range). + +uniform_float_around_mid(P, Mid, Delta, N, !S) :- + uniform_float_in_01(P, N0, !S), + ( if N0 = 0.0 then + uniform_float_around_mid(P, Mid, Delta, N, !S) + else + N = Mid + Delta * (2.0 * N0 - 1.0) + ). + +uniform_float_in_01(P, N, !S) :- + gen_uint64(P, N0, !S), + D = 18_446_744_073_709_551_616.0, % 2^64 + N = float.cast_from_uint64(N0) / D. + +normal_floats(P, M, SD, U, V, !S) :- + normal_floats(P, U0, V0, !S), + U = M + SD * U0, + V = M + SD * V0. + +normal_floats(P, U, V, !S) :- + uniform_float_in_range(P, -1.0, 2.0, X, !S), + uniform_float_in_range(P, -1.0, 2.0, Y, !S), + ( if uniform_to_normal(X, Y, U0, V0) then + U = U0, + V = V0 + else + normal_floats(P, U, V, !S) + ). + +%---------------------------------------------------------------------------% + +:- pred uniform_to_normal(float::in, float::in, float::out, float::out) + is semidet. + +uniform_to_normal(X, Y, U, V) :- + S = X * X + Y * Y, + S > 0.0, + S < 1.0, + Fac = math.sqrt(-2.0 * math.ln(S) / S), + U = X * Fac, + V = Y * Fac. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- type urandom_params(R) + ---> urandom_params. + +:- type urandom_state(R) + ---> urandom_state(R). + +:- instance urandom(urandom_params(R), urandom_state(R)) <= random(R) where [ + ( gen_uint8(_, N, S0, S) :- + S0 = urandom_state(R0), + gen_uint8(N, R0, R), + S = unsafe_promise_unique(urandom_state(R)) + ), + ( gen_uint16(_, N, S0, S) :- + S0 = urandom_state(R0), + gen_uint16(N, R0, R), + S = unsafe_promise_unique(urandom_state(R)) + ), + ( gen_uint32(_, N, S0, S) :- + S0 = urandom_state(R0), + gen_uint32(N, R0, R), + S = unsafe_promise_unique(urandom_state(R)) + ), + ( gen_uint64(_, N, S0, S) :- + S0 = urandom_state(R0), + gen_uint64(N, R0, R), + S = unsafe_promise_unique(urandom_state(R)) + ) +]. + +:- instance urandom_dup(urandom_state(R)) <= random(R) where [ + ( urandom_dup(S, S1, S2) :- + S1 = unsafe_promise_unique(S), + S2 = unsafe_promise_unique(S) + ) +]. + +make_urandom(R, P, S) :- + P = urandom_params, + S = unsafe_promise_unique(urandom_state(R)). + +%---------------------------------------------------------------------------% + +:- type shared_random(P, S) + ---> shared_random( + shared_random_params :: P, + shared_random_state :: S + ). + +:- instance random(shared_random(P, S)) <= (urandom(P, S), urandom_dup(S)) + where [ + ( gen_uint8(N, R0, R) :- + R0 = shared_random(P, S0), + S1 = unsafe_promise_unique(S0), + urandom_dup(S1, _, S2), + gen_uint8(P, N, S2, S), + R = shared_random(P, S) + ), + ( gen_uint16(N, R0, R) :- + R0 = shared_random(P, S0), + S1 = unsafe_promise_unique(S0), + urandom_dup(S1, _, S2), + gen_uint16(P, N, S2, S), + R = shared_random(P, S) + ), + ( gen_uint32(N, R0, R) :- + R0 = shared_random(P, S0), + S1 = unsafe_promise_unique(S0), + urandom_dup(S1, _, S2), + gen_uint32(P, N, S2, S), + R = shared_random(P, S) + ), + ( gen_uint64(N, R0, R) :- + R0 = shared_random(P, S0), + S1 = unsafe_promise_unique(S0), + urandom_dup(S1, _, S2), + gen_uint64(P, N, S2, S), + R = shared_random(P, S) + ) +]. + +make_shared_random(P, S) = shared_random(P, S). + +%---------------------------------------------------------------------------% + +:- type io_random(R) + ---> io_random(mutvar(R)). + +:- instance urandom(io_random(R), io) <= random(R) where [ + pred(gen_uint8/4) is io_random_gen_uint8, + pred(gen_uint16/4) is io_random_gen_uint16, + pred(gen_uint32/4) is io_random_gen_uint32, + pred(gen_uint64/4) is io_random_gen_uint64 +]. + +:- pred io_random_gen_uint8(io_random(R)::in, uint8::out, io::di, io::uo) + is det <= random(R). +:- pragma promise_pure(io_random_gen_uint8/4). + +io_random_gen_uint8(io_random(V), N, !IO) :- + impure get_mutvar(V, R0), + gen_uint8(N, R0, R), + impure set_mutvar(V, R). + +:- pred io_random_gen_uint16(io_random(R)::in, uint16::out, io::di, io::uo) + is det <= random(R). +:- pragma promise_pure(io_random_gen_uint16/4). + +io_random_gen_uint16(io_random(V), N, !IO) :- + impure get_mutvar(V, R0), + gen_uint16(N, R0, R), + impure set_mutvar(V, R). + +:- pred io_random_gen_uint32(io_random(R)::in, uint32::out, io::di, io::uo) + is det <= random(R). +:- pragma promise_pure(io_random_gen_uint32/4). + +io_random_gen_uint32(io_random(V), N, !IO) :- + impure get_mutvar(V, R0), + gen_uint32(N, R0, R), + impure set_mutvar(V, R). + +:- pred io_random_gen_uint64(io_random(R)::in, uint64::out, io::di, io::uo) + is det <= random(R). +:- pragma promise_pure(io_random_gen_uint64/4). + +io_random_gen_uint64(io_random(V), N, !IO) :- + impure get_mutvar(V, R0), + gen_uint64(N, R0, R), + impure set_mutvar(V, R). + +:- pragma promise_pure(make_io_random/4). + +make_io_random(R, Pio, !IO) :- + impure new_mutvar(R, V), + Pio = io_random(V). + +%---------------------------------------------------------------------------% + +:- type io_urandom(P, S) + ---> io_urandom(P, mutvar(S)). + +:- instance urandom(io_urandom(P, S), io) <= urandom(P, S) where [ + pred(gen_uint8/4) is io_urandom_gen_uint8, + pred(gen_uint16/4) is io_urandom_gen_uint16, + pred(gen_uint32/4) is io_urandom_gen_uint32, + pred(gen_uint64/4) is io_urandom_gen_uint64 +]. + +:- pred io_urandom_gen_uint8(io_urandom(P, S)::in, uint8::out, io::di, io::uo) + is det <= urandom(P, S). +:- pragma promise_pure(io_urandom_gen_uint8/4). + +io_urandom_gen_uint8(io_urandom(P, V), N, !IO) :- + impure get_mutvar(V, S0), + S1 = unsafe_promise_unique(S0), + gen_uint8(P, N, S1, S), + impure set_mutvar(V, S). + +:- pred io_urandom_gen_uint16(io_urandom(P, S)::in, uint16::out, io::di, io::uo) + is det <= urandom(P, S). +:- pragma promise_pure(io_urandom_gen_uint16/4). + +io_urandom_gen_uint16(io_urandom(P, V), N, !IO) :- + impure get_mutvar(V, S0), + S1 = unsafe_promise_unique(S0), + gen_uint16(P, N, S1, S), + impure set_mutvar(V, S). + +:- pred io_urandom_gen_uint32(io_urandom(P, S)::in, uint32::out, io::di, io::uo) + is det <= urandom(P, S). +:- pragma promise_pure(io_urandom_gen_uint32/4). + +io_urandom_gen_uint32(io_urandom(P, V), N, !IO) :- + impure get_mutvar(V, S0), + S1 = unsafe_promise_unique(S0), + gen_uint32(P, N, S1, S), + impure set_mutvar(V, S). + +:- pred io_urandom_gen_uint64(io_urandom(P, S)::in, uint64::out, io::di, io::uo) + is det <= urandom(P, S). +:- pragma promise_pure(io_urandom_gen_uint64/4). + +io_urandom_gen_uint64(io_urandom(P, V), N, !IO) :- + impure get_mutvar(V, S0), + S1 = unsafe_promise_unique(S0), + gen_uint64(P, N, S1, S), + impure set_mutvar(V, S). + +:- pragma promise_pure(make_io_urandom/5). + +make_io_urandom(P, S, Pio, !IO) :- + impure new_mutvar(S, V), + Pio = io_urandom(P, V). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- type supply ---> rs(int). % I(j) diff --git a/library/random.sfc16.m b/library/random.sfc16.m new file mode 100644 index 000000000..9c6068cfc --- /dev/null +++ b/library/random.sfc16.m @@ -0,0 +1,141 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 2019 The Mercury team. +% This file is distributed under the terms specified in COPYING.LIB. +%---------------------------------------------------------------------------% +% +% File: random.sfc16.m +% Main author: Mark Brown +% +% 16-bit Small Fast Counting generator, by Chris Doty-Humphrey. +% +% http://pracrand.sourceforge.net/ +% +% From the above: +% "[A] good small chaotic RNG driven by a bad smaller linear RNG. The +% combination gives it the strengths of each - good chaotic behavior, +% but enough structure to avoid short cycles." +% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- module random.sfc16. +:- interface. + +%---------------------------------------------------------------------------% + + % A fast, 16-bit SFC generator. + % +:- type random. + +:- instance random(random). + + % Initialise a 16-bit SFC generator with the default seed. + % +:- func init = random. + + % Initialise a 16-bit SFC generator with the given seed. + % +:- func seed(uint64) = random. + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % +:- pred gen_uint8(uint8::out, random::in, random::out) is det. +:- pred gen_uint16(uint16::out, random::in, random::out) is det. +:- pred gen_uint32(uint32::out, random::in, random::out) is det. +:- pred gen_uint64(uint64::out, random::in, random::out) is det. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module int. +:- import_module uint. +:- import_module uint8. +:- import_module uint16. +:- import_module uint32. +:- import_module uint64. + +%---------------------------------------------------------------------------% + +:- type random + ---> random(uint64). + +:- instance random(random) where [ + pred(gen_uint8/3) is sfc16.gen_uint8, + pred(gen_uint16/3) is sfc16.gen_uint16, + pred(gen_uint32/3) is sfc16.gen_uint32, + pred(gen_uint64/3) is sfc16.gen_uint64 +]. + +init = seed(0x6048_5623_5e79_371e_u64). + +seed(Seed) = R :- + skip(10, random(Seed), R). + +:- pred skip(int::in, random::in, random::out) is det. + +skip(N, !R) :- + ( if N > 0 then + sfc16.gen_uint16(_, !R), + skip(N - 1, !R) + else + true + ). + +%---------------------------------------------------------------------------% + +gen_uint8(N, !R) :- + sfc16.gen_uint16(N0, !R), + N1 = uint16.to_int(N0 >> 8), + N = uint8.cast_from_int(N1). + +gen_uint32(N, !R) :- + sfc16.gen_uint16(A0, !R), + sfc16.gen_uint16(B0, !R), + A = uint16.cast_to_uint(A0), + B = uint16.cast_to_uint(B0), + N = uint32.cast_from_uint(A + (B << 16)). + +gen_uint64(N, !R) :- + sfc16.gen_uint16(A, !R), + sfc16.gen_uint16(B, !R), + sfc16.gen_uint16(C, !R), + sfc16.gen_uint16(D, !R), + N = pack_uint64(A, B, C, D). + +%---------------------------------------------------------------------------% + +gen_uint16(N, random(S0), random(S)) :- + unpack_uint64(S0, A0, B0, C0, Counter0), + N = A0 + B0 + Counter0, + A = B0 `xor` (B0 >> 5), + B = C0 + (C0 << 3), + C = ((C0 << 6) \/ (C0 >> 10)) + N, + Counter = Counter0 + 1u16, + S = pack_uint64(A, B, C, Counter). + +%---------------------------------------------------------------------------% + +:- func pack_uint64(uint16, uint16, uint16, uint16) = uint64. + +pack_uint64(P1, P2, P3, P4) = + uint16.cast_to_uint64(P1) + + (uint16.cast_to_uint64(P2) << 16) + + (uint16.cast_to_uint64(P3) << 32) + + (uint16.cast_to_uint64(P4) << 48). + +:- pred unpack_uint64(uint64::in, uint16::out, uint16::out, uint16::out, + uint16::out) is det. + +unpack_uint64(S, P1, P2, P3, P4) :- + Mask = 0xffffu64, + P1 = uint16.cast_from_uint64(S /\ Mask), + P2 = uint16.cast_from_uint64((S >> 16) /\ Mask), + P3 = uint16.cast_from_uint64((S >> 32) /\ Mask), + P4 = uint16.cast_from_uint64(S >> 48). + +%---------------------------------------------------------------------------% diff --git a/library/random.sfc32.m b/library/random.sfc32.m new file mode 100644 index 000000000..87c2a7f4c --- /dev/null +++ b/library/random.sfc32.m @@ -0,0 +1,184 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 2019 The Mercury team. +% This file is distributed under the terms specified in COPYING.LIB. +%---------------------------------------------------------------------------% +% +% File: random.sfc32.m +% Main author: Mark Brown +% +% 32-bit Small Fast Counting generator, by Chris Doty-Humphrey. +% +% http://pracrand.sourceforge.net/ +% +% From the above: +% "[A] good small chaotic RNG driven by a bad smaller linear RNG. The +% combination gives it the strengths of each - good chaotic behavior, +% but enough structure to avoid short cycles." +% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- module random.sfc32. +:- interface. + +%---------------------------------------------------------------------------% + + % A fast, 32-bit SFC generator with unique state. This may achieve + % better performance on 32-bit architectures, but generally does not + % have the quality of the 64-bit generator or the low heap usage of + % the 16-bit generator. + % +:- type params. +:- type ustate. + +:- instance urandom(params, ustate). +:- instance urandom_dup(ustate). + + % Initialise a 32-bit SFC generator with the default seed. + % +:- pred init(params::out, ustate::uo) is det. + + % Initialise a 32-bit SFC generator with the given seed. + % +:- pred seed(uint32::in, uint32::in, uint32::in, params::out, ustate::uo) + is det. + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % +:- pred gen_uint8(params::in, uint8::out, ustate::di, ustate::uo) is det. +:- pred gen_uint16(params::in, uint16::out, ustate::di, ustate::uo) is det. +:- pred gen_uint32(params::in, uint32::out, ustate::di, ustate::uo) is det. +:- pred gen_uint64(params::in, uint64::out, ustate::di, ustate::uo) is det. + + % Duplicate a 32-bit SFC state. + % +:- pred urandom_dup(ustate::di, ustate::uo, ustate::uo) is det. + +%---------------------------------------------------------------------------% + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % + % As above, but does not require the params argument (which is a dummy + % type only needed to satisfy the typeclass interface). + % +:- pred gen_uint8(uint8::out, ustate::di, ustate::uo) is det. +:- pred gen_uint16(uint16::out, ustate::di, ustate::uo) is det. +:- pred gen_uint32(uint32::out, ustate::di, ustate::uo) is det. +:- pred gen_uint64(uint64::out, ustate::di, ustate::uo) is det. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module array. +:- import_module int. +:- import_module list. +:- import_module uint8. +:- import_module uint16. +:- import_module uint32. +:- import_module uint64. + +%---------------------------------------------------------------------------% + +:- type params + ---> params. + +:- type ustate + ---> ustate(array(uint32)). + +:- instance urandom(params, ustate) where [ + pred(gen_uint8/4) is sfc32.gen_uint8, + pred(gen_uint16/4) is sfc32.gen_uint16, + pred(gen_uint32/4) is sfc32.gen_uint32, + pred(gen_uint64/4) is sfc32.gen_uint64 +]. + +:- instance urandom_dup(ustate) where [ + pred(urandom_dup/3) is sfc32.urandom_dup +]. + +urandom_dup(S, S1, S2) :- + S = ustate(A), + Sc = ustate(array.copy(A)), + S1 = unsafe_promise_unique(S), + S2 = unsafe_promise_unique(Sc). + +%---------------------------------------------------------------------------% + +init(P, S) :- + seed(0x0_u32, 0xf16c_a8bb_u32, 0x20a3_6f2d_u32, P, S). + +seed(A, B, C, params, S) :- + Counter = 1u32, + Seed0 = array([A, B, C, Counter]), + S0 = unsafe_promise_unique(ustate(Seed0)), + skip(15, S0, S). + +:- pred skip(int::in, ustate::di, ustate::uo) is det. + +skip(N, !S) :- + ( if N > 0 then + sfc32.gen_uint32(_, !S), + skip(N - 1, !S) + else + true + ). + +%---------------------------------------------------------------------------% + +gen_uint8(_, N, !S) :- + sfc32.gen_uint8(N, !S). + +gen_uint16(_, N, !S) :- + sfc32.gen_uint16(N, !S). + +gen_uint32(_, N, !S) :- + sfc32.gen_uint32(N, !S). + +gen_uint64(_, N, !S) :- + sfc32.gen_uint64(N, !S). + +%---------------------------------------------------------------------------% + +gen_uint8(N, !S) :- + sfc32.gen_uint32(N0, !S), + N1 = uint32.cast_to_int(N0 >> 24), + N = uint8.cast_from_int(N1). + +gen_uint16(N, !S) :- + sfc32.gen_uint32(N0, !S), + N1 = uint32.cast_to_int(N0 >> 16), + N = uint16.cast_from_int(N1). + +gen_uint64(N, !S) :- + sfc32.gen_uint32(A0, !S), + sfc32.gen_uint32(B0, !S), + A = uint32.cast_to_uint64(A0), + B = uint32.cast_to_uint64(B0), + N = A + (B << 32). + +%---------------------------------------------------------------------------% + +gen_uint32(N, RS0, RS) :- + RS0 = ustate(S0), + array.unsafe_lookup(S0, 0, A0), + array.unsafe_lookup(S0, 1, B0), + array.unsafe_lookup(S0, 2, C0), + array.unsafe_lookup(S0, 3, Counter0), + N = A0 + B0 + Counter0, + A = B0 `xor` (B0 >> 9), + B = C0 + (C0 << 3), + C = ((C0 << 21) \/ (C0 >> 11)) + N, + Counter = Counter0 + 1u32, + array.unsafe_set(0, A, S0, S1), + array.unsafe_set(1, B, S1, S2), + array.unsafe_set(2, C, S2, S3), + array.unsafe_set(3, Counter, S3, S), + RS = unsafe_promise_unique(ustate(S)). + +%---------------------------------------------------------------------------% diff --git a/library/random.sfc64.m b/library/random.sfc64.m new file mode 100644 index 000000000..9b2d47b07 --- /dev/null +++ b/library/random.sfc64.m @@ -0,0 +1,182 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 2019 The Mercury team. +% This file is distributed under the terms specified in COPYING.LIB. +%---------------------------------------------------------------------------% +% +% File: random.sfc64.m +% Main author: Mark Brown +% +% 64-bit Small Fast Counting generator, by Chris Doty-Humphrey. +% +% http://pracrand.sourceforge.net/ +% +% From the above: +% "[A] good small chaotic RNG driven by a bad smaller linear RNG. The +% combination gives it the strengths of each - good chaotic behavior, +% but enough structure to avoid short cycles." +% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- module random.sfc64. +:- interface. + +%---------------------------------------------------------------------------% + + % A fast, 64-bit SFC generator with unique state. + % +:- type params. +:- type ustate. + +:- instance urandom(params, ustate). +:- instance urandom_dup(ustate). + + % Initialise a 64-bit SFC generator with the default seed. + % +:- pred init(params::out, ustate::uo) is det. + + % Initialise a 64-bit SFC generator with the given seed. + % +:- pred seed(uint64::in, uint64::in, uint64::in, params::out, ustate::uo) + is det. + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % +:- pred gen_uint8(params::in, uint8::out, ustate::di, ustate::uo) is det. +:- pred gen_uint16(params::in, uint16::out, ustate::di, ustate::uo) is det. +:- pred gen_uint32(params::in, uint32::out, ustate::di, ustate::uo) is det. +:- pred gen_uint64(params::in, uint64::out, ustate::di, ustate::uo) is det. + + % Duplicate a 64-bit SFC state. + % +:- pred urandom_dup(ustate::di, ustate::uo, ustate::uo) is det. + +%---------------------------------------------------------------------------% + + % Generate a uniformly distributed pseudo-random unsigned integer + % of 8, 16, 32 or 64 bits, respectively. + % + % As above, but does not require the params argument (which is a dummy + % type only needed to satisfy the typeclass interface). + % +:- pred gen_uint8(uint8::out, ustate::di, ustate::uo) is det. +:- pred gen_uint16(uint16::out, ustate::di, ustate::uo) is det. +:- pred gen_uint32(uint32::out, ustate::di, ustate::uo) is det. +:- pred gen_uint64(uint64::out, ustate::di, ustate::uo) is det. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module array. +:- import_module int. +:- import_module list. +:- import_module uint8. +:- import_module uint16. +:- import_module uint32. +:- import_module uint64. + +%---------------------------------------------------------------------------% + +:- type params + ---> params. + +:- type ustate + ---> ustate(array(uint64)). + +:- instance urandom(params, ustate) where [ + pred(gen_uint8/4) is sfc64.gen_uint8, + pred(gen_uint16/4) is sfc64.gen_uint16, + pred(gen_uint32/4) is sfc64.gen_uint32, + pred(gen_uint64/4) is sfc64.gen_uint64 +]. + +:- instance urandom_dup(ustate) where [ + pred(urandom_dup/3) is sfc64.urandom_dup +]. + +urandom_dup(S, S1, S2) :- + S = ustate(A), + Sc = ustate(array.copy(A)), + S1 = unsafe_promise_unique(S), + S2 = unsafe_promise_unique(Sc). + +%---------------------------------------------------------------------------% + +init(P, S) :- + seed( + 0x9578_32f2_b9e1_43b1_u64, + 0x9578_32f2_b9e1_43b1_u64, + 0x9578_32f2_b9e1_43b1_u64, + P, S). + +seed(A, B, C, params, S) :- + Counter = 1u64, + Seed0 = array([A, B, C, Counter]), + S0 = unsafe_promise_unique(ustate(Seed0)), + skip(18, S0, S). + +:- pred skip(int::in, ustate::di, ustate::uo) is det. + +skip(N, !S) :- + ( if N > 0 then + sfc64.gen_uint64(_, !S), + skip(N - 1, !S) + else + true + ). + +%---------------------------------------------------------------------------% + +gen_uint8(_, N, !S) :- + sfc64.gen_uint8(N, !S). + +gen_uint16(_, N, !S) :- + sfc64.gen_uint16(N, !S). + +gen_uint32(_, N, !S) :- + sfc64.gen_uint32(N, !S). + +gen_uint64(_, N, !S) :- + sfc64.gen_uint64(N, !S). + +%---------------------------------------------------------------------------% + +gen_uint8(N, !S) :- + sfc64.gen_uint64(N0, !S), + N1 = uint64.cast_to_int(N0 >> 56), + N = uint8.cast_from_int(N1). + +gen_uint16(N, !S) :- + sfc64.gen_uint64(N0, !S), + N1 = uint64.cast_to_int(N0 >> 48), + N = uint16.cast_from_int(N1). + +gen_uint32(N, !S) :- + sfc64.gen_uint64(N0, !S), + N = uint32.cast_from_uint64(N0 >> 32). + +%---------------------------------------------------------------------------% + +gen_uint64(N, RS0, RS) :- + RS0 = ustate(S0), + array.unsafe_lookup(S0, 0, A0), + array.unsafe_lookup(S0, 1, B0), + array.unsafe_lookup(S0, 2, C0), + array.unsafe_lookup(S0, 3, Counter0), + N = A0 + B0 + Counter0, + A = B0 `xor` (B0 >> 11), + B = C0 + (C0 << 3), + C = ((C0 << 24) \/ (C0 >> 40)) + N, + Counter = Counter0 + 1u64, + array.unsafe_set(0, A, S0, S1), + array.unsafe_set(1, B, S1, S2), + array.unsafe_set(2, C, S2, S3), + array.unsafe_set(3, Counter, S3, S), + RS = unsafe_promise_unique(ustate(S)). + +%---------------------------------------------------------------------------% diff --git a/library/rng.m b/library/rng.m deleted file mode 100644 index 202b3adcd..000000000 --- a/library/rng.m +++ /dev/null @@ -1,352 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sts=4 sw=4 et -%---------------------------------------------------------------------------% -% Copyright (C) 2019 The Mercury team. -% This file is distributed under the terms specified in COPYING.LIB. -%---------------------------------------------------------------------------% -% -% File: rng.m -% Main author: Mark Brown -% -% This module provides an interface to several random number generators, -% which can be found in the submodules. -% -% Two styles of the interface are provided, a ground style and a -% unique style. Each has its own advantages and disadvantages: -% -% - Ground RNGs are easier to use; for example they can be easily -% stored in larger data structures. -% - Ground RNGs are easier to implement instances for. -% - Unique RNGs are able to use destructive update, and therefore -% are often able to operate more efficiently. -% - Unique RNGs need to be explicitly duplicated (i.e., to produce -% a new generator that will generate the same sequence of numbers). -% This may be regarded as an advantage or a disadvantage. -% - Some RNGs, for example the binfile generator that reads data from -% a file, use the I/O state and therefore must use the unique interface. -% -% Each RNG defined in the submodules is natively one of these two styles. -% Conversion between the two styles can be done with make_urng/3 and -% make_shared_rng/2, below, although this incurs additional overhead. -% -% -% Example, ground style: -% -% main(!IO) :- -% RNG0 = rng.marsaglia.init, -% roll(RNG0, RNG1, !IO), -% roll(RNG1, _, !IO). -% -% :- pred roll(RNG, RNG, io, io) <= rng(RNG). -% :- mode roll(in, out, di, uo) is det. -% -% roll(!RNG, !IO) :- -% random_int(1, 6, N, !RNG), -% io.format("You rolled a %d\n", [i(N)], !IO). -% -% -% Example, unique style: -% -% main(!IO) :- -% rng.tausworthe.init_t3(RP, RS0), -% roll(RP, RS0, RS1, !IO), -% roll(RP, RS1, _, !IO). -% -% :- pred roll(RP, RS, RS, io, io) <= urng(RP, RS). -% :- mode roll(in, di, uo, di, uo) is det. % note unique modes -% -% roll(RP, !RS, !IO) :- -% urandom_int(RP, 1, 6, N, !RS), -% io.format("You rolled a %d\n", [i(N)], !IO). -% -% -% Example, converting style: -% -% main(!IO) :- -% rng.tausworthe.init_t3(RP, RS), -% RNG0 = make_shared_rng(RP, RS), -% random_int(1, 6, N, RNG0, RNG1), -% ... -% -% main(!IO) :- -% RNG = rng.marsaglia.init, -% make_urng(RNG, RP, RS0), -% urandom_int(RP, 1, 6, N, RS0, RS1), -% ... -% -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- module rng. -:- interface. - -:- include_module binfile. -:- include_module marsaglia. -:- include_module sfc. -:- include_module tausworthe. - -%---------------------------------------------------------------------------% - - % random_int(Start, Range, N, !RNG) - % - % Generate a uniformly distributed random integer between Start and - % Start+Range-1 inclusive. - % Throws an exception if Range < 1 or Range > random_max. - % -:- pred random_int(int, int, int, RNG, RNG) <= rng(RNG). -:- mode random_int(in, in, out, in, out) is det. - - % Generate a uniformly distributed random float in the range [0, 1). - % -:- pred random_float(float, RNG, RNG) <= rng(RNG). -:- mode random_float(out, in, out) is det. - - % Generate two random floats from a normal distribution with - % mean 0 and standard deviation 1, using the Box-Muller method. - % - % We generate two at a time for efficiency; they are independent of - % each other. - % -:- pred random_gauss(float, float, RNG, RNG) <= rng(RNG). -:- mode random_gauss(out, out, in, out) is det. - -%---------------------------------------------------------------------------% - - % Interface to random number generators. - % -:- typeclass rng(RNG) where [ - - % Generate a uniformly distributed random integer between 0 and - % random_max, inclusive. - % - pred random(uint64, RNG, RNG), - mode random(out, in, out) is det, - - % Return the largest integer that can be generated. This must be - % no less than 65535. - % - func random_max(RNG) = uint64 -]. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - - % urandom_int(RP, Start, Range, N, !RS) - % - % Generate a uniformly distributed random integer between Start and - % Start+Range-1 inclusive. - % Throws an exception if Range < 1 or Range > urandom_max. - % -:- pred urandom_int(RP, int, int, int, RS, RS) <= urng(RP, RS). -:- mode urandom_int(in, in, in, out, di, uo) is det. - - % Generate a uniformly distributed random float in the interval [0, 1). - % -:- pred urandom_float(RP, float, RS, RS) <= urng(RP, RS). -:- mode urandom_float(in, out, di, uo) is det. - - % Generate two random floats from a normal distribution with - % mean 0 and standard deviation 1, using the Box-Muller method. - % - % We generate two at a time for efficiency; they are independent of - % each other. - % -:- pred urandom_gauss(RP, float, float, RS, RS) <= urng(RP, RS). -:- mode urandom_gauss(in, out, out, di, uo) is det. - -%---------------------------------------------------------------------------% - - % Interface to unique random number generators. Callers need to - % ensure they preserve the uniqueness of the random state, and in - % turn instances can use destructive update on it. - % -:- typeclass urng(RP, RS) <= (RP -> RS) where [ - - % Generate a uniformly distributed random integer between 0 and - % random_max, inclusive. - % - pred urandom(RP, uint64, RS, RS), - mode urandom(in, out, di, uo) is det, - - % Return the largest integer that can be generated. This must be - % no less than 65535. - % - func urandom_max(RP) = uint64 -]. - -:- typeclass urng_dup(RS) where [ - - % urandom_dup(!RS, !:RSdup) - % - % Create a duplicate random state that will generate the - % same sequence of integers. - % - pred urandom_dup(RS, RS, RS), - mode urandom_dup(di, uo, uo) is det -]. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - - % Convert any rng into a urng. This creates some additional overhead - % in the form of additional typeclass method calls. - % -:- type urng_params(RNG). -:- type urng_state(RNG). - -:- instance urng(urng_params(RNG), urng_state(RNG)) <= rng(RNG). -:- instance urng_dup(urng_state(RNG)) <= rng(RNG). - -:- pred make_urng(RNG, urng_params(RNG), urng_state(RNG)) <= rng(RNG). -:- mode make_urng(in, out, uo) is det. - -%---------------------------------------------------------------------------% - - % Convert any urng into an rng. This duplicates the state every time - % a random number is generated, hence may use significantly more - % memory than if the unique version is used directly. - % -:- type shared_rng(RP, RS). - -:- instance rng(shared_rng(RP, RS)) <= (urng(RP, RS), urng_dup(RS)). - -:- func make_shared_rng(RP, RS) = shared_rng(RP, RS). -:- mode make_shared_rng(in, di) = out is det. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- implementation. - -:- import_module int. -:- import_module float. -:- import_module math. -:- import_module uint64. - -%---------------------------------------------------------------------------% - -random_int(Start, Range0, N, !RNG) :- - Range = uint64.det_from_int(Range0), - random(N0, !RNG), - Max = random_max(!.RNG), - N1 = N0 // (Max // Range), - ( if N1 < Range then - N = Start + uint64.cast_to_int(N1) - else - random_int(Start, Range0, N, !RNG) - ). - -random_float(F, !RNG) :- - random(N, !RNG), - Max = random_max(!.RNG), - F = float.cast_from_uint64(N) / (float.cast_from_uint64(Max) + 1.0). - -random_gauss(U, V, !RNG) :- - random_float(X, !RNG), - random_float(Y, !RNG), - ( if gauss(X, Y, U0, V0) then - U = U0, - V = V0 - else - random_gauss(U, V, !RNG) - ). - -%---------------------------------------------------------------------------% - -urandom_int(RP, Start, Range0, N, !RS) :- - Range = uint64.det_from_int(Range0), - urandom(RP, N0, !RS), - Max = urandom_max(RP), - N1 = N0 // (Max // Range), - ( if N1 < Range then - N = Start + uint64.cast_to_int(N1) - else - urandom_int(RP, Start, Range0, N, !RS) - ). - -urandom_float(RP, F, !RS) :- - urandom(RP, N, !RS), - Max = urandom_max(RP), - F = float.cast_from_uint64(N) / (float.cast_from_uint64(Max) + 1.0). - -urandom_gauss(RP, U, V, !RS) :- - urandom_float(RP, X, !RS), - urandom_float(RP, Y, !RS), - ( if gauss(X, Y, U0, V0) then - U = U0, - V = V0 - else - urandom_gauss(RP, U, V, !RS) - ). - -%---------------------------------------------------------------------------% - -:- pred gauss(float, float, float, float). -:- mode gauss(in, in, out, out) is semidet. - -gauss(X0, Y0, U, V) :- - X = 2.0 * X0 - 1.0, - Y = 2.0 * Y0 - 1.0, - S = X * X + Y * Y, - S > 0.0, - S < 1.0, - Fac = math.sqrt(-2.0 * math.ln(S) / S), - U = X * Fac, - V = Y * Fac. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- type urng_params(RNG) - ---> urng_params( - urng_max :: uint64 - ). - -:- type urng_state(RNG) - ---> urng_state( - urng_rng :: RNG - ). - -:- instance urng(urng_params(RNG), urng_state(RNG)) <= rng(RNG) where [ - ( urandom(_, N, RS0, RS) :- - RS0 = urng_state(RNG0), - random(N, RNG0, RNG), - RS = unsafe_promise_unique(urng_state(RNG)) - ), - ( urandom_max(RP) = RP ^ urng_max ) -]. - -:- instance urng_dup(urng_state(RNG)) <= rng(RNG) where [ - ( urandom_dup(RS, RS1, RS2) :- - RS1 = unsafe_promise_unique(RS), - RS2 = unsafe_promise_unique(RS) - ) -]. - -make_urng(RNG, RP, RS) :- - RP = urng_params(random_max(RNG)), - RS = unsafe_promise_unique(urng_state(RNG)). - -%---------------------------------------------------------------------------% - -:- type shared_rng(RP, RS) - ---> shared_rng( - shared_rng_params :: RP, - shared_rng_state :: RS - ). - -:- instance rng(shared_rng(RP, RS)) <= (urng(RP, RS), urng_dup(RS)) where [ - ( random(N, RNG0, RNG) :- - RNG0 = shared_rng(RP, RS0), - RS1 = unsafe_promise_unique(RS0), - urandom_dup(RS1, _, RS2), - urandom(RP, N, RS2, RS), - RNG = shared_rng(RP, RS) - ), - ( random_max(RNG) = urandom_max(RNG ^ shared_rng_params) ) -]. - -make_shared_rng(RP, RS) = shared_rng(RP, RS). - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% diff --git a/library/rng.sfc.m b/library/rng.sfc.m deleted file mode 100644 index a4eb149ab..000000000 --- a/library/rng.sfc.m +++ /dev/null @@ -1,354 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sts=4 sw=4 et -%---------------------------------------------------------------------------% -% Copyright (C) 2019 The Mercury team. -% This file is distributed under the terms specified in COPYING.LIB. -%---------------------------------------------------------------------------% -% -% File: rng.sfc.m -% Main author: Mark Brown -% -% Small Fast Counting generators, by Chris Doty-Humphrey. -% -% http://pracrand.sourceforge.net/ -% -% From the above: -% "[A] good small chaotic RNG driven by a bad smaller linear RNG. The -% combination gives it the strengths of each - good chaotic behavior, -% but enough structure to avoid short cycles." -% -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- module rng.sfc. -:- interface. - -%---------------------------------------------------------------------------% - - % A fast, 16-bit SFC generator. - % -:- type sfc. - -:- instance rng(sfc). - - % Initialise a 16-bit SFC RNG with the default seed. - % -:- func init16 = sfc. - - % Initialise a 16-bit SFC RNG with the given seed. - % -:- func seed16(uint64) = sfc. - - % Generate a random number between 0 and max_uint16. - % -:- pred rand16(uint16, sfc, sfc). -:- mode rand16(out, in, out) is det. - - % Return max_uint16, the maximum number that can be returned by this - % generator. - % -:- func rand16_max(sfc) = uint16. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - - % A fast, 64-bit SFC generator with unique state. - % -:- type params. -:- type state. - -:- instance urng(params, state). -:- instance urng_dup(state). - - % Initialise a 64-bit SFC RNG with the default seed. - % -:- pred init(params, state). -:- mode init(out, uo) is det. - - % Initialise a 64-bit SFC RNG with the given seed. - % -:- pred seed(uint64, uint64, uint64, params, state). -:- mode seed(in, in, in, out, uo) is det. - -%---------------------------------------------------------------------------% - - % Generate a random number between 0 and max_uint64. Note that the - % params are not required for this RNG unless calling via the - % typeclass interface. - % -:- pred rand(uint64, state, state). -:- mode rand(out, di, uo) is det. - - % Return max_uint64, the maximum number that can be returned by this - % generator. - % -:- func rand_max = uint64. - - % Duplicate a 64-bit SFC state. - % -:- pred dup(state, state, state). -:- mode dup(di, uo, uo) is det. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - - % A fast, 32-bit SFC generator with unique state. This may achieve - % better performance on 32-bit architectures, but generally does not - % have the quality of the 64-bit generator or the low heap usage of - % the 16-bit generator. - % -:- type params32. -:- type state32. - -:- instance urng(params32, state32). -:- instance urng_dup(state32). - - % Initialise a 32-bit SFC RNG with the default seed. - % -:- pred init32(params32, state32). -:- mode init32(out, uo) is det. - - % Initialise a 32-bit SFC RNG with the given seed. - % -:- pred seed32(uint32, uint32, uint32, params32, state32). -:- mode seed32(in, in, in, out, uo) is det. - -%---------------------------------------------------------------------------% - - % Generate a random number between 0 and max_uint32. Note that the - % params are not required for this RNG unless calling via the - % typeclass interface. - % -:- pred rand32(uint32, state32, state32). -:- mode rand32(out, di, uo) is det. - - % Return max_uint32, the maximum number that can be returned by this - % generator. - % -:- func rand32_max = uint32. - - % Duplicate a 32-bit SFC state. - % -:- pred dup32(state32, state32, state32). -:- mode dup32(di, uo, uo) is det. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- implementation. - -:- import_module array. -:- import_module int. -:- import_module list. -:- import_module uint16. -:- import_module uint32. -:- import_module uint64. - -%---------------------------------------------------------------------------% - -:- type sfc - ---> sfc(uint64). - -:- instance rng(sfc) where [ - ( random(N, !RNG) :- - rand16(N0, !RNG), - N = uint16.cast_to_uint64(N0) - ), - ( random_max(RNG) = uint16.cast_to_uint64(rand16_max(RNG)) ) -]. - -init16 = seed16(0x6048_5623_5e79_371e_u64). - -seed16(Seed) = RNG :- - skip16(10, sfc(Seed), RNG). - -:- pred skip16(int, sfc, sfc). -:- mode skip16(in, in, out) is det. - -skip16(N, !RNG) :- - ( if N > 0 then - rand16(_, !RNG), - skip16(N - 1, !RNG) - else - true - ). - -%---------------------------------------------------------------------------% - -rand16(N, sfc(S0), sfc(S)) :- - unpack_uint64(S0, A0, B0, C0, Counter0), - N = A0 + B0 + Counter0, - A = B0 `xor` (B0 >> 5), - B = C0 + (C0 << 3), - C = ((C0 << 6) \/ (C0 >> 10)) + N, - Counter = Counter0 + 1u16, - S = pack_uint64(A, B, C, Counter). - -rand16_max(_) = uint16.max_uint16. - -:- func pack_uint64(uint16, uint16, uint16, uint16) = uint64. - -pack_uint64(P1, P2, P3, P4) = - (uint16.cast_to_uint64(P1) << 48) + - (uint16.cast_to_uint64(P2) << 32) + - (uint16.cast_to_uint64(P3) << 16) + - uint16.cast_to_uint64(P4). - -:- pred unpack_uint64(uint64, uint16, uint16, uint16, uint16). -:- mode unpack_uint64(in, out, out, out, out) is det. - -unpack_uint64(S, P1, P2, P3, P4) :- - Mask = 0xffffu64, - P1 = uint16.cast_from_uint64(S >> 48), - P2 = uint16.cast_from_uint64((S >> 32) /\ Mask), - P3 = uint16.cast_from_uint64((S >> 16) /\ Mask), - P4 = uint16.cast_from_uint64(S /\ Mask). - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- type params - ---> params. - -:- type state - ---> state(array(uint64)). - -:- instance urng(params, state) where [ - ( urandom(_, N, !RS) :- - rand(N, !RS) - ), - ( urandom_max(_) = rand_max ) -]. - -:- instance urng_dup(state) where [ - pred(urandom_dup/3) is dup -]. - -dup(S, S1, S2) :- - S = state(A), - Sc = state(array.copy(A)), - S1 = unsafe_promise_unique(S), - S2 = unsafe_promise_unique(Sc). - -%---------------------------------------------------------------------------% - -init(RP, RS) :- - sfc.seed( - 0x9578_32f2_b9e1_43b1_u64, - 0x9578_32f2_b9e1_43b1_u64, - 0x9578_32f2_b9e1_43b1_u64, - RP, RS). - -seed(A, B, C, params, RS) :- - Counter = 1u64, - S0 = array([A, B, C, Counter]), - RS0 = unsafe_promise_unique(state(S0)), - skip(18, RS0, RS). - -:- pred skip(int, state, state). -:- mode skip(in, di, uo) is det. - -skip(N, !RS) :- - ( if N > 0 then - rand(_, !RS), - skip(N - 1, !RS) - else - true - ). - -%---------------------------------------------------------------------------% - -rand(N, RS0, RS) :- - RS0 = state(S0), - array.unsafe_lookup(S0, 0, A0), - array.unsafe_lookup(S0, 1, B0), - array.unsafe_lookup(S0, 2, C0), - array.unsafe_lookup(S0, 3, Counter0), - N = A0 + B0 + Counter0, - A = B0 `xor` (B0 >> 11), - B = C0 + (C0 << 3), - C = ((C0 << 24) \/ (C0 >> 40)) + N, - Counter = Counter0 + 1u64, - array.unsafe_set(0, A, S0, S1), - array.unsafe_set(1, B, S1, S2), - array.unsafe_set(2, C, S2, S3), - array.unsafe_set(3, Counter, S3, S), - RS = unsafe_promise_unique(state(S)). - -rand_max = uint64.max_uint64. - -%---------------------------------------------------------------------------% -%---------------------------------------------------------------------------% - -:- type params32 - ---> params32. - -:- type state32 - ---> state32(array(uint32)). - -:- instance urng(params32, state32) where [ - ( urandom(_, N, !RS) :- - rand32(N0, !RS), - N = uint32.cast_to_uint64(N0) - ), - ( urandom_max(_) = uint32.cast_to_uint64(rand32_max) ) -]. - -:- instance urng_dup(state32) where [ - pred(urandom_dup/3) is dup32 -]. - -dup32(S, S1, S2) :- - S = state32(A), - Sc = state32(array.copy(A)), - S1 = unsafe_promise_unique(S), - S2 = unsafe_promise_unique(Sc). - -%---------------------------------------------------------------------------% - -init32(RP, RS) :- - sfc.seed32( - 0x0_u32, - 0xf16c_a8bb_u32, - 0x20a3_6f2d_u32, - RP, RS). - -seed32(A, B, C, params32, RS) :- - Counter = 1u32, - S0 = array([A, B, C, Counter]), - RS0 = unsafe_promise_unique(state32(S0)), - skip32(15, RS0, RS). - -:- pred skip32(int, state32, state32). -:- mode skip32(in, di, uo) is det. - -skip32(N, !RS) :- - ( if N > 0 then - rand32(_, !RS), - skip32(N - 1, !RS) - else - true - ). - -%---------------------------------------------------------------------------% - -rand32(N, RS0, RS) :- - RS0 = state32(S0), - array.unsafe_lookup(S0, 0, A0), - array.unsafe_lookup(S0, 1, B0), - array.unsafe_lookup(S0, 2, C0), - array.unsafe_lookup(S0, 3, Counter0), - N = A0 + B0 + Counter0, - A = B0 `xor` (B0 >> 9), - B = C0 + (C0 << 3), - C = ((C0 << 21) \/ (C0 >> 11)) + N, - Counter = Counter0 + 1u32, - array.unsafe_set(0, A, S0, S1), - array.unsafe_set(1, B, S1, S2), - array.unsafe_set(2, C, S2, S3), - array.unsafe_set(3, Counter, S3, S), - RS = unsafe_promise_unique(state32(S)). - -rand32_max = uint32.max_uint32. - -%---------------------------------------------------------------------------% diff --git a/library/uint32.m b/library/uint32.m index 11beb36f5..af211c96e 100644 --- a/library/uint32.m +++ b/library/uint32.m @@ -73,6 +73,14 @@ % :- func cast_to_uint(uint32) = uint. + % cast_from_uint(U) = U32: + % + % Convert a uint to a uint32. + % Always succeeds, but will yield a result that is mathematically equal + % to I only if I is in [0, 2^32 - 1]. + % +:- func cast_from_uint(uint) = uint32. + %---------------------------------------------------------------------------% % % Conversion to/from uint64. @@ -493,6 +501,35 @@ cast_to_uint(_) = _ :- %---------------------------------------------------------------------------% +:- pragma no_determinism_warning(cast_from_uint/1). + +:- pragma foreign_proc("C", + cast_from_uint(U::in) = (U32::out), + [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail, + does_not_affect_liveness], +" + U32 = (uint32_t) U; +"). + +:- pragma foreign_proc("C#", + cast_from_uint(U::in) = (U32::out), + [will_not_call_mercury, promise_pure, thread_safe], +" + U32 = U; +"). + +:- pragma foreign_proc("Java", + cast_from_uint(U::in) = (U32::out), + [will_not_call_mercury, promise_pure, thread_safe], +" + U32 = U; +"). + +cast_from_uint(_) = _ :- + sorry($module, "uint32.cast_from_uint/1 NYI for Erlang"). + +%---------------------------------------------------------------------------% + :- pragma no_determinism_warning(cast_to_uint64/1). :- pragma foreign_proc("C", diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile index 2b5f902a7..a16c70742 100644 --- a/tests/hard_coded/Mmakefile +++ b/tests/hard_coded/Mmakefile @@ -303,6 +303,9 @@ ORDINARY_PROGS = \ quantifier \ quantifier2 \ quoting_bug_test \ + random1 \ + random2 \ + random3 \ random_permutation \ random_simple \ rational_test \ @@ -321,9 +324,6 @@ ORDINARY_PROGS = \ rev_arith \ reverse_arith \ rnd \ - rng1 \ - rng2 \ - rng3 \ rtree_test \ rtti_strings \ sectag_bits \ diff --git a/tests/hard_coded/random1.exp b/tests/hard_coded/random1.exp new file mode 100644 index 000000000..f437c5231 --- /dev/null +++ b/tests/hard_coded/random1.exp @@ -0,0 +1,65 @@ +sfc16: +f1da2998508208ce +dc3db0ad5bdc29b4 +b45ddd1593d79f02 +c16ec5610837a9ed +eb86bafa5fe041c3 +0e39c83889057760 +4618b21c2a7b68f9 +8a4b6b051781e80f +0eb9ec14e2f2ecaa +51b58080d41cdd7a +47edad9ee007eaae +adf41b33a2e848a3 +994f7c58d79c645f +b2d48024ccc4d84e +b405d1f8991c2a57 +fa9847e553f2ec37 +b3f924d6937ea592 +714ec8f4628dfb90 +3895bc3d702924e1 +41e01e949d0abcd6 + +sfc32: +67c004cb9710cf59 +4afa2a0612c8b398 +a2f04cd5fd3c3aea +957a0e9b3b72705a +8dd576aeff28179d +b5bfe1ed3bee7eb6 +5436ff5340317077 +8f34ae5bc659489c +82c566e84c76ff57 +cf6e31c1222aea9a +bf8c36a3b9460e1d +7d06b86ee811bfd2 +56cbf44474a68886 +e3ca455cbbaa4fac +80b711a891c0a6d4 +8967f3705ddf020c +d1fdecd4a8808871 +f97ad63b4c206c74 +520e81db167c9f82 +8216cd04564bcc68 + +sfc64: +d029a1c2712c9d49 +f85f501bb1c04eec +fea25bc1ec40b318 +ac18b2945044ae76 +62cf40b35db4727b +b1732b64ac2c34d1 +c1aa0e92ee3fcf25 +7cd2c1258c1f81a7 +8002bb0742502d23 +881d3eb1963c3252 +58af30fc460cca22 +c324b43b980f7ca9 +aaa0d8be526900d6 +2ba5ff4ff7a49a35 +f41222612a677e40 +5522139092002c80 +96fe40e68a5b7553 +59ecca5eee058558 +bdf1251762cdb38b +919f5d0cdf591a5e diff --git a/tests/hard_coded/random1.m b/tests/hard_coded/random1.m new file mode 100644 index 000000000..b0f78278e --- /dev/null +++ b/tests/hard_coded/random1.m @@ -0,0 +1,47 @@ +%---------------------------------------------------------------------------% +% vim: ts=4 sw=4 sts=4 et ft=mercury +%---------------------------------------------------------------------------% + +:- module random1. +:- interface. +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int. +:- import_module list. +:- import_module random. +:- import_module random.sfc16. +:- import_module random.sfc32. +:- import_module random.sfc64. +:- import_module string. +:- import_module uint64. + +main(!IO) :- + io.write_string("sfc16:\n", !IO), + make_urandom(sfc16.init, RPsfc16, RSsfc16), + test(20, RPsfc16, RSsfc16, _, !IO), + + io.write_string("\nsfc32:\n", !IO), + sfc32.init(RPsfc32, RSsfc32), + test(20, RPsfc32, RSsfc32, _, !IO), + + io.write_string("\nsfc64:\n", !IO), + sfc64.init(RPsfc64, RSsfc64), + test(20, RPsfc64, RSsfc64, _, !IO). + +:- pred test(int::in, P::in, S::di, S::uo, io::di, io::uo) is det + <= urandom(P, S). + +test(Count, RP, !RS, !IO) :- + ( if Count > 0 then + random.gen_uint64(RP, N, !RS), + A = cast_to_int(N >> 32), + B = cast_to_int(N /\ 0xffffffffu64), + io.format("%08x%08x\n", [i(A), i(B)], !IO), + test(Count - 1, RP, !RS, !IO) + else + true + ). diff --git a/tests/hard_coded/random2.exp b/tests/hard_coded/random2.exp new file mode 100644 index 000000000..f437c5231 --- /dev/null +++ b/tests/hard_coded/random2.exp @@ -0,0 +1,65 @@ +sfc16: +f1da2998508208ce +dc3db0ad5bdc29b4 +b45ddd1593d79f02 +c16ec5610837a9ed +eb86bafa5fe041c3 +0e39c83889057760 +4618b21c2a7b68f9 +8a4b6b051781e80f +0eb9ec14e2f2ecaa +51b58080d41cdd7a +47edad9ee007eaae +adf41b33a2e848a3 +994f7c58d79c645f +b2d48024ccc4d84e +b405d1f8991c2a57 +fa9847e553f2ec37 +b3f924d6937ea592 +714ec8f4628dfb90 +3895bc3d702924e1 +41e01e949d0abcd6 + +sfc32: +67c004cb9710cf59 +4afa2a0612c8b398 +a2f04cd5fd3c3aea +957a0e9b3b72705a +8dd576aeff28179d +b5bfe1ed3bee7eb6 +5436ff5340317077 +8f34ae5bc659489c +82c566e84c76ff57 +cf6e31c1222aea9a +bf8c36a3b9460e1d +7d06b86ee811bfd2 +56cbf44474a68886 +e3ca455cbbaa4fac +80b711a891c0a6d4 +8967f3705ddf020c +d1fdecd4a8808871 +f97ad63b4c206c74 +520e81db167c9f82 +8216cd04564bcc68 + +sfc64: +d029a1c2712c9d49 +f85f501bb1c04eec +fea25bc1ec40b318 +ac18b2945044ae76 +62cf40b35db4727b +b1732b64ac2c34d1 +c1aa0e92ee3fcf25 +7cd2c1258c1f81a7 +8002bb0742502d23 +881d3eb1963c3252 +58af30fc460cca22 +c324b43b980f7ca9 +aaa0d8be526900d6 +2ba5ff4ff7a49a35 +f41222612a677e40 +5522139092002c80 +96fe40e68a5b7553 +59ecca5eee058558 +bdf1251762cdb38b +919f5d0cdf591a5e diff --git a/tests/hard_coded/random2.m b/tests/hard_coded/random2.m new file mode 100644 index 000000000..5f53391b3 --- /dev/null +++ b/tests/hard_coded/random2.m @@ -0,0 +1,49 @@ +%---------------------------------------------------------------------------% +% vim: ts=4 sw=4 sts=4 et ft=mercury +%---------------------------------------------------------------------------% + +:- module random2. +:- interface. +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int. +:- import_module list. +:- import_module random. +:- import_module random.sfc16. +:- import_module random.sfc32. +:- import_module random.sfc64. +:- import_module string. +:- import_module uint64. + +main(!IO) :- + io.write_string("sfc16:\n", !IO), + Rsfc16 = sfc16.init, + test(20, Rsfc16, _, !IO), + + io.write_string("\nsfc32:\n", !IO), + sfc32.init(Psfc32, Ssfc32), + Rsfc32 = make_shared_random(Psfc32, Ssfc32), + test(20, Rsfc32, _, !IO), + + io.write_string("\nsfc64:\n", !IO), + sfc64.init(Psfc64, Ssfc64), + Rsfc64 = make_shared_random(Psfc64, Ssfc64), + test(20, Rsfc64, _, !IO). + +:- pred test(int::in, R::in, R::out, io::di, io::uo) is det <= random(R). + +test(Count, !R, !IO) :- + ( if Count > 0 then + random.gen_uint64(N, !R), + A = cast_to_int(N >> 32), + B = cast_to_int(N /\ 0xffffffffu64), + io.format("%08x%08x\n", [i(A), i(B)], !IO), + test(Count - 1, !R, !IO) + else + true + ). + diff --git a/tests/hard_coded/random3.exp b/tests/hard_coded/random3.exp new file mode 100644 index 000000000..f437c5231 --- /dev/null +++ b/tests/hard_coded/random3.exp @@ -0,0 +1,65 @@ +sfc16: +f1da2998508208ce +dc3db0ad5bdc29b4 +b45ddd1593d79f02 +c16ec5610837a9ed +eb86bafa5fe041c3 +0e39c83889057760 +4618b21c2a7b68f9 +8a4b6b051781e80f +0eb9ec14e2f2ecaa +51b58080d41cdd7a +47edad9ee007eaae +adf41b33a2e848a3 +994f7c58d79c645f +b2d48024ccc4d84e +b405d1f8991c2a57 +fa9847e553f2ec37 +b3f924d6937ea592 +714ec8f4628dfb90 +3895bc3d702924e1 +41e01e949d0abcd6 + +sfc32: +67c004cb9710cf59 +4afa2a0612c8b398 +a2f04cd5fd3c3aea +957a0e9b3b72705a +8dd576aeff28179d +b5bfe1ed3bee7eb6 +5436ff5340317077 +8f34ae5bc659489c +82c566e84c76ff57 +cf6e31c1222aea9a +bf8c36a3b9460e1d +7d06b86ee811bfd2 +56cbf44474a68886 +e3ca455cbbaa4fac +80b711a891c0a6d4 +8967f3705ddf020c +d1fdecd4a8808871 +f97ad63b4c206c74 +520e81db167c9f82 +8216cd04564bcc68 + +sfc64: +d029a1c2712c9d49 +f85f501bb1c04eec +fea25bc1ec40b318 +ac18b2945044ae76 +62cf40b35db4727b +b1732b64ac2c34d1 +c1aa0e92ee3fcf25 +7cd2c1258c1f81a7 +8002bb0742502d23 +881d3eb1963c3252 +58af30fc460cca22 +c324b43b980f7ca9 +aaa0d8be526900d6 +2ba5ff4ff7a49a35 +f41222612a677e40 +5522139092002c80 +96fe40e68a5b7553 +59ecca5eee058558 +bdf1251762cdb38b +919f5d0cdf591a5e diff --git a/tests/hard_coded/random3.m b/tests/hard_coded/random3.m new file mode 100644 index 000000000..fcadb6c08 --- /dev/null +++ b/tests/hard_coded/random3.m @@ -0,0 +1,49 @@ +%---------------------------------------------------------------------------% +% vim: ts=4 sw=4 sts=4 et ft=mercury +%---------------------------------------------------------------------------% + +:- module random3. +:- interface. +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int. +:- import_module list. +:- import_module random. +:- import_module random.sfc16. +:- import_module random.sfc32. +:- import_module random.sfc64. +:- import_module string. +:- import_module uint64. + +main(!IO) :- + io.write_string("sfc16:\n", !IO), + make_io_random(sfc16.init, Msfc16, !IO), + test(20, Msfc16, !IO), + + io.write_string("\nsfc32:\n", !IO), + sfc32.init(Psfc32, Ssfc32), + make_io_urandom(Psfc32, Ssfc32, Msfc32, !IO), + test(20, Msfc32, !IO), + + io.write_string("\nsfc64:\n", !IO), + sfc64.init(Psfc64, Ssfc64), + make_io_urandom(Psfc64, Ssfc64, Msfc64, !IO), + test(20, Msfc64, !IO). + +:- pred test(int::in, M::in, io::di, io::uo) is det <= urandom(M, io). + +test(Count, M, !IO) :- + ( if Count > 0 then + random.gen_uint64(M, N, !IO), + A = cast_to_int(N >> 32), + B = cast_to_int(N /\ 0xffffffffu64), + io.format("%08x%08x\n", [i(A), i(B)], !IO), + test(Count - 1, M, !IO) + else + true + ). + diff --git a/tests/hard_coded/rng1.exp b/tests/hard_coded/rng1.exp deleted file mode 100644 index d23855f9f..000000000 --- a/tests/hard_coded/rng1.exp +++ /dev/null @@ -1,131 +0,0 @@ -marsaglia: -1168299085 -520487819 -1761612921 -3632618539 -610669668 -2136514290 -3850311835 -2494138816 -3923280858 -1280618954 -309986706 -924303156 -2252542156 -1444019197 -2955985350 -1185139548 -3579107875 -3047601897 -1651990379 -2165617597 - -sfc16: -43153 -47661 -50096 -11040 -31457 -3072 -18062 -30539 -55957 -45948 -19700 -58569 -33953 -35062 -62409 -59130 -23863 -36035 -47819 -1018 - -sfc32: -2534461273 -1740637387 -315143064 -1257908742 -4248582890 -2733657301 -997355610 -2507804315 -4280817565 -2379577006 -1005485750 -3049251309 -1076981879 -1412890451 -3327740060 -2402594395 -1282867031 -2193975016 -573237914 -3480105409 - -sfc: -14999697890428624201 -17897111524070149868 -18348328720311300888 -12400857924036243062 -7119980675011474043 -12786611478420272337 -13954982419586076453 -8994463772821127591 -9224140626659912995 -9808064495933469266 -6390380256327158306 -14061562104604753065 -12295065294659453142 -3145200633710418485 -17587157295553805888 -6134487154077740160 -10880205108681602387 -6479776472948376920 -13686761524927771531 -10493207966664694366 - -tausworthe3: -364603069 -528378279 -1153580643 -643237034 -3988596671 -1788716332 -626833507 -3768515118 -3526246283 -979916873 -497809124 -3522765921 -1904307014 -4035450154 -758388753 -2195520256 -1345056435 -1718236369 -823666345 -2531321601 - -tausworthe4: -3298080016 -1006674250 -784842863 -3826950035 -1766034713 -2314274634 -2461174380 -1680209578 -3954198082 -1441070313 -3013911521 -3001839125 -563675899 -2431136453 -632203520 -1481012674 -3251476639 -4143656215 -2141916911 -1746317775 diff --git a/tests/hard_coded/rng1.m b/tests/hard_coded/rng1.m deleted file mode 100644 index eec604a57..000000000 --- a/tests/hard_coded/rng1.m +++ /dev/null @@ -1,55 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ts=4 sw=4 sts=4 et ft=mercury -%---------------------------------------------------------------------------% - -:- module rng1. -:- interface. -:- import_module io. - -:- pred main(io::di, io::uo) is det. - -:- implementation. - -:- import_module int. -:- import_module rng. -:- import_module rng.marsaglia. -:- import_module rng.sfc. -:- import_module rng.tausworthe. - -main(!IO) :- - io.write_string("marsaglia:\n", !IO), - make_urng(marsaglia.init, RPm, RSm), - test(20, RPm, RSm, _, !IO), - - io.write_string("\nsfc16:\n", !IO), - make_urng(sfc.init16, RPsfc16, RSsfc16), - test(20, RPsfc16, RSsfc16, _, !IO), - - io.write_string("\nsfc32:\n", !IO), - sfc.init32(RPsfc32, RSsfc32), - test(20, RPsfc32, RSsfc32, _, !IO), - - io.write_string("\nsfc:\n", !IO), - sfc.init(RPsfc, RSsfc), - test(20, RPsfc, RSsfc, _, !IO), - - io.write_string("\ntausworthe3:\n", !IO), - tausworthe.init_t3(RPt3, RSt3), - test(20, RPt3, RSt3, _, !IO), - - io.write_string("\ntausworthe4:\n", !IO), - tausworthe.init_t4(RPt4, RSt4), - test(20, RPt4, RSt4, _, !IO). - -:- pred test(int, RP, RS, RS, io, io) <= urng(RP, RS). -:- mode test(in, in, di, uo, di, uo) is det. - -test(Count, RP, !RS, !IO) :- - ( if Count > 0 then - urandom(RP, N, !RS), - io.write_uint64(N, !IO), - io.nl(!IO), - test(Count - 1, RP, !RS, !IO) - else - true - ). diff --git a/tests/hard_coded/rng2.exp b/tests/hard_coded/rng2.exp deleted file mode 100644 index d23855f9f..000000000 --- a/tests/hard_coded/rng2.exp +++ /dev/null @@ -1,131 +0,0 @@ -marsaglia: -1168299085 -520487819 -1761612921 -3632618539 -610669668 -2136514290 -3850311835 -2494138816 -3923280858 -1280618954 -309986706 -924303156 -2252542156 -1444019197 -2955985350 -1185139548 -3579107875 -3047601897 -1651990379 -2165617597 - -sfc16: -43153 -47661 -50096 -11040 -31457 -3072 -18062 -30539 -55957 -45948 -19700 -58569 -33953 -35062 -62409 -59130 -23863 -36035 -47819 -1018 - -sfc32: -2534461273 -1740637387 -315143064 -1257908742 -4248582890 -2733657301 -997355610 -2507804315 -4280817565 -2379577006 -1005485750 -3049251309 -1076981879 -1412890451 -3327740060 -2402594395 -1282867031 -2193975016 -573237914 -3480105409 - -sfc: -14999697890428624201 -17897111524070149868 -18348328720311300888 -12400857924036243062 -7119980675011474043 -12786611478420272337 -13954982419586076453 -8994463772821127591 -9224140626659912995 -9808064495933469266 -6390380256327158306 -14061562104604753065 -12295065294659453142 -3145200633710418485 -17587157295553805888 -6134487154077740160 -10880205108681602387 -6479776472948376920 -13686761524927771531 -10493207966664694366 - -tausworthe3: -364603069 -528378279 -1153580643 -643237034 -3988596671 -1788716332 -626833507 -3768515118 -3526246283 -979916873 -497809124 -3522765921 -1904307014 -4035450154 -758388753 -2195520256 -1345056435 -1718236369 -823666345 -2531321601 - -tausworthe4: -3298080016 -1006674250 -784842863 -3826950035 -1766034713 -2314274634 -2461174380 -1680209578 -3954198082 -1441070313 -3013911521 -3001839125 -563675899 -2431136453 -632203520 -1481012674 -3251476639 -4143656215 -2141916911 -1746317775 diff --git a/tests/hard_coded/rng2.m b/tests/hard_coded/rng2.m deleted file mode 100644 index fb0c53eeb..000000000 --- a/tests/hard_coded/rng2.m +++ /dev/null @@ -1,59 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ts=4 sw=4 sts=4 et ft=mercury -%---------------------------------------------------------------------------% - -:- module rng2. -:- interface. -:- import_module io. - -:- pred main(io::di, io::uo) is det. - -:- implementation. - -:- import_module int. -:- import_module rng. -:- import_module rng.marsaglia. -:- import_module rng.sfc. -:- import_module rng.tausworthe. - -main(!IO) :- - io.write_string("marsaglia:\n", !IO), - RNGm = marsaglia.init, - test(20, RNGm, _, !IO), - - io.write_string("\nsfc16:\n", !IO), - RNGsfc16 = sfc.init16, - test(20, RNGsfc16, _, !IO), - - io.write_string("\nsfc32:\n", !IO), - sfc.init32(RPsfc32, RSsfc32), - RNGsfc32 = make_shared_rng(RPsfc32, RSsfc32), - test(20, RNGsfc32, _, !IO), - - io.write_string("\nsfc:\n", !IO), - sfc.init(RPsfc, RSsfc), - RNGsfc = make_shared_rng(RPsfc, RSsfc), - test(20, RNGsfc, _, !IO), - - io.write_string("\ntausworthe3:\n", !IO), - tausworthe.init_t3(RP2, RS2), - RNG2 = make_shared_rng(RP2, RS2), - test(20, RNG2, _, !IO), - - io.write_string("\ntausworthe4:\n", !IO), - tausworthe.init_t4(RP3, RS3), - RNG3 = make_shared_rng(RP3, RS3), - test(20, RNG3, _, !IO). - -:- pred test(int, RNG, RNG, io, io) <= rng(RNG). -:- mode test(in, in, out, di, uo) is det. - -test(Count, !RNG, !IO) :- - ( if Count > 0 then - random(N, !RNG), - io.write_uint64(N, !IO), - io.nl(!IO), - test(Count - 1, !RNG, !IO) - else - true - ). diff --git a/tests/hard_coded/rng3.data b/tests/hard_coded/rng3.data deleted file mode 100644 index 32608b4f0..000000000 --- a/tests/hard_coded/rng3.data +++ /dev/null @@ -1 +0,0 @@ -),'%s܉uq/xLC1< V;ߜ9- <@T 6Aڄ@lvAx441PGu^(&)nAvM2w-fDpϸC܄ccWr]j<=*s \ No newline at end of file diff --git a/tests/hard_coded/rng3.exp b/tests/hard_coded/rng3.exp deleted file mode 100644 index d65b2562d..000000000 --- a/tests/hard_coded/rng3.exp +++ /dev/null @@ -1,20 +0,0 @@ -2954916798570026696 -1667866628051534109 -13940220771134697775 -322207273700596812 -4888430056450119176 -4314338737435511803 -17802622935837392980 -13252981692086548022 -10215788215724049472 -7783069486986040440 -12840945681691628871 -9208765531625021939 -12333313133034171969 -8574196514119192996 -3249741414590345429 -1298368084489858627 -11139097173025252115 -15212143235644916823 -14732021350738443524 -13699714837961864112 diff --git a/tests/hard_coded/rng3.m b/tests/hard_coded/rng3.m deleted file mode 100644 index bd65dcb6e..000000000 --- a/tests/hard_coded/rng3.m +++ /dev/null @@ -1,57 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ts=4 sw=4 sts=4 et ft=mercury -%---------------------------------------------------------------------------% - -:- module rng3. -:- interface. -:- import_module io. - -:- pred main(io::di, io::uo) is cc_multi. - -:- implementation. - -:- import_module exception. -:- import_module int. -:- import_module list. -:- import_module rng. -:- import_module rng.binfile. -:- import_module string. - -main(!IO) :- - open("rng3.data", Res, !IO), - ( - Res = ok(RPbin), - test(20, RPbin, !IO), - expect_eof(RPbin, !IO), - close(RPbin, !IO) - ; - Res = error(E), - io.progname($module, Name, !IO), - io.format("%s: %s\n", [s(Name), s(error_message(E))], !IO) - ). - -:- pred test(int, binfile, io, io). -:- mode test(in, in, di, uo) is det. - -test(Count, RP, !IO) :- - ( if Count > 0 then - rand(RP, N, !IO), - io.write_uint64(N, !IO), - io.nl(!IO), - test(Count - 1, RP, !IO) - else - true - ). - -:- pred expect_eof(binfile, io, io). -:- mode expect_eof(in, di, uo) is cc_multi. - -expect_eof(RP, !IO) :- - ( try [io(!IO)] - rand(RP, _, !IO) - then - io.write_string("EOF not found!\n", !IO) - catch _ : software_error -> - true - ). -