From 8916501b5059c161a87a9e898396b7fd0520e593 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 21 Nov 2025 16:16:58 +0100 Subject: [PATCH 01/10] Use more bits when shuffling Also, use specified algorithms when measuring. --- lib/stdlib/src/rand.erl | 62 +++++++++++++++++++--------------- lib/stdlib/test/rand_SUITE.erl | 45 +++++++++++++++++------- 2 files changed, 67 insertions(+), 40 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 7298e65b327f..ff9562c90b65 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -533,6 +533,7 @@ the generator's range: exs1024_next/1, exs1024_calc/2, exro928_next_state/4, exrop_next/1, exrop_next_s/2, + shuffle_new_bits/1, mwc59_value/1, get_52/1, normal_kiwi/1]}). @@ -606,7 +607,7 @@ the generator's range: -type alg_handler() :: #{type := alg(), bits => non_neg_integer(), - weak_low_bits => non_neg_integer(), + weak_low_bits => 0..3, max => non_neg_integer(), % Deprecated next := fun ((alg_state()) -> {non_neg_integer(), alg_state()}), @@ -1503,17 +1504,9 @@ and the [`NewState`](`t:state/0`). when List :: list(), State :: state(). -shuffle_s(List, {#{bits:=_, next:=Next} = AlgHandler, R0}) +shuffle_s(List, {AlgHandler, R0}) when is_list(List) -> - WeakLowBits = maps:get(weak_low_bits, AlgHandler, 0), - [P0|S0] = shuffle_init_bitstream(R0, Next, WeakLowBits), - {ShuffledList, _P1, [R1|_]=_S1} = shuffle_r(List, [], P0, S0), - {ShuffledList, {AlgHandler, R1}}; -shuffle_s(List, {#{max:=_, next:=Next} = AlgHandler, R0}) - when is_list(List) -> - %% Old spec - assume 2 weak low bits - WeakLowBits = 2, - [P0|S0] = shuffle_init_bitstream(R0, Next, WeakLowBits), + [P0|S0] = shuffle_init_bitstream(R0, AlgHandler), {ShuffledList, _P1, [R1|_]=_S1} = shuffle_r(List, [], P0, S0), {ShuffledList, {AlgHandler, R1}}. @@ -1607,9 +1600,9 @@ shuffle_r([], Acc0, P0, S0, Zero, One, Two, Three) -> {Acc3, P3, S3} = shuffle_r(Two, Acc2, P2, S2), shuffle_r(Three, Acc3, P3, S3); shuffle_r([X | L], Acc, P0, S, Zero, One, Two, Three) - when is_integer(P0), 3 < P0, P0 < 1 bsl 57 -> + when is_integer(P0), ?BIT(2) =< P0, P0 =< ?MASK(59) -> P1 = P0 bsr 2, - case P0 band 3 of + case ?MASK(2, P0) of 0 -> shuffle_r(L, Acc, P1, S, [X | Zero], One, Two, Three); 1 -> shuffle_r(L, Acc, P1, S, Zero, [X | One], Two, Three); 2 -> shuffle_r(L, Acc, P1, S, Zero, One, [X | Two], Three); @@ -1621,8 +1614,8 @@ shuffle_r([_ | _] = L, Acc, _P, S0, Zero, One, Two, Three) -> %% Permute 2 elements shuffle_r_2(X, Acc, P, S, Y) - when is_integer(P), 1 < P, P < 1 bsl 57 -> - {case P band 1 of + when is_integer(P), ?BIT(1) =< P, P =< ?MASK(59) -> + {case ?MASK(1, P) of 0 -> [Y, X | Acc]; 1 -> [X, Y | Acc] end, P bsr 1, S}; @@ -1636,9 +1629,9 @@ shuffle_r_2(X, Acc, _P, S0, Y) -> %% to reject and retry, which on average is 3 * 4/3 %% (infinite sum of (1/4)^k) = 4 bits per permutation shuffle_r_3(X, Acc, P0, S, Y, Z) - when is_integer(P0), 7 < P0, P0 < 1 bsl 57 -> + when is_integer(P0), ?BIT(3) =< P0, P0 =< ?MASK(59) -> P1 = P0 bsr 3, - case P0 band 7 of + case ?MASK(3, P0) of 0 -> {[Z, Y, X | Acc], P1, S}; 1 -> {[Y, Z, X | Acc], P1, S}; 2 -> {[Z, X, Y | Acc], P1, S}; @@ -1652,24 +1645,37 @@ shuffle_r_3(X, Acc, _P, S0, Y, Z) -> [P|S1] = shuffle_new_bits(S0), shuffle_r_3(X, Acc, P, S1, Y, Z). --dialyzer({no_improper_lists, shuffle_init_bitstream/3}). %% -shuffle_init_bitstream(R, Next, WeakLowBits) -> +shuffle_init_bitstream(R, #{bits:=Bits, next:=Next} = AlgHandler) -> + Mask = ?MASK(Bits), + Shift = maps:get(weak_low_bits, AlgHandler, 0), + shuffle_init_bitstream(R, Next, Shift, Mask); +shuffle_init_bitstream(R, #{max:=Mask, next:=Next}) -> + %% Old spec - assume 2 weak low bits + Shift = 2, + shuffle_init_bitstream(R, Next, Shift, Mask). +%% +-dialyzer({no_improper_lists, shuffle_init_bitstream/4}). +shuffle_init_bitstream(R, Next, Shift, Mask0) -> + Mask = ?MASK(58, Mask0), % Limit the mask to avoid bignum P = 1, % Marker for out of random bits - W = {Next,WeakLowBits}, % Generator + W = {Next,Shift,Mask}, % Generator S = [R|W], % Generator state [P|S]. % Bit cash and state -dialyzer({no_improper_lists, shuffle_new_bits/1}). %% -shuffle_new_bits([R0|{Next,WeakLowBits}=W]) -> - {V, R1} = Next(R0), - %% Setting the top bit M here provides the marker - %% for when we are out of random bits: P =:= 1 - M = 1 bsl 56, - P = ((V bsr WeakLowBits) band (M-1)) bor M, - S = [R1|W], - [P|S]. +shuffle_new_bits([R0|{Next,Shift,Mask}=W]) + when is_integer(Shift), 0 =< Shift, Shift =< 3, + is_integer(Mask), 0 < Mask, Mask =< ?MASK(58) -> + case Next(R0) of + {V, R1} when is_integer(V) -> + %% Setting the top bit here provides the marker + %% for when we are out of random bits: P =:= 1 + P = ((V bsr Shift) band Mask) bor (Mask + 1), + S = [R1|W], + [P|S] + end. %% ===================================================================== %% Internal functions diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index b94a21285d68..da40195fb841 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -55,8 +55,6 @@ suite() -> all() -> [seed, interval_int, interval_float, bytes_count, - shuffle_elements, shuffle_reference, - basic_stats_shuffle, measure_shuffle, api_eq, mwc59_api, exsp_next_api, exsp_jump_api, @@ -68,6 +66,7 @@ all() -> plugin, measure, {group, reference_jump}, short_jump, + {group, shuffle}, doctests ]. @@ -75,6 +74,9 @@ groups() -> [{basic_stats, [parallel], [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_bytes, basic_stats_standard_normal]}, + {shuffle, [], + [shuffle_elements, shuffle_reference, + basic_stats_shuffle, measure_shuffle]}, {distr_stats, [parallel], [stats_standard_normal_box_muller, stats_standard_normal_box_muller_2, @@ -89,6 +91,9 @@ group(distr_stats) -> %% valgrind needs a lot of time [{timetrap,{minutes,10}}]; group(reference_jump) -> + %% valgrind needs a lot of time + [{timetrap,{minutes,10}}]; +group(shuffle) -> %% valgrind needs a lot of time [{timetrap,{minutes,10}}]. @@ -414,10 +419,13 @@ bytes_count(Config) when is_list(Config) -> %% Check that shuffle doesn't loose or duplicate elements shuffle_elements(Config) when is_list(Config) -> - M = 20, - SortedList = lists:seq(0, (1 bsl M) - 1), + SortedList = lists:seq(1, 1010_101), State = rand:seed(default), - case lists:sort(rand:shuffle(SortedList)) of + {ShuffledList, NewState} = rand:shuffle_s(SortedList, State), + true = ShuffledList =:= rand:shuffle(SortedList), + NewSeed = rand:export_seed_s(NewState), + NewSeed = rand:export_seed(), + case lists:sort(ShuffledList) of SortedList -> ok; _ -> error({mismatch, State}) @@ -428,13 +436,26 @@ shuffle_elements(Config) when is_list(Config) -> %% Check that shuffle is repeatable shuffle_reference(Config) when is_list(Config) -> - M = 20, + M = 20, + List = lists:seq(0, (1 bsl M) - 1), Seed = {1,2,3}, - MD5 = <<56,202,188,237,192,69,132,182,227,54,33,68,45,74,208,89>>, - %% - SortedList = lists:seq(0, (1 bsl M) - 1), - S = rand:seed_s(default, Seed), - {ShuffledList, NewS} = rand:shuffle_s(SortedList, S), + Ref = + [{exsss, + <<124,54,150,191,198,136,245,103,157,213,96,6,210,103,134,107>>}, + {exro928ss, + <<160,170,223,95,44,254,192,107,145,180,236,235,102,110,72,131>>}, + {exrop, + <<175,236,222,199,129,54,205,86,81,38,92,219,66,71,30,69>>}, + {exs1024s, + <<148,169,164,28,198,202,108,206,123,68,189,26,116,210,82,116>>}, + {exsp, + <<63,163,228,59,249,88,205,251,225,174,227,65,144,130,169,191>>}], + [shuffle_reference(M, List, Seed, Alg, MD5) || {Alg, MD5} <- Ref], + ok. + +shuffle_reference(M, List, Seed, Alg, MD5) -> + S = rand:seed_s(Alg, Seed), + {ShuffledList, NewS} = rand:shuffle_s(List, S), Data = mk_iolist(ShuffledList, M), case erlang:md5(Data) of MD5 -> ok; @@ -517,7 +538,7 @@ measure_shuffle(Config) when is_list(Config) -> end; measure_shuffle(Effort) when is_integer(Effort) -> Algs = - [default, exs1024 | + [exsss, exs1024 | case crypto_support() of ok -> [crypto]; _ -> [] From c9247ded9878e30766761883d806d47e4b39d99c Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 13 Nov 2025 16:59:48 +0100 Subject: [PATCH 02/10] Write more tested documentation examples --- lib/stdlib/src/rand.erl | 535 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 491 insertions(+), 44 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index ff9562c90b65..c0e5157656a7 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -130,7 +130,7 @@ and use the returned new state in the next call, or call an API function without an explicit state argument to operate on the state in the process dictionary. -#### _Examples_ +#### _Shell Examples_ ```erlang %% Generate two uniformly distibuted floating point numbers. @@ -147,7 +147,7 @@ true is_float(R1) andalso 0.0 =< R1 andalso R1 < 1.0. true -%% Generate a uniformly distributed integer in the range 1..4711: +%% Generate a uniformly distributed integer in the range 1 .. 4711: %% 3> K0 = rand:uniform(4711), is_integer(K0) andalso 1 =< K0 andalso K0 =< 4711. @@ -218,6 +218,28 @@ true true %% R6 cannot be equal to 0.0 so math:log/1 will never fail 17> SND1 = math:sqrt(-2 * math:log(R6)) * math:cos(math:pi() * R7). + +%% Shuffle a deck of cards from a fixed seed, +%% with a cryptographically unpredictable algorithm: +18> Deck0 = [{Rank,Suit} || + Rank <- lists:seq(2, 14), + Suit <- [clubs,diamonds,hearts,spades]] +19> S5 = crypto:rand_seed_alg(crypto_aes, "Nothing up my sleeve") +20> {Deck, S6} = rand:shuffle_s(Deck0, S5). +21> Deck. +[{2,spades}, {12,spades}, {14,diamonds}, {11,clubs}, + {6,spades}, {2,hearts}, {13,diamonds}, {12,hearts}, + {10,clubs}, {7,diamonds}, {2,diamonds}, {9,diamonds}, + {4,hearts}, {9,hearts}, {6,clubs}, {3,spades}, + {3,diamonds}, {14,clubs}, {9,spades}, {10,hearts}, + {3,hearts}, {4,spades}, {13,hearts}, {5,hearts}, + {7,hearts}, {7,clubs}, {8,spades}, {14,spades}, + {11,spades}, {12,clubs}, {5,diamonds}, {12,diamonds}, + {4,diamonds}, {9,clubs}, {14,hearts}, {2,clubs}, + {10,diamonds}, {13,spades}, {6,hearts}, {4,clubs}, + {7,spades}, {5,spades}, {10,spades}, {5,clubs}, + {8,diamonds}, {6,diamonds}, {8,clubs}, {11,hearts}, + {13,clubs}, {11,diamonds}, {3,clubs}, {8,hearts}] ``` [](){: #algorithms } Algorithms @@ -334,7 +356,7 @@ relying on them will produce the same pseudo random sequences as before. > The new algorithms are a bit slower but do not have these problems: > > Uniform integer ranges had a skew in the probability distribution -> that was not noticable for small ranges but for large ranges +> that was not noticeable for small ranges but for large ranges > less than the generator's precision the probability to produce > a low number could be twice the probability for a high. > @@ -405,7 +427,7 @@ the generator's range: [](){: #modulo-method } - **Modulo** - To generate a number `V` in the range `0..Range-1`: + To generate a number `V` in the range `0 .. Range-1`: > Generate a number `X`. > Use `V = X rem Range` as your value. @@ -421,12 +443,12 @@ the generator's range: have a bias. Example: Say the generator generates a byte, that is, the generator range - is `0..255`, and the desired range is `0..99` (`Range = 100`). + is `0 .. 255`, and the desired range is `0 .. 99` (`Range = 100`). Then there are 3 generator outputs that produce the value `0`, these are; `0`, `100` and `200`. But there are only 2 generator outputs that produce the value `99`, - which are; `99` and `199`. So the probability for a value `V` in `0..55` - is 3/2 times the probability for the other values `56..99`. + which are; `99` and `199`. So the probability for a value `V` in `0 .. 55` + is 3/2 times the probability for the other values `56 .. 99`. If `Range` is much smaller than the generator range, then this bias gets hard to detect. The rule of thumb is that if `Range` is smaller @@ -442,8 +464,8 @@ the generator's range: [](){: #truncated-multiplication-method } - **Truncated multiplication** - To generate a number `V` in the range `0..Range-1`, when you have - a generator with a power of 2 range (`0..2^Bits-1`): + To generate a number `V` in the range `0 .. Range-1`, when you have + a generator with a power of 2 range (`0 .. 2^Bits-1`): > Generate a number `X`. > Use `V = X * Range bsr Bits` as your value. @@ -460,8 +482,8 @@ the generator's range: [](){: #shift-or-mask-method } - **Shift or mask** - To generate a number in a power of 2 range (`0..2^RBits-1`), - when you have a generator with a power of 2 range (`0..2^Bits`): + To generate a number in a power of 2 range (`0 .. 2^RBits-1`), + when you have a generator with a power of 2 range (`0 .. 2^Bits`): > Generate a number `X`. > Use `V = X band ((1 bsl RBits)-1)` or `V = X bsr (Bits-RBits)` @@ -489,20 +511,20 @@ the generator's range: Also, since the base generator is a full length generator, a value that will break the loop must eventually be generated. - These methods can be combined, such as using - the [Modulo](#modulo-method) method and only if the generator value - would create bias use [Rejection](#rejection-method). - Or using [Shift or mask](#shift-or-mask-method) to reduce the size - of a generator value so that - [Truncated multiplication](#truncated-multiplication-method) - will not create a bignum. - - The recommended way to generate a floating point number - (IEEE 745 Double, that has got a 53-bit mantissa) in the range - `0..1`, that is `0.0 =< V < 1.0` is to generate a 53-bit number `X` - and then use `V = X * (1.0/((1 bsl 53)))` as your value. - This will create a value of the form N*2^-53 with equal probability - for every possible N for the range. +These methods can be combined, such as using +the [Modulo](#modulo-method) method and only if the generator value +would create bias use [Rejection](#rejection-method). +Or using [Shift or mask](#shift-or-mask-method) to reduce the size +of a generator value so that +[Truncated multiplication](#truncated-multiplication-method) +will not create a bignum. + +The recommended way to generate a floating point number +(IEEE 745 Double, that has got a 53-bit mantissa) in the range +`0 .. 1`, that is `0.0 =< V < 1.0` is to generate a 53-bit number `X` +and then use `V = X * (1.0/((1 bsl 53)))` as your value. +This will create a value of the form N*2^-53 with equal probability +for every possible N for the range. """. -moduledoc(#{since => "OTP 18.0"}). @@ -750,6 +772,27 @@ Export the seed value. Returns the random number state in an external format. To be used with `seed/1`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S = rand:seed(exsss, 4711). +%% Export the (initial) state +2> E = rand:export_seed(). +%% Generate an integer N in the interval 1 .. 1000000 +3> rand:uniform(1000000). +334013 +%% Start over with E that may have been stored +%% in ETS, on file, etc... +4> rand:seed(E). +5> rand:uniform(1000000). +334013 +%% Within the same node this works just as well +6> rand:seed(S). +7> rand:uniform(1000000). +334013 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec export_seed() -> 'undefined' | export_state(). @@ -764,6 +807,32 @@ Export the seed value. Returns the random number generator state in an external format. To be used with `seed/1`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Export the (initial) state +2> E = rand:export_seed_s(S0). +%% Generate an integer N in the interval 1 .. 1000000 +3> {N, S1} = rand:uniform_s(1000000, S0). +4> N. +334013 +%% Start over with E that may have been stored +%% in ETS, on file, etc... +5> S2 = rand:seed_s(E). +%% S2 is equivalent to S0 +6> {N, S3} = rand:uniform_s(1000000, S2). +%% S3 is equivalent to S1 +7> N. +334013 +%% Within the same node this works just as well +6> {N, S4} = rand:uniform_s(1000000, S0). +%% S4 is equivalent to S1 +7> N. +334013 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec export_seed_s(State :: state()) -> export_state(). @@ -785,6 +854,24 @@ but also stores the generated state in the process dictionary. The argument `default` is an alias for the [_default algorithm_](#default-algorithm) that has been implemented *(Since OTP 24.0)*. + +#### _Shell Example_ + +```erlang +%% Initialize a PRNG sequence +%% with the default algorithm and automatic seed. +%% The return value from rand:seed/1 is normally +%% not used, but here we use it to verify equality +1> S = rand:seed(default). +%% Start from a state exported from +%% the process dictionary is equivalent +2> S = rand:seed(rand:export_seed()). +%% A state can also be used as a start state +3> S = rand:seed(S). +%% With a heavier algorithm +4> SS = rand:seed(exro928ss). +5> SS = rand:seed(rand:export_seed()). +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec seed(Alg | State) -> state() when @@ -809,6 +896,21 @@ fairly unique items may change in the future, if necessary. With the argument `State`, re-creates the state and returns it. See also `export_seed/0`. + +#### _Shell Example_ + +```erlang +%% Initialize a PRNG sequence +%% with the default algorithm and automatic seed +1> S = rand:seed_s(default). +%% Start from an exported state is equivalent +2> S = rand:seed_s(rand:export_seed_s(S)). +%% A state can also be used as a start state +3> S = rand:seed_s(S). +%% With a heavier algorithm +4> SS = rand:seed_s(exro928ss). +5> SS = rand:seed_s(rand:export_seed_s(SS)). +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec seed_s(Alg | State) -> state() when @@ -842,6 +944,20 @@ but also stores the generated state in the process dictionary. `Alg = default` is an alias for the [_default algorithm_](#default-algorithm) that has been implemented *(Since OTP 24.0)*. + +#### _Shell Example_ + +```erlang +%% Create a predictable PRNG sequence initial state, +%% in the process dictionary +1> rand:seed(exsss, 4711). +``` + +> #### Note {: .info } +> +> Using `Alg = default` is *not* perfectly predictable since +> which algorithm that is the default may change in a future +> OTP release. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec seed(Alg, Seed) -> state() when @@ -858,6 +974,19 @@ from the specified `t:seed/0` integers. `Alg = default` is an alias for the [_default algorithm_](#default-algorithm) that has been implemented *since OTP 24.0*. + +#### _Shell Example_ + +```erlang +%% Create a predictable PRNG sequence initial state +1> S = rand:seed(exsss, 4711). +``` + +> #### Note {: .info } +> +> Using `Alg = default` is *not* perfectly predictable since +> which algorithm that is the default may change in a future +> OTP release. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec seed_s(Alg, Seed) -> state() when @@ -881,6 +1010,16 @@ using the state in the process dictionary. Like `uniform_s/1` but operates on the state stored in the process dictionary. Returns the generated number `X`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Generate a float() in [0.0, 1.0) +2> rand:uniform(). +0.28480361525506226 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec uniform() -> X :: float(). @@ -899,6 +1038,16 @@ using the state in the process dictionary. Like `uniform_s/2` but operates on the state stored in the process dictionary. Returns the generated number `X`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Generate an integer in the interval 1 .. 1000000 +2> rand:uniform(1000000). +334013 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec uniform(N :: pos_integer()) -> X :: pos_integer(). @@ -937,6 +1086,17 @@ equally spaced in the interval. > _ -> my_uniform() > end. > ``` + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Generate a float() F in [0.0, 1.0) +2> {F, S1} = rand:uniform_s(S0). +3> F. +0.28480361525506226 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec uniform_s(State :: state()) -> {X :: float(), NewState :: state()}. @@ -962,6 +1122,17 @@ Generate a uniformly distributed random integer `1 =< X =< N`. From the specified `State`, generates a random number `X ::` `t:integer/0`, uniformly distributed in the specified range `1 =< X =< N`. Returns the number `X` and the updated `NewState`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Generate an integer N in the interval 1 .. 1000000 +2> {N, S1} = rand:uniform_s(1000000, S0). +3> N. +334013 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec uniform_s(N :: pos_integer(), State :: state()) -> @@ -998,6 +1169,21 @@ Like `uniform_real_s/1` but operates on the state stored in the process dictionary. Returns the generated number `X`. See `uniform_real_s/1`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence (bad seed) +1> S = rand:seed(exsss, [4711,0]). +%% Generate a float() in [0.0, 1.0) +2> rand:uniform(). +0.0 +%% But, with uniform_real/1 we get better precision; +%% generate a float() with distribution [0.0, 1.0) in (0.0, 1.0) +3> rand:seed(S). +3> rand:uniform_real(). +2.1911861999281885e-20 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 21.0">>}). -spec uniform_real() -> X :: float(). @@ -1080,6 +1266,22 @@ in a sub range is the same, very much like the numbers generated by Having to generate extra random bits for occasional small numbers costs a little performance. This function is about 20% slower than the regular `uniform_s/1` + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence (bad seed) +1> S0 = rand:seed_s(exsss, [4711,0]). +%% Generate a float() F in [0.0, 1.0) +2> {F, S1} = rand:uniform_s(S0). +3> F. +0.0 +%% But, with uniform_real/1 we get better precision; +%% generate a float() R with distribution [0.0, 1.0) in (0.0, 1.0) +3> {R, S2} = rand:uniform_real_s(S0). +5> R. +2.1911861999281885e-20 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 21.0">>}). -spec uniform_real_s(State :: state()) -> {X :: float(), NewState :: state()}. @@ -1237,6 +1439,16 @@ using the state in the process dictionary. Like `bytes_s/2` but operates on the state stored in the process dictionary. Returns the generated [`Bytes`](`t:binary/0`). + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Generate 10 bytes +2> rand:bytes(10). +<<72,232,227,197,77,149,79,57,9,136>> +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 24.0">>}). -spec bytes(N :: non_neg_integer()) -> Bytes :: binary(). @@ -1275,10 +1487,21 @@ as required to compose the `t:binary/0`. Returns the generated > > Particularly inefficient and slow is to use > a [`rand` plug-in generator](#plug-in-framework) from `m:crypto` -> such as `crypto:rand_seed_s/0` to call this function for generating -> bytes. Since in that case it is not possible to reproduce -> the byte sequence anyway; it is better to use +> such as `crypto:rand_seed_s/0` when calling this function +> for generating bytes. Since in that case it is not possible +> to reproduce the byte sequence anyway; it is better to use > `crypto:strong_rand_bytes/1` directly. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Generate 10 bytes +2> {Bytes, S1} = rand:bytes_s(10, S0). +3> Bytes. +<<72,232,227,197,77,149,79,57,9,136>> +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 24.0">>}). -spec bytes_s(N :: non_neg_integer(), State :: state()) -> @@ -1360,6 +1583,22 @@ describing jump functions. This function raises a `not_implemented` error exception if there is no jump function implemented for the [`State`](`t:state/0`)'s algorithm. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> Sa0 = rand:seed_s(exsss, 4711). +2> Sb0 = rand:jump(Sa0). +%% Sa and Sb can now be used for surely +%% non-overlapping PRNG sequences +3> {BytesA, Sa1} = rand:bytes_s(10, Sa0). +4> {BytesB, Sb1} = rand:bytes_s(10, Sb0). +5> BytesA. +<<72,232,227,197,77,149,79,57,9,136>> +6> BytesB. +<<105,25,180,32,189,44,213,220,254,22>> +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 20.0">>}). -spec jump(State :: state()) -> NewState :: state(). @@ -1379,6 +1618,26 @@ Jump the generator state forward. Like `jump/1` but operates on the state stored in the process dictionary. Returns the [`NewState`](`t:state/0`). + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S = rand:seed(exsss, 4711). +2> Parent = self(). +3> Pid = spawn( + fun() -> + rand:seed(S), + rand:jump(), + Parent ! {self(), rand:bytes(10)} + end). +%% Parent and Pid now produce surely +%% non-overlapping PRNG sequences +4> rand:bytes(10). +<<72,232,227,197,77,149,79,57,9,136>> +5> receive {Pid, Bytes} -> Bytes end. +<<105,25,180,32,189,44,213,220,254,22>> +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 20.0">>}). -spec jump() -> NewState :: state(). @@ -1393,6 +1652,16 @@ Generate a random number with standard normal distribution. Like `normal_s/1` but operates on the state stored in the process dictionary. Returns the generated number `X`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Generate a float() with distribution 𝒩 (0.0, 1.0) +2> rand:normal(). +0.5235119324419965 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec normal() -> X :: float(). @@ -1409,6 +1678,16 @@ Generate a random number with specified normal distribution 𝒩 *(μ, σ²)*. Like `normal_s/3` but operates on the state stored in the process dictionary. Returns the generated number `X`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Generate a float() with distribution 𝒩 (-3.0, 0.5) +2> rand:normal(-3.0, 0.5). +-2.6298211625381906 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 20.0">>}). -spec normal(Mean :: number(), Variance :: number()) -> X :: float(). @@ -1428,6 +1707,17 @@ and variance `1.0`. Returns the generated number [`X`](`t:float/0`) and the [`NewState`](`t:state/0`). + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Generate a float() F with distribution 𝒩 (0.0, 1.0) +2> {F, S1} = rand:normal_s(S0). +3> F. +0.5235119324419965 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). -spec normal_s(State :: state()) -> {X :: float(), NewState :: state()}. @@ -1456,6 +1746,17 @@ with normal distribution 𝒩 *(μ, σ²)*, that is 𝒩 (Mean, Variance) where `Variance >= 0.0`. Returns [`X`](`t:float/0`) and the [`NewState`](`t:state/0`). + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Generate a float() F with distribution 𝒩 (-3.0, 0.5) +2> {F, S1} = rand:normal_s(-3.0, 0.5, S0). +3> F. +-2.6298211625381906 +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 20.0">>}). -spec normal_s(Mean, Variance, State) -> {X :: float(), NewState :: state()} @@ -1473,6 +1774,19 @@ Shuffle a list. Like `shuffle_s/2` but operates on the state stored in the process dictionary. Returns the shuffled list. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> rand:seed(exsss, 4711). +%% Create a list +2> L = lists:seq($A, $Z). +"ABCDEFGHIJKLMNOPQRSTUVWXYZ" +%% Shuffle the list +3> rand:shuffle(L). +"KRCYQBUXTIWHMEJGFNODAZPSLV" +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 29.0">>}). -spec shuffle(List :: list()) -> ShuffledList :: list(). @@ -1497,6 +1811,20 @@ to initialize the random number generator. Returns the shuffled list [`ShuffledList`](`t:list/0`) and the [`NewState`](`t:state/0`). + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> S0 = rand:seed_s(exsss, 4711). +%% Create a list +2> L0 = lists:seq($A, $Z). +"ABCDEFGHIJKLMNOPQRSTUVWXYZ" +%% Shuffle the list +3> {L1, S1} = rand:shuffle_s(L0, S0). +4> L1. +"KRCYQBUXTIWHMEJGFNODAZPSLV" +``` """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 29.0">>}). -spec shuffle_s(List, State) -> @@ -1863,6 +2191,11 @@ exsss_seed({A1, A2, A3}) -> ?MASK(58, V_b + ?BSL(58, V_b, 3)) % * 9 end). +%% Just noted. Multiplicative inverses: +%% (9 * 16#238e38e38e38e39) band ((1 bsl 58) - 1) == 1 +%% (5 * 16#cccccccccccccd) band ((1 bsl 58) - 1) == 1 + + %% Advance state and generate 58bit unsigned integer %% -dialyzer({no_improper_lists, exsp_next/1}). @@ -1891,12 +2224,22 @@ with a specific [`Seed`](`t:seed/0`). > nor in generating floating point numbers. It is easy to accidentally > mess up the statistical properties of this generator or to loose > the performance advantage when doing either. -> See the recipes at the start of this -> [Niche algorithms API](#niche-algorithms-api) description. +> See the recipes in section [Niche algorithms](#niche-algorithms). > > Note also the caveat about weak low bits that this generator suffers from. > > The generator is exported in this form primarily for performance reasons. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> {_, R0} = rand:seed(exsp, 4711). +%% Generate a 32-bit random integer +2> {X, R1} = rand:exsp_next(R0). +3> V = X bsr (58 - 32). +2183156113 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec exsp_next(AlgState :: exsplus_state()) -> @@ -1996,6 +2339,21 @@ See the description of jump functions at the top of this module description. See `exsp_next/1` about why this internal implementation function has been exposed. + +#### _Shell Example_ + +```erlang +%% Initialize an 'exsp' PRNG +1> {_, Ra0} = rand:seed_s(exsp, 4711). +2> Rb0 = rand:exsp_jump(Ra0). +3> {A1, Ra1} = rand:exsp_next(Ra0). +4> {B1, Rb1} = rand:exsp_next(Rb0). +%% A1 and B1 are the start of two non-overlapping PRNG sequences +5> A1. +146509126700279260 +6> B1. +141632021409309024 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec exsp_jump(AlgState :: exsplus_state()) -> @@ -2592,8 +2950,7 @@ The low bits of the base generator are surprisingly good, so the lowest weaknesses that lie in the high bits of the 32-bit MWC "digit". It is recommended to use `rem` on the the generator state, or bit mask extracting the lowest bits to produce numbers in a range 16 bits or less. -See the recipes at the start of this -[Niche algorithms API](#niche-algorithms-api) description. +See the recipes in section [Niche algorithms](#niche-algorithms). On a typical 64 bit Erlang VM this generator executes in below 8% (1/13) of the time for the default algorithm in the @@ -2611,6 +2968,21 @@ is 60% of the time for the default algorithm generating a `t:float/0`. > is a quality concern, although when used with the value scramblers > it passes strict PRNG tests. The generator is much faster than > `exsp_next/1` but with a bit lower quality and much shorter period. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> CX0 = rand:mwc59_seed(4711). +%% Generate a 16 bit integer +2> CX1 = rand:mwc59(CX0). +3> CX1 band 65535. +7714 +%% Generate an integer 0 .. 999 with not noticeable bias +2> CX2 = rand:mwc59(CX1). +3> CX2 rem 1000. +86 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59(CX0 :: mwc59_state()) -> CX1 :: mwc59_state(). @@ -2644,16 +3016,30 @@ When using this scrambler it is in general better to use the high bits of the value than the low. The lowest 8 bits are of good quality and are passed right through from the base generator. They are combined with the next 8 in the xorshift making the low 16 good quality, but in the range -16..31 bits there are weaker bits that should not become high bits +16 .. 31 bits there are weaker bits that should not become high bits of the generated values. -Therefore it is in general safer to shift out low bits. See the recipes -at the start of this [Niche algorithms API](#niche-algorithms-api) -description. +Therefore it is in general safer to shift out low bits. +See the recipes in section [Niche algorithms](#niche-algorithms). For a non power of 2 range less than about 16 bits (to not get too much bias and to avoid bignums) truncated multiplication can be used, that is: `(Range*V) bsr 32`, which is much faster than using `rem`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> CX0 = rand:mwc59_seed(4711). +%% Generate a 32 bit integer +2> CX1 = rand:mwc59(CX0). +3> rand:mwc59_value32(CX1). +2935831586 +%% Generate an integer 0 .. 999 with not noticeable bias +2> CX2 = rand:mwc59(CX1). +3> (rand:mwc59_value32(CX2) * 1000) bsr 32. +540 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value32(CX :: mwc59_state()) -> V :: 0..?MASK(32). @@ -2672,15 +3058,33 @@ base generator enough that all 59 bits are of very good quality. Be careful to not accidentaly create a bignum when handling the value `V`. It is in general general better to use the high bits from this scrambler than -the low. See the recipes at the start of this -[Niche algorithms API](#niche-algorithms-api) description. +the low. See the recipes in section [Niche algorithms](#niche-algorithms). -For a non power of 2 range less than about 29 bits (to not get +For a non power of 2 range less than about 20 bits (to not get too much bias and to avoid bignums) truncated multiplication can be used, -which is much faster than using `rem`. Example for range 1'000'000'000; -the range is 30 bits, we use 29 bits from the generator, +which is much faster than using `rem`. Example for range 1'000'000; +the range is 20 bits, we use 39 bits from the generator, adding up to 59 bits, which is not a bignum (on a 64-bit VM ): -`(1000000000 * (V bsr (59-29))) bsr 29`. +`(1000_000 * (V bsr (59-39))) bsr 39`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> CX0 = rand:mwc59_seed(4711). +%% Generate a 48 bit integer +2> CX1 = rand:mwc59(CX0). +3> rand:mwc59_value(CX1) bsr (59-48). +247563052677727 +%% Generate an integer 0 .. 1'000'000 with not noticeable bias +4> CX2 = rand:mwc59(CX1). +5> ((rand:mwc59_value(CX2) bsr (59-39)) * 1000_000) bsr 39. +144457 +%% Generate an integer 0 .. 1'000'000'000 with not noticeable bias +4> CX3 = rand:mwc59(CX2). +5> rand:mwc59_value(CX3) rem 1000_000_000. +949193925 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value(CX :: mwc59_state()) -> V :: 0..?MASK(59). @@ -2701,6 +3105,17 @@ in the range `0.0 =< V < 1.0` like for example `uniform_s/1`. The generator state is scrambled as with [`mwc59_value/1`](`mwc59_value/1`) before converted to a `t:float/0`. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> CX0 = rand:mwc59_seed(4711). +%% Generate a float() F in [0.0, 1.0) +2> CX1 = rand:mwc59(CX0). +3> rand:mwc59_float(CX1). +0.28932119128137423 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_float(CX :: mwc59_state()) -> V :: float(). @@ -2710,8 +3125,18 @@ mwc59_float(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> -doc """ Create a [MWC59 generator state](`t:mwc59_state/0`). -Like `mwc59_seed/1` but it hashes the default seed value -of [`seed_s(atom())`](`seed_s/1`). +Like `mwc59_seed/1` but creates a reasonably unpredictable seed +just like [`seed_s(atom())`](`seed_s/1`). + +#### _Shell Example_ + +```erlang +%% Initialize the 'mwc59' PRNG +1> CX0 = rand:mwc59_seed(). +%% Generate an integer 0 .. 999 with not noticeable bias +2> CX1 = rand:mwc59(CX0). +3> CX1 rem 1000. +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_seed() -> CX :: mwc59_state(). @@ -2728,6 +3153,17 @@ Create a [MWC59 generator state](`t:mwc59_state/0`). Returns a generator state [`CX`](`t:mwc59_state/0`). The 58-bit seed value `S` is hashed to create the generator state, to avoid that similar seeds create similar sequences. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> CX0 = rand:mwc59_seed(4711). +%% Generate a 16 bit integer +2> CX1 = rand:mwc59(CX0). +3> CX1 band 65535. +7714 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_seed(S :: 0..?MASK(58)) -> CX :: mwc59_state(). @@ -2835,6 +3271,17 @@ according to the SplitMix64 algorithm. This generator is used internally in the `rand` module for seeding other generators since it is of a quite different breed which reduces the probability for creating an accidentally bad seed. + +#### _Shell Example_ + +```erlang +%% Initialize a predictable PRNG sequence +1> {_, R0} = rand:splitmix64_next(erlang:phash2(4711)). +%% Generate a 64 bit integer +2> {X, R1} = rand:splitmix64_next(R0). +3> X. +8700325640925601664 +``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec splitmix64_next(AlgState :: integer()) -> From 7a0c4af238d7c89e6c351da7ec6d3a70dd554b74 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 18 Nov 2025 15:42:53 +0100 Subject: [PATCH 03/10] Try the speed of mwc59 in particular for shuffle --- lib/stdlib/src/rand.erl | 81 +++++++++++++++++++++++++++++----- lib/stdlib/test/rand_SUITE.erl | 4 +- 2 files changed, 71 insertions(+), 14 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index c0e5157656a7..c69049882e49 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -2056,6 +2056,11 @@ mk_alg(exro928ss) -> uniform_n=>fun exro928ss_uniform/2, jump=>fun exro928_jump/1}, fun exro928_seed/1}; +mk_alg(mwc59) -> + {#{type=>mwc59, bits=>58, next=>fun mwc59_plugin_next/1, + uniform=>fun mwc59_plugin_uniform/1, + uniform_n=>fun mwc59_plugin_uniform/2}, + fun mwc59_plugin_seed/1}; mk_alg(dummy=Name) -> {#{type=>Name, bits=>58, next=>fun dummy_next/1, uniform=>fun dummy_uniform/1, @@ -2986,10 +2991,15 @@ is 60% of the time for the default algorithm generating a `t:float/0`. """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59(CX0 :: mwc59_state()) -> CX1 :: mwc59_state(). +-define( + mwc59(CX, C, X), + begin + C = (CX) bsr ?MWC59_B, + X = ?MASK(?MWC59_B, (CX)), + ?MWC59_A * X + C + end). mwc59(CX) when is_integer(CX), 1 =< CX, CX < ?MWC59_P -> - C = CX bsr ?MWC59_B, - X = ?MASK(?MWC59_B, CX), - ?MWC59_A * X + C. + ?mwc59(CX, C, X). %%% %% Verification by equivalent MCG generator %%% mwc59_r(CX1) -> @@ -3089,10 +3099,10 @@ adding up to 59 bits, which is not a bignum (on a 64-bit VM ): -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value(CX :: mwc59_state()) -> V :: 0..?MASK(59). -define( - mwc59_value(CX0, CX1), + mwc59_value(CX0, Tmp), begin - CX1 = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), - CX1 bxor ?BSL(59, CX1, ?MWC59_XS2) + Tmp = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), + Tmp bxor ?BSL(59, Tmp, ?MWC59_XS2) end). mwc59_value(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> ?mwc59_value(CX0, CX1). @@ -3141,11 +3151,8 @@ just like [`seed_s(atom())`](`seed_s/1`). -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_seed() -> CX :: mwc59_state(). mwc59_seed() -> - {A1, A2, A3} = default_seed(), - X1 = hash58(A1), - X2 = hash58(A2), - X3 = hash58(A3), - (X1 bxor X2 bxor X3) + 1. + mwc59_plugin_seed(default_seed()). + -doc """ Create a [MWC59 generator state](`t:mwc59_state/0`). @@ -3170,6 +3177,57 @@ to avoid that similar seeds create similar sequences. mwc59_seed(S) when is_integer(S), 0 =< S, S =< ?MASK(58) -> hash58(S) + 1. + +%% ------- + +mwc59_plugin_seed([]) -> + erlang:error(zero_seed); +mwc59_plugin_seed([S]) -> + if + is_integer(S) -> + case ?MASK(59, S) of + 0 -> + erlang:error(zero_seed); + R -> + R + end; + true -> + erlang:error(non_integer_seed) + end; +mwc59_plugin_seed([_ | _]) -> + erlang:error(too_many_seed_integers); +%% +mwc59_plugin_seed(S) when is_integer(S) -> + hash58(S) + 1; +%% +mwc59_plugin_seed({A1, A2, A3}) -> + X1 = hash58(A1), + X2 = hash58(A2), + X3 = hash58(A3), + (X1 bxor X2 bxor X3) + 1. + +mwc59_plugin_next(CX0) + when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> + CX1 = ?mwc59(CX0, C, X), + V = ?MASK(58, ?mwc59_value(CX1, Tmp)), + {V, CX1}. + +mwc59_plugin_uniform({AlgHandler, CX0}) + when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> + CX1 = ?mwc59(CX0, C, X), + V = ?MASK(53, ?mwc59_value(CX1, Tmp)) * ?TWO_POW_MINUS53, + {V, {AlgHandler, CX1}}. + +mwc59_plugin_uniform(Range, {AlgHandler, CX0}) + when is_integer(Range), 0 < Range, + is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> + CX1 = ?mwc59(CX0, C, X), + V = ?MASK(58, ?mwc59_value(CX1, Tmp)), + MaxMinusRange = ?BIT(58) - Range, + ?uniform_range(Range, AlgHandler, CX1, V, MaxMinusRange, I). + +%% ------- + %% Constants a'la SplitMix64, MurMurHash, etc. %% Not that critical, just mix the bits using bijections %% (reversible mappings) to not have any two user input seeds @@ -3181,7 +3239,6 @@ hash58(X) -> X2 = ?MASK(58, (X1 bxor (X1 bsr 29)) * 16#0ceb9fe1a85ec53), X2 bxor (X2 bsr 29). - %% ===================================================================== %% Mask and fill state list, ensure not all zeros %% ===================================================================== diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index da40195fb841..1c272985efe6 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -112,7 +112,7 @@ test() -> end, Tests). algs() -> - [exsss, exrop, exsp, exs1024s, exs64, exsplus, exs1024, exro928ss]. + [exsss, exrop, exsp, mwc59, exs1024s, exs64, exsplus, exs1024, exro928ss]. crypto_support() -> try crypto:strong_rand_bytes(1) of @@ -538,7 +538,7 @@ measure_shuffle(Config) when is_list(Config) -> end; measure_shuffle(Effort) when is_integer(Effort) -> Algs = - [exsss, exs1024 | + [exsss, mwc59, exs1024 | case crypto_support() of ok -> [crypto]; _ -> [] From 3ace5c9ba1b815bed2f50c2261f86fc6bc835d91 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 20 Nov 2025 18:15:34 +0100 Subject: [PATCH 04/10] Try dedicated shuffle_mwc59 --- lib/stdlib/src/rand.erl | 80 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index c69049882e49..7fe3226a9d0e 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1832,6 +1832,9 @@ and the [`NewState`](`t:state/0`). when List :: list(), State :: state(). +shuffle_s(List, {#{type:=mwc59} = AlgHandler, CX0}) -> + {ShuffledList, _P1, CX1} = shuffle_s_mwc59(List, CX0), + {ShuffledList, {AlgHandler, CX1}}; shuffle_s(List, {AlgHandler, R0}) when is_list(List) -> [P0|S0] = shuffle_init_bitstream(R0, AlgHandler), @@ -3239,6 +3242,83 @@ hash58(X) -> X2 = ?MASK(58, (X1 bxor (X1 bsr 29)) * 16#0ceb9fe1a85ec53), X2 bxor (X2 bsr 29). +%% ------- + +shuffle_s_mwc59(List, S) -> + shuffle_mwc59_r(List, [], 1, S). + +%% Leaf cases - random permutations for 0..3 elements +shuffle_mwc59_r([], Acc, P, S) -> + {Acc, P, S}; +shuffle_mwc59_r([X], Acc, P, S) -> + {[X | Acc], P, S}; +shuffle_mwc59_r([X, Y], Acc, P, S) -> + shuffle_mwc59_r_2(X, Acc, P, S, Y); +shuffle_mwc59_r([X, Y, Z], Acc, P, S) -> + shuffle_mwc59_r_3(X, Acc, P, S, Y, Z); +%% General case - split and recursive shuffle +shuffle_mwc59_r([_, _, _ | _] = List, Acc, P, S) -> + %% P and S is bitstream cache and state + shuffle_mwc59_r(List, Acc, P, S, [], [], [], []). +%% +%% Split L into 4 random subsets +%% +shuffle_mwc59_r([], Acc0, P0, S0, Zero, One, Two, Three) -> + %% Split done, recursively shuffle the splitted lists onto Acc + {Acc1, P1, S1} = shuffle_mwc59_r(Zero, Acc0, P0, S0), + {Acc2, P2, S2} = shuffle_mwc59_r(One, Acc1, P1, S1), + {Acc3, P3, S3} = shuffle_mwc59_r(Two, Acc2, P2, S2), + shuffle_mwc59_r(Three, Acc3, P3, S3); +shuffle_mwc59_r([X | L], Acc, P0, S, Zero, One, Two, Three) + when is_integer(P0), 3 < P0, P0 =< ?MASK(59) -> + P1 = P0 bsr 2, + case P0 band 3 of + 0 -> shuffle_mwc59_r(L, Acc, P1, S, [X | Zero], One, Two, Three); + 1 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, [X | One], Two, Three); + 2 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, One, [X | Two], Three); + 3 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, One, Two, [X | Three]) + end; +shuffle_mwc59_r([_ | _] = L, Acc, _P, S0, Zero, One, Two, Three) -> + S1 = ?mwc59(S0, C, D), + P = ?mwc59_value(S1, Tmp) bor ?BIT(58), + shuffle_mwc59_r(L, Acc, P, S1, Zero, One, Two, Three). + +%% Permute 2 elements +shuffle_mwc59_r_2(X, Acc, P, S, Y) + when is_integer(P), 1 < P, P =< ?MASK(59) -> + {case P band 1 of + 0 -> [Y, X | Acc]; + 1 -> [X, Y | Acc] + end, P bsr 1, S}; +shuffle_mwc59_r_2(X, Acc, _P, S0, Y) -> + S1 = ?mwc59(S0, C, D), + P = ?mwc59_value(S1, Tmp) bor ?BIT(58), + shuffle_mwc59_r_2(X, Acc, P, S1, Y). + +%% Permute 3 elements +%% +%% Uses 3 random bits per iteration with a probability of 1/4 +%% to reject and retry, which on average is 3 * 4/3 +%% (infinite sum of (1/4)^k) = 4 bits per permutation +shuffle_mwc59_r_3(X, Acc, P0, S, Y, Z) + when is_integer(P0), 7 < P0, P0 =< ?MASK(59) -> + P1 = P0 bsr 3, + case P0 band 7 of + 0 -> {[Z, Y, X | Acc], P1, S}; + 1 -> {[Y, Z, X | Acc], P1, S}; + 2 -> {[Z, X, Y | Acc], P1, S}; + 3 -> {[X, Z, Y | Acc], P1, S}; + 4 -> {[Y, X, Z | Acc], P1, S}; + 5 -> {[X, Y, Z | Acc], P1, S}; + _ -> % Reject and retry + shuffle_mwc59_r_3(X, Acc, P1, S, Y, Z) + end; +shuffle_mwc59_r_3(X, Acc, _P, S0, Y, Z) -> + S1 = ?mwc59(S0, C, D), + P = ?mwc59_value(S1, Tmp) bor ?BIT(58), + shuffle_mwc59_r_3(X, Acc, P, S1, Y, Z). + + %% ===================================================================== %% Mask and fill state list, ensure not all zeros %% ===================================================================== From 5dd78a11dc8c932645215cd5ae042c2486cedf44 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 24 Nov 2025 10:52:53 +0100 Subject: [PATCH 05/10] Try dedicated shuffle_exsss --- lib/stdlib/src/rand.erl | 83 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 7fe3226a9d0e..3bf6b1ae7743 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1832,6 +1832,9 @@ and the [`NewState`](`t:state/0`). when List :: list(), State :: state(). +shuffle_s(List, {#{type:=exsss} = AlgHandler, S}) -> + {ShuffledList, _P1, NewS} = shuffle_s_exsss(List, S), + {ShuffledList, {AlgHandler, NewS}}; shuffle_s(List, {#{type:=mwc59} = AlgHandler, CX0}) -> {ShuffledList, _P1, CX1} = shuffle_s_mwc59(List, CX0), {ShuffledList, {AlgHandler, CX1}}; @@ -2384,6 +2387,86 @@ exsplus_jump(S, [AS0|AS1], J, N) -> exsplus_jump(NS, [AS0|AS1], J bsr 1, N-1) end. +%% ------- + +shuffle_s_exsss(List, S) -> + shuffle_exsss_r(List, [], 1, S). + +%% Leaf cases - random permutations for 0..3 elements +shuffle_exsss_r([], Acc, P, S) -> + {Acc, P, S}; +shuffle_exsss_r([X], Acc, P, S) -> + {[X | Acc], P, S}; +shuffle_exsss_r([X, Y], Acc, P, S) -> + shuffle_exsss_r_2(X, Acc, P, S, Y); +shuffle_exsss_r([X, Y, Z], Acc, P, S) -> + shuffle_exsss_r_3(X, Acc, P, S, Y, Z); +%% General case - split and recursive shuffle +shuffle_exsss_r([_, _, _ | _] = List, Acc, P, S) -> + %% P and S is bitstream cache and state + shuffle_exsss_r(List, Acc, P, S, [], [], [], []). +%% +%% Split L into 4 random subsets +%% +shuffle_exsss_r([], Acc0, P0, S0, Zero, One, Two, Three) -> + %% Split done, recursively shuffle the splitted lists onto Acc + {Acc1, P1, S1} = shuffle_exsss_r(Zero, Acc0, P0, S0), + {Acc2, P2, S2} = shuffle_exsss_r(One, Acc1, P1, S1), + {Acc3, P3, S3} = shuffle_exsss_r(Two, Acc2, P2, S2), + shuffle_exsss_r(Three, Acc3, P3, S3); +shuffle_exsss_r([X | L], Acc, P0, S, Zero, One, Two, Three) + when is_integer(P0), 3 < P0, P0 =< ?MASK(59) -> + P1 = P0 bsr 2, + case P0 band 3 of + 0 -> shuffle_exsss_r(L, Acc, P1, S, [X | Zero], One, Two, Three); + 1 -> shuffle_exsss_r(L, Acc, P1, S, Zero, [X | One], Two, Three); + 2 -> shuffle_exsss_r(L, Acc, P1, S, Zero, One, [X | Two], Three); + 3 -> shuffle_exsss_r(L, Acc, P1, S, Zero, One, Two, [X | Three]) + end; +shuffle_exsss_r([_ | _] = L, Acc, _P, [S1|S0], Zero, One, Two, Three) -> + S0_1 = ?MASK(58, S0), + S1_1 = ?exs_next(S0_1, S1, Tmp1), + P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), + shuffle_exsss_r(L, Acc, P, [S0_1|S1_1], Zero, One, Two, Three). + +%% Permute 2 elements +shuffle_exsss_r_2(X, Acc, P, S, Y) + when is_integer(P), 1 < P, P =< ?MASK(59) -> + {case P band 1 of + 0 -> [Y, X | Acc]; + 1 -> [X, Y | Acc] + end, P bsr 1, S}; +shuffle_exsss_r_2(X, Acc, _P, [S1|S0], Y) -> + S0_1 = ?MASK(58, S0), + S1_1 = ?exs_next(S0_1, S1, Tmp1), + P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), + shuffle_exsss_r_2(X, Acc, P, [S0_1|S1_1], Y). + +%% Permute 3 elements +%% +%% Uses 3 random bits per iteration with a probability of 1/4 +%% to reject and retry, which on average is 3 * 4/3 +%% (infinite sum of (1/4)^k) = 4 bits per permutation +shuffle_exsss_r_3(X, Acc, P0, S, Y, Z) + when is_integer(P0), 7 < P0, P0 =< ?MASK(59) -> + P1 = P0 bsr 3, + case P0 band 7 of + 0 -> {[Z, Y, X | Acc], P1, S}; + 1 -> {[Y, Z, X | Acc], P1, S}; + 2 -> {[Z, X, Y | Acc], P1, S}; + 3 -> {[X, Z, Y | Acc], P1, S}; + 4 -> {[Y, X, Z | Acc], P1, S}; + 5 -> {[X, Y, Z | Acc], P1, S}; + _ -> % Reject and retry + shuffle_exsss_r_3(X, Acc, P1, S, Y, Z) + end; +shuffle_exsss_r_3(X, Acc, _P, [S1|S0], Y, Z) -> + S0_1 = ?MASK(58, S0), + S1_1 = ?exs_next(S0_1, S1, Tmp1), + P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), + shuffle_exsss_r_3(X, Acc, P, [S0_1|S1_1], Y, Z). + + %% ===================================================================== %% exs1024 PRNG: Xorshift1024* %% Algorithm by Sebastiano Vigna From 36ec9857386ef628e4e6f65c0500e72ea562a513 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 24 Nov 2025 15:44:57 +0100 Subject: [PATCH 06/10] Revert "Try dedicated shuffle_exsss" This reverts commit 5dd78a11dc8c932645215cd5ae042c2486cedf44. --- lib/stdlib/src/rand.erl | 83 ----------------------------------------- 1 file changed, 83 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 3bf6b1ae7743..7fe3226a9d0e 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1832,9 +1832,6 @@ and the [`NewState`](`t:state/0`). when List :: list(), State :: state(). -shuffle_s(List, {#{type:=exsss} = AlgHandler, S}) -> - {ShuffledList, _P1, NewS} = shuffle_s_exsss(List, S), - {ShuffledList, {AlgHandler, NewS}}; shuffle_s(List, {#{type:=mwc59} = AlgHandler, CX0}) -> {ShuffledList, _P1, CX1} = shuffle_s_mwc59(List, CX0), {ShuffledList, {AlgHandler, CX1}}; @@ -2387,86 +2384,6 @@ exsplus_jump(S, [AS0|AS1], J, N) -> exsplus_jump(NS, [AS0|AS1], J bsr 1, N-1) end. -%% ------- - -shuffle_s_exsss(List, S) -> - shuffle_exsss_r(List, [], 1, S). - -%% Leaf cases - random permutations for 0..3 elements -shuffle_exsss_r([], Acc, P, S) -> - {Acc, P, S}; -shuffle_exsss_r([X], Acc, P, S) -> - {[X | Acc], P, S}; -shuffle_exsss_r([X, Y], Acc, P, S) -> - shuffle_exsss_r_2(X, Acc, P, S, Y); -shuffle_exsss_r([X, Y, Z], Acc, P, S) -> - shuffle_exsss_r_3(X, Acc, P, S, Y, Z); -%% General case - split and recursive shuffle -shuffle_exsss_r([_, _, _ | _] = List, Acc, P, S) -> - %% P and S is bitstream cache and state - shuffle_exsss_r(List, Acc, P, S, [], [], [], []). -%% -%% Split L into 4 random subsets -%% -shuffle_exsss_r([], Acc0, P0, S0, Zero, One, Two, Three) -> - %% Split done, recursively shuffle the splitted lists onto Acc - {Acc1, P1, S1} = shuffle_exsss_r(Zero, Acc0, P0, S0), - {Acc2, P2, S2} = shuffle_exsss_r(One, Acc1, P1, S1), - {Acc3, P3, S3} = shuffle_exsss_r(Two, Acc2, P2, S2), - shuffle_exsss_r(Three, Acc3, P3, S3); -shuffle_exsss_r([X | L], Acc, P0, S, Zero, One, Two, Three) - when is_integer(P0), 3 < P0, P0 =< ?MASK(59) -> - P1 = P0 bsr 2, - case P0 band 3 of - 0 -> shuffle_exsss_r(L, Acc, P1, S, [X | Zero], One, Two, Three); - 1 -> shuffle_exsss_r(L, Acc, P1, S, Zero, [X | One], Two, Three); - 2 -> shuffle_exsss_r(L, Acc, P1, S, Zero, One, [X | Two], Three); - 3 -> shuffle_exsss_r(L, Acc, P1, S, Zero, One, Two, [X | Three]) - end; -shuffle_exsss_r([_ | _] = L, Acc, _P, [S1|S0], Zero, One, Two, Three) -> - S0_1 = ?MASK(58, S0), - S1_1 = ?exs_next(S0_1, S1, Tmp1), - P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), - shuffle_exsss_r(L, Acc, P, [S0_1|S1_1], Zero, One, Two, Three). - -%% Permute 2 elements -shuffle_exsss_r_2(X, Acc, P, S, Y) - when is_integer(P), 1 < P, P =< ?MASK(59) -> - {case P band 1 of - 0 -> [Y, X | Acc]; - 1 -> [X, Y | Acc] - end, P bsr 1, S}; -shuffle_exsss_r_2(X, Acc, _P, [S1|S0], Y) -> - S0_1 = ?MASK(58, S0), - S1_1 = ?exs_next(S0_1, S1, Tmp1), - P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), - shuffle_exsss_r_2(X, Acc, P, [S0_1|S1_1], Y). - -%% Permute 3 elements -%% -%% Uses 3 random bits per iteration with a probability of 1/4 -%% to reject and retry, which on average is 3 * 4/3 -%% (infinite sum of (1/4)^k) = 4 bits per permutation -shuffle_exsss_r_3(X, Acc, P0, S, Y, Z) - when is_integer(P0), 7 < P0, P0 =< ?MASK(59) -> - P1 = P0 bsr 3, - case P0 band 7 of - 0 -> {[Z, Y, X | Acc], P1, S}; - 1 -> {[Y, Z, X | Acc], P1, S}; - 2 -> {[Z, X, Y | Acc], P1, S}; - 3 -> {[X, Z, Y | Acc], P1, S}; - 4 -> {[Y, X, Z | Acc], P1, S}; - 5 -> {[X, Y, Z | Acc], P1, S}; - _ -> % Reject and retry - shuffle_exsss_r_3(X, Acc, P1, S, Y, Z) - end; -shuffle_exsss_r_3(X, Acc, _P, [S1|S0], Y, Z) -> - S0_1 = ?MASK(58, S0), - S1_1 = ?exs_next(S0_1, S1, Tmp1), - P = ?scramble_starstar(S0_1, Tmp2, Tmp3) bor ?BIT(58), - shuffle_exsss_r_3(X, Acc, P, [S0_1|S1_1], Y, Z). - - %% ===================================================================== %% exs1024 PRNG: Xorshift1024* %% Algorithm by Sebastiano Vigna From c879505ff30670adfea60724df273e18616e3c06 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 24 Nov 2025 15:45:06 +0100 Subject: [PATCH 07/10] Revert "Try dedicated shuffle_mwc59" This reverts commit 3ace5c9ba1b815bed2f50c2261f86fc6bc835d91. --- lib/stdlib/src/rand.erl | 80 ----------------------------------------- 1 file changed, 80 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 7fe3226a9d0e..c69049882e49 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1832,9 +1832,6 @@ and the [`NewState`](`t:state/0`). when List :: list(), State :: state(). -shuffle_s(List, {#{type:=mwc59} = AlgHandler, CX0}) -> - {ShuffledList, _P1, CX1} = shuffle_s_mwc59(List, CX0), - {ShuffledList, {AlgHandler, CX1}}; shuffle_s(List, {AlgHandler, R0}) when is_list(List) -> [P0|S0] = shuffle_init_bitstream(R0, AlgHandler), @@ -3242,83 +3239,6 @@ hash58(X) -> X2 = ?MASK(58, (X1 bxor (X1 bsr 29)) * 16#0ceb9fe1a85ec53), X2 bxor (X2 bsr 29). -%% ------- - -shuffle_s_mwc59(List, S) -> - shuffle_mwc59_r(List, [], 1, S). - -%% Leaf cases - random permutations for 0..3 elements -shuffle_mwc59_r([], Acc, P, S) -> - {Acc, P, S}; -shuffle_mwc59_r([X], Acc, P, S) -> - {[X | Acc], P, S}; -shuffle_mwc59_r([X, Y], Acc, P, S) -> - shuffle_mwc59_r_2(X, Acc, P, S, Y); -shuffle_mwc59_r([X, Y, Z], Acc, P, S) -> - shuffle_mwc59_r_3(X, Acc, P, S, Y, Z); -%% General case - split and recursive shuffle -shuffle_mwc59_r([_, _, _ | _] = List, Acc, P, S) -> - %% P and S is bitstream cache and state - shuffle_mwc59_r(List, Acc, P, S, [], [], [], []). -%% -%% Split L into 4 random subsets -%% -shuffle_mwc59_r([], Acc0, P0, S0, Zero, One, Two, Three) -> - %% Split done, recursively shuffle the splitted lists onto Acc - {Acc1, P1, S1} = shuffle_mwc59_r(Zero, Acc0, P0, S0), - {Acc2, P2, S2} = shuffle_mwc59_r(One, Acc1, P1, S1), - {Acc3, P3, S3} = shuffle_mwc59_r(Two, Acc2, P2, S2), - shuffle_mwc59_r(Three, Acc3, P3, S3); -shuffle_mwc59_r([X | L], Acc, P0, S, Zero, One, Two, Three) - when is_integer(P0), 3 < P0, P0 =< ?MASK(59) -> - P1 = P0 bsr 2, - case P0 band 3 of - 0 -> shuffle_mwc59_r(L, Acc, P1, S, [X | Zero], One, Two, Three); - 1 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, [X | One], Two, Three); - 2 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, One, [X | Two], Three); - 3 -> shuffle_mwc59_r(L, Acc, P1, S, Zero, One, Two, [X | Three]) - end; -shuffle_mwc59_r([_ | _] = L, Acc, _P, S0, Zero, One, Two, Three) -> - S1 = ?mwc59(S0, C, D), - P = ?mwc59_value(S1, Tmp) bor ?BIT(58), - shuffle_mwc59_r(L, Acc, P, S1, Zero, One, Two, Three). - -%% Permute 2 elements -shuffle_mwc59_r_2(X, Acc, P, S, Y) - when is_integer(P), 1 < P, P =< ?MASK(59) -> - {case P band 1 of - 0 -> [Y, X | Acc]; - 1 -> [X, Y | Acc] - end, P bsr 1, S}; -shuffle_mwc59_r_2(X, Acc, _P, S0, Y) -> - S1 = ?mwc59(S0, C, D), - P = ?mwc59_value(S1, Tmp) bor ?BIT(58), - shuffle_mwc59_r_2(X, Acc, P, S1, Y). - -%% Permute 3 elements -%% -%% Uses 3 random bits per iteration with a probability of 1/4 -%% to reject and retry, which on average is 3 * 4/3 -%% (infinite sum of (1/4)^k) = 4 bits per permutation -shuffle_mwc59_r_3(X, Acc, P0, S, Y, Z) - when is_integer(P0), 7 < P0, P0 =< ?MASK(59) -> - P1 = P0 bsr 3, - case P0 band 7 of - 0 -> {[Z, Y, X | Acc], P1, S}; - 1 -> {[Y, Z, X | Acc], P1, S}; - 2 -> {[Z, X, Y | Acc], P1, S}; - 3 -> {[X, Z, Y | Acc], P1, S}; - 4 -> {[Y, X, Z | Acc], P1, S}; - 5 -> {[X, Y, Z | Acc], P1, S}; - _ -> % Reject and retry - shuffle_mwc59_r_3(X, Acc, P1, S, Y, Z) - end; -shuffle_mwc59_r_3(X, Acc, _P, S0, Y, Z) -> - S1 = ?mwc59(S0, C, D), - P = ?mwc59_value(S1, Tmp) bor ?BIT(58), - shuffle_mwc59_r_3(X, Acc, P, S1, Y, Z). - - %% ===================================================================== %% Mask and fill state list, ensure not all zeros %% ===================================================================== From ac2129fc61eefef2dc7d6271640e692fee3d8a6d Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 24 Nov 2025 15:45:10 +0100 Subject: [PATCH 08/10] Revert "Try the speed of mwc59 in particular for shuffle" This reverts commit 7a0c4af238d7c89e6c351da7ec6d3a70dd554b74. --- lib/stdlib/src/rand.erl | 81 +++++----------------------------- lib/stdlib/test/rand_SUITE.erl | 4 +- 2 files changed, 14 insertions(+), 71 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index c69049882e49..c0e5157656a7 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -2056,11 +2056,6 @@ mk_alg(exro928ss) -> uniform_n=>fun exro928ss_uniform/2, jump=>fun exro928_jump/1}, fun exro928_seed/1}; -mk_alg(mwc59) -> - {#{type=>mwc59, bits=>58, next=>fun mwc59_plugin_next/1, - uniform=>fun mwc59_plugin_uniform/1, - uniform_n=>fun mwc59_plugin_uniform/2}, - fun mwc59_plugin_seed/1}; mk_alg(dummy=Name) -> {#{type=>Name, bits=>58, next=>fun dummy_next/1, uniform=>fun dummy_uniform/1, @@ -2991,15 +2986,10 @@ is 60% of the time for the default algorithm generating a `t:float/0`. """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59(CX0 :: mwc59_state()) -> CX1 :: mwc59_state(). --define( - mwc59(CX, C, X), - begin - C = (CX) bsr ?MWC59_B, - X = ?MASK(?MWC59_B, (CX)), - ?MWC59_A * X + C - end). mwc59(CX) when is_integer(CX), 1 =< CX, CX < ?MWC59_P -> - ?mwc59(CX, C, X). + C = CX bsr ?MWC59_B, + X = ?MASK(?MWC59_B, CX), + ?MWC59_A * X + C. %%% %% Verification by equivalent MCG generator %%% mwc59_r(CX1) -> @@ -3099,10 +3089,10 @@ adding up to 59 bits, which is not a bignum (on a 64-bit VM ): -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value(CX :: mwc59_state()) -> V :: 0..?MASK(59). -define( - mwc59_value(CX0, Tmp), + mwc59_value(CX0, CX1), begin - Tmp = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), - Tmp bxor ?BSL(59, Tmp, ?MWC59_XS2) + CX1 = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), + CX1 bxor ?BSL(59, CX1, ?MWC59_XS2) end). mwc59_value(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> ?mwc59_value(CX0, CX1). @@ -3151,8 +3141,11 @@ just like [`seed_s(atom())`](`seed_s/1`). -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_seed() -> CX :: mwc59_state(). mwc59_seed() -> - mwc59_plugin_seed(default_seed()). - + {A1, A2, A3} = default_seed(), + X1 = hash58(A1), + X2 = hash58(A2), + X3 = hash58(A3), + (X1 bxor X2 bxor X3) + 1. -doc """ Create a [MWC59 generator state](`t:mwc59_state/0`). @@ -3177,57 +3170,6 @@ to avoid that similar seeds create similar sequences. mwc59_seed(S) when is_integer(S), 0 =< S, S =< ?MASK(58) -> hash58(S) + 1. - -%% ------- - -mwc59_plugin_seed([]) -> - erlang:error(zero_seed); -mwc59_plugin_seed([S]) -> - if - is_integer(S) -> - case ?MASK(59, S) of - 0 -> - erlang:error(zero_seed); - R -> - R - end; - true -> - erlang:error(non_integer_seed) - end; -mwc59_plugin_seed([_ | _]) -> - erlang:error(too_many_seed_integers); -%% -mwc59_plugin_seed(S) when is_integer(S) -> - hash58(S) + 1; -%% -mwc59_plugin_seed({A1, A2, A3}) -> - X1 = hash58(A1), - X2 = hash58(A2), - X3 = hash58(A3), - (X1 bxor X2 bxor X3) + 1. - -mwc59_plugin_next(CX0) - when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> - CX1 = ?mwc59(CX0, C, X), - V = ?MASK(58, ?mwc59_value(CX1, Tmp)), - {V, CX1}. - -mwc59_plugin_uniform({AlgHandler, CX0}) - when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> - CX1 = ?mwc59(CX0, C, X), - V = ?MASK(53, ?mwc59_value(CX1, Tmp)) * ?TWO_POW_MINUS53, - {V, {AlgHandler, CX1}}. - -mwc59_plugin_uniform(Range, {AlgHandler, CX0}) - when is_integer(Range), 0 < Range, - is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> - CX1 = ?mwc59(CX0, C, X), - V = ?MASK(58, ?mwc59_value(CX1, Tmp)), - MaxMinusRange = ?BIT(58) - Range, - ?uniform_range(Range, AlgHandler, CX1, V, MaxMinusRange, I). - -%% ------- - %% Constants a'la SplitMix64, MurMurHash, etc. %% Not that critical, just mix the bits using bijections %% (reversible mappings) to not have any two user input seeds @@ -3239,6 +3181,7 @@ hash58(X) -> X2 = ?MASK(58, (X1 bxor (X1 bsr 29)) * 16#0ceb9fe1a85ec53), X2 bxor (X2 bsr 29). + %% ===================================================================== %% Mask and fill state list, ensure not all zeros %% ===================================================================== diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 1c272985efe6..da40195fb841 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -112,7 +112,7 @@ test() -> end, Tests). algs() -> - [exsss, exrop, exsp, mwc59, exs1024s, exs64, exsplus, exs1024, exro928ss]. + [exsss, exrop, exsp, exs1024s, exs64, exsplus, exs1024, exro928ss]. crypto_support() -> try crypto:strong_rand_bytes(1) of @@ -538,7 +538,7 @@ measure_shuffle(Config) when is_list(Config) -> end; measure_shuffle(Effort) when is_integer(Effort) -> Algs = - [exsss, mwc59, exs1024 | + [exsss, exs1024 | case crypto_support() of ok -> [crypto]; _ -> [] From 62c2a75624d116a85d4538f53de977b5fcd0decc Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 25 Nov 2025 10:39:43 +0100 Subject: [PATCH 09/10] Update after feedback --- lib/stdlib/src/rand.erl | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index c0e5157656a7..aea61daeb959 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -338,11 +338,15 @@ The current _default algorithm_ is [`exsss` (Xorshift116\*\*)](#algorithms). If a specific algorithm is required, ensure to always use `seed/1` to initialize the state. -Which algorithm that is the default may change between Erlang/OTP releases, -and is selected to be one with high speed, small state and "good enough" -statistical properties. So to ensure that the same sequence is reproduced -on a later Erlang/OTP release, use a `seed/2` or `seed_s/2` to select -both a specific algorithm and the seed value. +In many API functions in this module, the atom `default` can be used +instead of an algorithm name, and is currently an alias for `exsss`. +In a future Erlang/OTP release this might be a different algorithm. +The _default algorithm_ is selected to be one with high speed, +small state and "good enough" statistical properties. + +If it is essential to reproduce the same PRNG sequence +on a later Erlang/OTP release, use `seed/2` or `seed_s/2` +to select *both* a specific algorithm and the seed value. #### Old Algorithms @@ -956,7 +960,7 @@ that has been implemented *(Since OTP 24.0)*. > #### Note {: .info } > > Using `Alg = default` is *not* perfectly predictable since -> which algorithm that is the default may change in a future +>`default` may be an alias for a different algorithm in a future > OTP release. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). @@ -985,7 +989,7 @@ that has been implemented *since OTP 24.0*. > #### Note {: .info } > > Using `Alg = default` is *not* perfectly predictable since -> which algorithm that is the default may change in a future +>`default` may be an alias for a different algorithm in a future > OTP release. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). @@ -1928,7 +1932,7 @@ shuffle_r([], Acc0, P0, S0, Zero, One, Two, Three) -> {Acc3, P3, S3} = shuffle_r(Two, Acc2, P2, S2), shuffle_r(Three, Acc3, P3, S3); shuffle_r([X | L], Acc, P0, S, Zero, One, Two, Three) - when is_integer(P0), ?BIT(2) =< P0, P0 =< ?MASK(59) -> + when is_integer(P0, ?BIT(2), ?MASK(59)) -> P1 = P0 bsr 2, case ?MASK(2, P0) of 0 -> shuffle_r(L, Acc, P1, S, [X | Zero], One, Two, Three); @@ -1942,7 +1946,7 @@ shuffle_r([_ | _] = L, Acc, _P, S0, Zero, One, Two, Three) -> %% Permute 2 elements shuffle_r_2(X, Acc, P, S, Y) - when is_integer(P), ?BIT(1) =< P, P =< ?MASK(59) -> + when is_integer(P, ?BIT(1), ?MASK(59)) -> {case ?MASK(1, P) of 0 -> [Y, X | Acc]; 1 -> [X, Y | Acc] @@ -1957,7 +1961,7 @@ shuffle_r_2(X, Acc, _P, S0, Y) -> %% to reject and retry, which on average is 3 * 4/3 %% (infinite sum of (1/4)^k) = 4 bits per permutation shuffle_r_3(X, Acc, P0, S, Y, Z) - when is_integer(P0), ?BIT(3) =< P0, P0 =< ?MASK(59) -> + when is_integer(P0, ?BIT(3), ?MASK(59)) -> P1 = P0 bsr 3, case ?MASK(3, P0) of 0 -> {[Z, Y, X | Acc], P1, S}; @@ -1994,8 +1998,7 @@ shuffle_init_bitstream(R, Next, Shift, Mask0) -> -dialyzer({no_improper_lists, shuffle_new_bits/1}). %% shuffle_new_bits([R0|{Next,Shift,Mask}=W]) - when is_integer(Shift), 0 =< Shift, Shift =< 3, - is_integer(Mask), 0 < Mask, Mask =< ?MASK(58) -> + when is_integer(Shift, 0, 3), is_integer(Mask, 0, ?MASK(58)) -> case Next(R0) of {V, R1} when is_integer(V) -> %% Setting the top bit here provides the marker @@ -2986,7 +2989,7 @@ is 60% of the time for the default algorithm generating a `t:float/0`. """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59(CX0 :: mwc59_state()) -> CX1 :: mwc59_state(). -mwc59(CX) when is_integer(CX), 1 =< CX, CX < ?MWC59_P -> +mwc59(CX) when is_integer(CX, 1, ?MWC59_P-1) -> C = CX bsr ?MWC59_B, X = ?MASK(?MWC59_B, CX), ?MWC59_A * X + C. @@ -3043,7 +3046,7 @@ that is: `(Range*V) bsr 32`, which is much faster than using `rem`. """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value32(CX :: mwc59_state()) -> V :: 0..?MASK(32). -mwc59_value32(CX1) when is_integer(CX1), 1 =< CX1, CX1 < ?MWC59_P -> +mwc59_value32(CX1) when is_integer(CX1, 1, ?MWC59_P-1) -> CX = ?MASK(32, CX1), CX bxor ?BSL(32, CX, ?MWC59_XS). @@ -3094,7 +3097,7 @@ adding up to 59 bits, which is not a bignum (on a 64-bit VM ): CX1 = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), CX1 bxor ?BSL(59, CX1, ?MWC59_XS2) end). -mwc59_value(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> +mwc59_value(CX0) when is_integer(CX0, 1, ?MWC59_P-1) -> ?mwc59_value(CX0, CX1). -doc """ @@ -3119,7 +3122,7 @@ The generator state is scrambled as with """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_float(CX :: mwc59_state()) -> V :: float(). -mwc59_float(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> +mwc59_float(CX0) when is_integer(CX0, 1, ?MWC59_P-1) -> ?MASK(53, ?mwc59_value(CX0, CX1)) * ?TWO_POW_MINUS53. -doc """ @@ -3167,7 +3170,7 @@ to avoid that similar seeds create similar sequences. """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_seed(S :: 0..?MASK(58)) -> CX :: mwc59_state(). -mwc59_seed(S) when is_integer(S), 0 =< S, S =< ?MASK(58) -> +mwc59_seed(S) when is_integer(S, 0, ?MASK(58)) -> hash58(S) + 1. %% Constants a'la SplitMix64, MurMurHash, etc. From d8bb3ccbd3ad2ca195b0d555761f7a4e8da8129e Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 26 Nov 2025 13:47:04 +0100 Subject: [PATCH 10/10] Update after feedback --- lib/stdlib/src/rand.erl | 84 ++++++++++++++++++++--------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index aea61daeb959..a6b6b3fae032 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -431,7 +431,7 @@ the generator's range: [](){: #modulo-method } - **Modulo** - To generate a number `V` in the range `0 .. Range-1`: + To generate a number `V` in the range `0 .. Range-1`: > Generate a number `X`. > Use `V = X rem Range` as your value. @@ -447,12 +447,12 @@ the generator's range: have a bias. Example: Say the generator generates a byte, that is, the generator range - is `0 .. 255`, and the desired range is `0 .. 99` (`Range = 100`). + is `0 .. 255`, and the desired range is `0 .. 99` (`Range = 100`). Then there are 3 generator outputs that produce the value `0`, - these are; `0`, `100` and `200`. + these are `0`, `100` and `200`. But there are only 2 generator outputs that produce the value `99`, - which are; `99` and `199`. So the probability for a value `V` in `0 .. 55` - is 3/2 times the probability for the other values `56 .. 99`. + which are `99` and `199`. So the probability for a value `V` in `0 .. 55` + is 3/2 times the probability for the other values `56 .. 99`. If `Range` is much smaller than the generator range, then this bias gets hard to detect. The rule of thumb is that if `Range` is smaller @@ -468,8 +468,8 @@ the generator's range: [](){: #truncated-multiplication-method } - **Truncated multiplication** - To generate a number `V` in the range `0 .. Range-1`, when you have - a generator with a power of 2 range (`0 .. 2^Bits-1`): + To generate a number `V` in the range `0 .. Range-1`, when you have + a generator with a power of 2 range (`0 .. 2^Bits-1`): > Generate a number `X`. > Use `V = X * Range bsr Bits` as your value. @@ -486,8 +486,8 @@ the generator's range: [](){: #shift-or-mask-method } - **Shift or mask** - To generate a number in a power of 2 range (`0 .. 2^RBits-1`), - when you have a generator with a power of 2 range (`0 .. 2^Bits`): + To generate a number in a power of 2 range (`0 .. 2^RBits-1`), + when you have a generator with a power of 2 range (`0 .. 2^Bits`): > Generate a number `X`. > Use `V = X band ((1 bsl RBits)-1)` or `V = X bsr (Bits-RBits)` @@ -525,7 +525,7 @@ will not create a bignum. The recommended way to generate a floating point number (IEEE 745 Double, that has got a 53-bit mantissa) in the range -`0 .. 1`, that is `0.0 =< V < 1.0` is to generate a 53-bit number `X` +`0 .. 1`, that is `0.0 =< V < 1.0` is to generate a 53-bit number `X` and then use `V = X * (1.0/((1 bsl 53)))` as your value. This will create a value of the form N*2^-53 with equal probability for every possible N for the range. @@ -595,9 +595,9 @@ for every possible N for the range. %% Types %% ===================================================================== --doc "`0 .. (2^64 - 1)`". +-doc "`0 .. (2^64 - 1)`". -type uint64() :: 0..?MASK(64). --doc "`0 .. (2^58 - 1)`". +-doc "`0 .. (2^58 - 1)`". -type uint58() :: 0..?MASK(58). %% This depends on the algorithm handler function @@ -613,7 +613,7 @@ for every possible N for the range. %% %% The 'bits' field indicates how many bits the integer %% returned from 'next' has got, i.e 'next' shall return -%% an random integer in the range 0..(2^Bits - 1). +%% an random integer in the range 0 .. (2^Bits - 1). %% At least 55 bits is required for the floating point %% producing fallbacks, but 56 bits would be more future proof. %% @@ -784,17 +784,17 @@ To be used with `seed/1`. 1> S = rand:seed(exsss, 4711). %% Export the (initial) state 2> E = rand:export_seed(). -%% Generate an integer N in the interval 1 .. 1000000 -3> rand:uniform(1000000). +%% Generate an integer N in the interval 1 .. 1_000_000 +3> rand:uniform(1_000_000). 334013 %% Start over with E that may have been stored %% in ETS, on file, etc... 4> rand:seed(E). -5> rand:uniform(1000000). +5> rand:uniform(1_000_000). 334013 %% Within the same node this works just as well 6> rand:seed(S). -7> rand:uniform(1000000). +7> rand:uniform(1_000_000). 334013 ``` """. @@ -819,20 +819,20 @@ To be used with `seed/1`. 1> S0 = rand:seed_s(exsss, 4711). %% Export the (initial) state 2> E = rand:export_seed_s(S0). -%% Generate an integer N in the interval 1 .. 1000000 -3> {N, S1} = rand:uniform_s(1000000, S0). +%% Generate an integer N in the interval 1 .. 1_000_000 +3> {N, S1} = rand:uniform_s(1_000_000, S0). 4> N. 334013 %% Start over with E that may have been stored %% in ETS, on file, etc... 5> S2 = rand:seed_s(E). %% S2 is equivalent to S0 -6> {N, S3} = rand:uniform_s(1000000, S2). +6> {N, S3} = rand:uniform_s(1_000_000, S2). %% S3 is equivalent to S1 7> N. 334013 %% Within the same node this works just as well -6> {N, S4} = rand:uniform_s(1000000, S0). +6> {N, S4} = rand:uniform_s(1_000_000, S0). %% S4 is equivalent to S1 7> N. 334013 @@ -1048,8 +1048,8 @@ the process dictionary. Returns the generated number `X`. ```erlang %% Initialize a predictable PRNG sequence 1> rand:seed(exsss, 4711). -%% Generate an integer in the interval 1 .. 1000000 -2> rand:uniform(1000000). +%% Generate an integer in the interval 1 .. 1_000_000 +2> rand:uniform(1_000_000). 334013 ``` """. @@ -1132,8 +1132,8 @@ Returns the number `X` and the updated `NewState`. ```erlang %% Initialize a predictable PRNG sequence 1> S0 = rand:seed_s(exsss, 4711). -%% Generate an integer N in the interval 1 .. 1000000 -2> {N, S1} = rand:uniform_s(1000000, S0). +%% Generate an integer N in the interval 1 .. 1_000_000 +2> {N, S1} = rand:uniform_s(1_000_000, S0). 3> N. 334013 ``` @@ -1594,8 +1594,8 @@ no jump function implemented for the [`State`](`t:state/0`)'s algorithm. %% Initialize a predictable PRNG sequence 1> Sa0 = rand:seed_s(exsss, 4711). 2> Sb0 = rand:jump(Sa0). -%% Sa and Sb can now be used for surely -%% non-overlapping PRNG sequences +%% Sa and Sb can now be used for non-overlapping PRNG +%% sequences since they are separated by 2^64 iterations 3> {BytesA, Sa1} = rand:bytes_s(10, Sa0). 4> {BytesB, Sb1} = rand:bytes_s(10, Sb0). 5> BytesA. @@ -1635,8 +1635,8 @@ the process dictionary. Returns the [`NewState`](`t:state/0`). rand:jump(), Parent ! {self(), rand:bytes(10)} end). -%% Parent and Pid now produce surely -%% non-overlapping PRNG sequences +%% Parent and Pid now produce non-overlapping PRNG +%% sequences since they are separated by 2^64 iterations 4> rand:bytes(10). <<72,232,227,197,77,149,79,57,9,136>> 5> receive {Pid, Bytes} -> Bytes end. @@ -1909,7 +1909,7 @@ shuffle_s(List, {AlgHandler, R0}) %% Also, it is faster to do a 4-way split by 2 bits instead of, %% as described above, a 2-way split by 1 bit. -%% Leaf cases - random permutations for 0..3 elements +%% Leaf cases - random permutations for 0 .. 3 elements shuffle_r([], Acc, P, S) -> {Acc, P, S}; shuffle_r([X], Acc, P, S) -> @@ -2439,7 +2439,7 @@ exs1024_next({[H], RL}) -> %% This is the jump function for the exs1024 generator, equivalent %% to 2^512 calls to next(); it can be used to generate 2^512 %% non-overlapping subsequences for parallel computations. -%% Note: the jump function takes ~2000 times of the execution time of +%% Note: the jump function takes ~ 2 000 times of the execution time of %% next/1. %% Jump constant here split into 58 bits for speed @@ -2910,7 +2910,7 @@ dummy_seed({A1, A2, A3}) -> -define(MWC59_XS2, 27). -doc """ -`1 .. (16#1ffb072 bsl 29) - 2` +`1 .. (16#1ffb072 bsl 29) - 2` """. -type mwc59_state() :: 1..?MWC59_P-1. @@ -2983,7 +2983,7 @@ is 60% of the time for the default algorithm generating a `t:float/0`. 7714 %% Generate an integer 0 .. 999 with not noticeable bias 2> CX2 = rand:mwc59(CX1). -3> CX2 rem 1000. +3> CX2 rem 1_000. 86 ``` """. @@ -3019,7 +3019,7 @@ When using this scrambler it is in general better to use the high bits of the value than the low. The lowest 8 bits are of good quality and are passed right through from the base generator. They are combined with the next 8 in the xorshift making the low 16 good quality, but in the range -16 .. 31 bits there are weaker bits that should not become high bits +16 .. 31 bits there are weaker bits that should not become high bits of the generated values. Therefore it is in general safer to shift out low bits. @@ -3040,7 +3040,7 @@ that is: `(Range*V) bsr 32`, which is much faster than using `rem`. 2935831586 %% Generate an integer 0 .. 999 with not noticeable bias 2> CX2 = rand:mwc59(CX1). -3> (rand:mwc59_value32(CX2) * 1000) bsr 32. +3> (rand:mwc59_value32(CX2) * 1_000) bsr 32. 540 ``` """. @@ -3065,10 +3065,10 @@ the low. See the recipes in section [Niche algorithms](#niche-algorithms). For a non power of 2 range less than about 20 bits (to not get too much bias and to avoid bignums) truncated multiplication can be used, -which is much faster than using `rem`. Example for range 1'000'000; +which is much faster than using `rem`. Example for range 1 000 000; the range is 20 bits, we use 39 bits from the generator, adding up to 59 bits, which is not a bignum (on a 64-bit VM ): -`(1000_000 * (V bsr (59-39))) bsr 39`. +`(1_000_000 * (V bsr (59-39))) bsr 39`. #### _Shell Example_ @@ -3079,13 +3079,13 @@ adding up to 59 bits, which is not a bignum (on a 64-bit VM ): 2> CX1 = rand:mwc59(CX0). 3> rand:mwc59_value(CX1) bsr (59-48). 247563052677727 -%% Generate an integer 0 .. 1'000'000 with not noticeable bias +%% Generate an integer 0 .. 1_000_000 with not noticeable bias 4> CX2 = rand:mwc59(CX1). -5> ((rand:mwc59_value(CX2) bsr (59-39)) * 1000_000) bsr 39. +5> ((rand:mwc59_value(CX2) bsr (59-39)) * 1_000_000) bsr 39. 144457 -%% Generate an integer 0 .. 1'000'000'000 with not noticeable bias +%% Generate an integer 0 .. 1_000_000_000 with not noticeable bias 4> CX3 = rand:mwc59(CX2). -5> rand:mwc59_value(CX3) rem 1000_000_000. +5> rand:mwc59_value(CX3) rem 1_000_000_000. 949193925 ``` """. @@ -3138,7 +3138,7 @@ just like [`seed_s(atom())`](`seed_s/1`). 1> CX0 = rand:mwc59_seed(). %% Generate an integer 0 .. 999 with not noticeable bias 2> CX1 = rand:mwc59(CX0). -3> CX1 rem 1000. +3> CX1 rem 1_000. ``` """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}).