[mercury-users] a typeclassful random.m

[Julian Fondren]

The attached random.m implements that module, and rand_test.m
uses it to print random ints and floats from a tausworthe3 PRNG
seeded from /dev/urandom

It offers these base typeclasses:

  :- typeclass prng(T, S) <= ((T -> S), (S -> T)) where [
      pred seed(S::in, T::out) is det,
      pred next(int::out, T::in, T::out) is det,
      pred max(int::out, T::in, T::out) is det
  ].

  :- typeclass io_prng(T, S) <= ((T -> S), (S -> T)) where [
      pred open(S::in, T::out, io::di, io::uo) is det,
      pred next(int::out, T::in, T::out, io::di, io::uo) is det,
      pred close(T::in, io::di, io::uo) is det
  ].

And these generic predicates for both:

  random_int, random_float, random_int_in, random_float_in

And these RNGs:

  :- instance prng(tausworthe3, tausworthe3_seed).
  :- instance io_prng(device, device_seed).

random.m isn't finished -- I gave myself three hours to work on
it after asking some questions on the list (and throwing away
most of the random.m I'd come up with), and my three hours just
expired :-)  Time to enjoy the night, a bit.  I think what I
have is enough, anyway, for any comments on its design or
limitations or whatnot.

My TODO on this:

  * fix random_int_in and random_float_in (they should work
    for lower-bound of 0, to start, and also I think they
    should work properly at all).

  * get io_prng/open/3 to return an io.res/1, the way I
    initially tried to.  I changed it to throw an exception
    after I had some unresolved-polymorphism errors, which
    I think I might've fixed doing something else.

  * give random.m proper comments and documentation, following
    the actual in-library random.m

  * come up with a plan for random permutation.  (should I
    just have a permutable/1 typeclass and then have instances
    for every type in the library?  Won't that prevent me
    from having separate di/uo and in/out modes, to conflict
    with e.g. uniqueness limitations with the array types?)

  * add more instances of RNGs

  * add some kind of platform-dependent seed-source, following
    my patches to random.m in the other thread


thanks,
Julian
-------------- next part --------------
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%---------------------------------------------------------------------------%
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: random.m.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- module random.
:- interface.
:- import_module io, int, float.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Typeclasses.

:- typeclass prng(T, S) <= ((T -> S), (S -> T)) where [
    pred seed(S::in, T::out) is det,
    pred next(int::out, T::in, T::out) is det,
    pred max(int::out, T::in, T::out) is det
].

:- typeclass io_prng(T, S) <= ((T -> S), (S -> T)) where [
    pred open(S::in, T::out, io::di, io::uo) is det,
    pred next(int::out, T::in, T::out, io::di, io::uo) is det,
    pred close(T::in, io::di, io::uo) is det
].

%---------------------------------------------------------------------------%
% RNGs.

:- type tausworthe3.
:- type tausworthe3_seed ---> tausworthe3_seed(int, int, int).
:- instance prng(tausworthe3, tausworthe3_seed).

:- type device.
:- type device_seed ---> device_seed(string).
:- type device_exception
    --->    eof
    ;       error(io.error).
:- type device_open_exception ---> open_exception(io.error).

:- instance io_prng(device, device_seed).


%---------------------------------------------------------------------------%
% Generic interface.

:- pred random_int(int::out, RNG::in, RNG::out) is det
        <= (prng(RNG, Seed)).

:- pred random_int(int::out, RNG::in, RNG::out, io::di, io::uo) is det
        <= (io_prng(RNG, Seed)).

:- pred random_float(float::out, RNG::in, RNG::out) is det
        <= (prng(RNG, Seed)).

:- pred random_float(float::out, RNG::in, RNG::out, io::di, io::uo) is det
        <= (io_prng(RNG, Seed)).

:- pred random_int_in(int::out, int::in, int::in, RNG::in, RNG::out) is det
        <= (prng(RNG, Seed)).

:- pred random_int_in(int::out, int::in, int::in, RNG::in, RNG::out,
        io::di, io::uo) is det <= (io_prng(RNG, Seed)).

:- pred random_float_in(float::out, float::in, float::in, RNG::in, RNG::out)
        is det <= (prng(RNG, Seed)).

:- pred random_float_in(float::out, float::in, float::in, RNG::in, RNG::out,
        io::di, io::uo) is det <= (io_prng(RNG, Seed)).

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.
:- import_module exception.

%---------------------------------------------------------------------------%

random_int(N, !RNG) :- next(N, !RNG).

random_int(N, !RNG, !IO) :- next(N, !RNG, !IO).

random_float(N, !RNG) :-
    random_int(N1, !RNG),
    max(M, !RNG),
    N = float(N1) / float(M).

random_float(N, !RNG, !IO) :-
    random_int(N1, !RNG, !IO),
    N = float(N1) / float(int.max_int).

random_int_in(N, L, H, !RNG) :-
    random_int(N1, !RNG),
    max(M, !RNG),
    N = scale_int(N1, M, L, H).

random_int_in(N, L, H, !RNG, !IO) :-
    random_int(N1, !RNG, !IO),
    N = scale_int(N1, int.max_int, L, H).

random_float_in(N, L, H, !RNG) :-
    random_float(N1, !RNG),
    max(M, !RNG),
    N = scale_float(N1, float(M), L, H).

random_float_in(N, L, H, !RNG, !IO) :-
    random_float(N1, !RNG, !IO),
    N = scale_float(N1, float(int.max_int), L, H).

:- func scale_int(int, int, int, int) = int.

scale_int(N1, D1, N2, D2) = (N1 * D2) div (N2 * D1).

:- func scale_float(float, float, float, float) = float.

scale_float(N1, D1, N2, D2) = (N1 * D2) / (N2 * D1).

%---------------------------------------------------------------------------%

:- instance prng(tausworthe3, tausworthe3_seed) where [
    (seed(tausworthe3_seed(A, B, C), RNG) :- seed_tausworthe3(A, B, C) = RNG),
    pred(next/3) is rand_tausworthe3,
    (max(N, !RNG) :- N = int.max_int)  % is it?
].

:- instance io_prng(device, device_seed) where [
    (open(device_seed(S), device(RNG), !IO) :-
        io.open_binary_input(S, Res, !IO),
        (
            Res = ok(RNG)
        ;
            Res = error(E),
            throw(open_exception(E))
        )),
    pred(next/5) is next_device,
    (close(device(RNG), !IO) :- io.close_binary_input(RNG, !IO))
].

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- type device ---> device(io.binary_input_stream).

:- pred next_device(int::out, device::in, device::out, io::di, io::uo) is det.
next_device(N, device(RNG), device(RNG), !IO) :-
    next_bytes_device(N, 0, int.bits_per_int // 8, RNG, !IO).

:- pred next_bytes_device(int::out, int::in, int::in,
        io.binary_input_stream::in, io::di, io::uo) is det.
next_bytes_device(N, Acc, Count, RNG, !IO) :-
    (
        Count = 0
    ->
        N = Acc
    ;
        io.read_byte(RNG, Res, !IO),
        (
            Res = ok(B),
            next_bytes_device(N, (Acc << 8) \/ B, Count - 1, RNG, !IO)
        ;
            Res = eof,
            throw(random.eof)
        ;
            Res = error(E),
            throw(random.error(E))
        )
    ).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Adapted from http://remus.rutgers.edu/~rhoads/Code/tausworth.c
%

:- type tausworthe3
    --->    tausworthe3(
                s1    ::    int,
                s2    ::    int,
                s3    ::    int,
                tausworthe3_consts
            ).

:- type tausworthe3_consts
    --->    tausworthe3_consts(
                shft1    ::    int,
                shft2    ::    int,
                shft3    ::    int,
                mask1    ::    int,
                mask2    ::    int,
                mask3    ::    int
            ).

%-----------------------------------------------------------------------------%

:- func seed_tausworthe3(int, int, int) = tausworthe3.
seed_tausworthe3(A, B, C) = R :-

    P1     = 12,
    P2     =  4,
    P3     = 17,

    K1     = 31,
    K2     = 29,
    K3     = 28,

    X      = 4294967295,

    Shft1  = K1 - P1,
    Shft2  = K2 - P2,
    Shft3  = K3 - P3,

    Mask1  = X << (32 - K1),
    Mask2  = X << (32 - K2),
    Mask3  = X << (32 - K3),

    S1     = ( if A > (1 << (32 - K1)) then A else 390451501 ),
    S2     = ( if A > (1 << (32 - K2)) then B else 613566701 ),
    S3     = ( if A > (1 << (32 - K3)) then C else 858993401 ),

    Consts = tausworthe3_consts(Shft1, Shft2, Shft3, Mask1, Mask2, Mask3),
    R0     = tausworthe3(S1, S2, S3, Consts),
    rand_tausworthe3(_, R0, R).

%-----------------------------------------------------------------------------%

:- pred rand_tausworthe3(int::out, tausworthe3::in, tausworthe3::out) is det.
rand_tausworthe3(I, !RNG) :-
    !.RNG  = tausworthe3(S1_0, S2_0, S3_0, Consts),
    Consts = tausworthe3_consts(Shft1, Shft2, Shft3, Mask1, Mask2, Mask3),

    P1     = 12,
    P2     =  4,
    P3     = 17,

    Q1     = 13,
    Q2     =  2,
    Q3     =  3,

    B1     = ((S1_0 << Q1)`xor`S1_0) >> Shft1,
    S1     = ((S1_0 /\ Mask1) << P1)`xor`B1,

    B2     = ((S2_0 << Q2)`xor`S2_0) >> Shft2,
    S2     = ((S2_0 /\ Mask2) << P2)`xor`B2,

    B3     = ((S3_0 << Q3)`xor`S3_0) >> Shft3,
    S3     = ((S3_0 /\ Mask3) << P3)`xor`B3,

    I      = abs(S1`xor`S2`xor`S3),
    !:RNG  = tausworthe3(S1,   S2,   S3,   Consts).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-------------- next part --------------
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%---------------------------------------------------------------------------%
% This file is released into the public domain by its author,
%   Julian Fondren <ayrnieu at gmail.com>
%---------------------------------------------------------------------------%
:- module rand_test.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module random, list, string, require.

main(!IO) :-
    some [!DRNG] (
        random.open(device_seed("/dev/urandom"), !:DRNG, !IO),
        random_int(A, !DRNG, !IO),
        random_int(B, !DRNG, !IO),
        random_int(C, !DRNG, !IO),
        random.close(!.DRNG, !IO),
        random.seed(random.tausworthe3_seed(A, B, C), PRNG),
        spew(PRNG, !IO)
    ).

:- pred spew(T::in, io::di, io::uo) is det
        <= (random.prng(T, _)).
spew(!.PRNG, !IO) :-
    random_int(N, !PRNG),
    random_float(F, !PRNG),
    random_int_in(N1, 20, 30, !PRNG),
    random_float_in(F1, 1.0, 5.0, !PRNG),
    io.print([N, N1], !IO), io.nl(!IO),
    io.print([F, F1], !IO), io.nl(!IO),
    spew(!.PRNG, !IO).