Remove SRFI-27
This commit is contained in:
parent
bb256c9cdd
commit
9ac04dda71
544
srfi/27.scm
544
srfi/27.scm
|
|
@ -1,544 +0,0 @@
|
|||
; 54-BIT INTEGER IMPLEMENTATION OF THE "MRG32K3A"-GENERATOR
|
||||
; =========================================================
|
||||
;
|
||||
; Sebastian.Egner@philips.com, Mar-2002.
|
||||
;
|
||||
; This file is an implementation of Pierre L'Ecuyer's MRG32k3a
|
||||
; pseudo random number generator. Please refer to 'mrg32k3a.scm'
|
||||
; for more information.
|
||||
;
|
||||
; compliance:
|
||||
; Scheme R5RS with integers covering at least {-2^53..2^53-1}.
|
||||
;
|
||||
; history of this file:
|
||||
; SE, 18-Mar-2002: initial version
|
||||
; SE, 22-Mar-2002: comments adjusted, range added
|
||||
; SE, 25-Mar-2002: pack/unpack just return their argument
|
||||
|
||||
; the actual generator
|
||||
|
||||
(define (mrg32k3a-random-m1 state)
|
||||
(let ((x11 (vector-ref state 0))
|
||||
(x12 (vector-ref state 1))
|
||||
(x13 (vector-ref state 2))
|
||||
(x21 (vector-ref state 3))
|
||||
(x22 (vector-ref state 4))
|
||||
(x23 (vector-ref state 5)))
|
||||
(let ((x10 (modulo (- (* 1403580 x12) (* 810728 x13)) 4294967087))
|
||||
(x20 (modulo (- (* 527612 x21) (* 1370589 x23)) 4294944443)))
|
||||
(vector-set! state 0 x10)
|
||||
(vector-set! state 1 x11)
|
||||
(vector-set! state 2 x12)
|
||||
(vector-set! state 3 x20)
|
||||
(vector-set! state 4 x21)
|
||||
(vector-set! state 5 x22)
|
||||
(modulo (- x10 x20) 4294967087))))
|
||||
|
||||
; interface to the generic parts of the generator
|
||||
|
||||
(define (mrg32k3a-pack-state unpacked-state)
|
||||
unpacked-state)
|
||||
|
||||
(define (mrg32k3a-unpack-state state)
|
||||
state)
|
||||
|
||||
(define (mrg32k3a-random-range) ; m1
|
||||
4294967087)
|
||||
|
||||
(define (mrg32k3a-random-integer state range) ; rejection method
|
||||
(let* ((q (quotient 4294967087 range))
|
||||
(qn (* q range)))
|
||||
(do ((x (mrg32k3a-random-m1 state) (mrg32k3a-random-m1 state)))
|
||||
((< x qn) (quotient x q)))))
|
||||
|
||||
(define (mrg32k3a-random-real state) ; normalization is 1/(m1+1)
|
||||
(* 0.0000000002328306549295728 (+ 1.0 (mrg32k3a-random-m1 state))))
|
||||
|
||||
|
||||
; GENERIC PART OF MRG32k3a-GENERATOR FOR SRFI-27
|
||||
; ==============================================
|
||||
;
|
||||
; Sebastian.Egner@philips.com, 2002.
|
||||
;
|
||||
; This is the generic R5RS-part of the implementation of the MRG32k3a
|
||||
; generator to be used in SRFI-27. It is based on a separate implementation
|
||||
; of the core generator (presumably in native code) and on code to
|
||||
; provide essential functionality not available in R5RS (see below).
|
||||
;
|
||||
; compliance:
|
||||
; Scheme R5RS with integer covering at least {-2^53..2^53-1}.
|
||||
; In addition,
|
||||
; SRFI-23: error
|
||||
;
|
||||
; history of this file:
|
||||
; SE, 22-Mar-2002: refactored from earlier versions
|
||||
; SE, 25-Mar-2002: pack/unpack need not allocate
|
||||
; SE, 27-Mar-2002: changed interface to core generator
|
||||
; SE, 10-Apr-2002: updated spec of mrg32k3a-random-integer
|
||||
|
||||
; Generator
|
||||
; =========
|
||||
;
|
||||
; Pierre L'Ecuyer's MRG32k3a generator is a Combined Multiple Recursive
|
||||
; Generator. It produces the sequence {(x[1,n] - x[2,n]) mod m1 : n}
|
||||
; defined by the two recursive generators
|
||||
;
|
||||
; x[1,n] = ( a12 x[1,n-2] + a13 x[1,n-3]) mod m1,
|
||||
; x[2,n] = (a21 x[2,n-1] + a23 x[2,n-3]) mod m2,
|
||||
;
|
||||
; where the constants are
|
||||
; m1 = 4294967087 = 2^32 - 209 modulus of 1st component
|
||||
; m2 = 4294944443 = 2^32 - 22853 modulus of 2nd component
|
||||
; a12 = 1403580 recursion coefficients
|
||||
; a13 = -810728
|
||||
; a21 = 527612
|
||||
; a23 = -1370589
|
||||
;
|
||||
; The generator passes all tests of G. Marsaglia's Diehard testsuite.
|
||||
; Its period is (m1^3 - 1)(m2^3 - 1)/2 which is nearly 2^191.
|
||||
; L'Ecuyer reports: "This generator is well-behaved in all dimensions
|
||||
; up to at least 45: ..." [with respect to the spectral test, SE].
|
||||
;
|
||||
; The period is maximal for all values of the seed as long as the
|
||||
; state of both recursive generators is not entirely zero.
|
||||
;
|
||||
; As the successor state is a linear combination of previous
|
||||
; states, it is possible to advance the generator by more than one
|
||||
; iteration by applying a linear transformation. The following
|
||||
; publication provides detailed information on how to do that:
|
||||
;
|
||||
; [1] P. L'Ecuyer, R. Simard, E. J. Chen, W. D. Kelton:
|
||||
; An Object-Oriented Random-Number Package With Many Long
|
||||
; Streams and Substreams. 2001.
|
||||
; To appear in Operations Research.
|
||||
;
|
||||
; Arithmetics
|
||||
; ===========
|
||||
;
|
||||
; The MRG32k3a generator produces values in {0..2^32-209-1}. All
|
||||
; subexpressions of the actual generator fit into {-2^53..2^53-1}.
|
||||
; The code below assumes that Scheme's "integer" covers this range.
|
||||
; In addition, it is assumed that floating point literals can be
|
||||
; read and there is some arithmetics with inexact numbers.
|
||||
;
|
||||
; However, for advancing the state of the generator by more than
|
||||
; one step at a time, the full range {0..2^32-209-1} is needed.
|
||||
|
||||
|
||||
; Required: Backbone Generator
|
||||
; ============================
|
||||
;
|
||||
; At this point in the code, the following procedures are assumed
|
||||
; to be defined to execute the core generator:
|
||||
;
|
||||
; (mrg32k3a-pack-state unpacked-state) -> packed-state
|
||||
; (mrg32k3a-unpack-state packed-state) -> unpacked-state
|
||||
; pack/unpack a state of the generator. The core generator works
|
||||
; on packed states, passed as an explicit argument, only. This
|
||||
; allows native code implementations to store their state in a
|
||||
; suitable form. Unpacked states are #(x10 x11 x12 x20 x21 x22)
|
||||
; with integer x_ij. Pack/unpack need not allocate new objects
|
||||
; in case packed and unpacked states are identical.
|
||||
;
|
||||
; (mrg32k3a-random-range) -> m-max
|
||||
; (mrg32k3a-random-integer packed-state range) -> x in {0..range-1}
|
||||
; advance the state of the generator and return the next random
|
||||
; range-limited integer.
|
||||
; Note that the state is not necessarily advanced by just one
|
||||
; step because we use the rejection method to avoid any problems
|
||||
; with distribution anomalies.
|
||||
; The range argument must be an exact integer in {1..m-max}.
|
||||
; It can be assumed that range is a fixnum if the Scheme system
|
||||
; has such a number representation.
|
||||
;
|
||||
; (mrg32k3a-random-real packed-state) -> x in (0,1)
|
||||
; advance the state of the generator and return the next random
|
||||
; real number between zero and one (both excluded). The type of
|
||||
; the result should be a flonum if possible.
|
||||
|
||||
; Required: Record Data Type
|
||||
; ==========================
|
||||
;
|
||||
; At this point in the code, the following procedures are assumed
|
||||
; to be defined to create and access a new record data type:
|
||||
;
|
||||
; (:random-source-make a0 a1 a2 a3 a4 a5) -> s
|
||||
; constructs a new random source object s consisting of the
|
||||
; objects a0 .. a5 in this order.
|
||||
;
|
||||
; (:random-source? obj) -> bool
|
||||
; tests if a Scheme object is a :random-source.
|
||||
;
|
||||
; (:random-source-state-ref s) -> a0
|
||||
; (:random-source-state-set! s) -> a1
|
||||
; (:random-source-randomize! s) -> a2
|
||||
; (:random-source-pseudo-randomize! s) -> a3
|
||||
; (:random-source-make-integers s) -> a4
|
||||
; (:random-source-make-reals s) -> a5
|
||||
; retrieve the values in the fields of the object s.
|
||||
|
||||
; Required: Current Time as an Integer
|
||||
; ====================================
|
||||
;
|
||||
; At this point in the code, the following procedure is assumed
|
||||
; to be defined to obtain a value that is likely to be different
|
||||
; for each invokation of the Scheme system:
|
||||
;
|
||||
; (:random-source-current-time) -> x
|
||||
; an integer that depends on the system clock. It is desired
|
||||
; that the integer changes as fast as possible.
|
||||
|
||||
|
||||
; Accessing the State
|
||||
; ===================
|
||||
|
||||
(define (mrg32k3a-state-ref packed-state)
|
||||
(cons 'lecuyer-mrg32k3a
|
||||
(vector->list (mrg32k3a-unpack-state packed-state))))
|
||||
|
||||
(define (mrg32k3a-state-set external-state)
|
||||
|
||||
(define (check-value x m)
|
||||
(if (and (integer? x)
|
||||
(exact? x)
|
||||
(<= 0 x (- m 1)))
|
||||
#t
|
||||
(error "illegal value" x)))
|
||||
|
||||
(if (and (list? external-state)
|
||||
(= (length external-state) 7)
|
||||
(eq? (car external-state) 'lecuyer-mrg32k3a))
|
||||
(let ((s (cdr external-state)))
|
||||
(check-value (list-ref s 0) mrg32k3a-m1)
|
||||
(check-value (list-ref s 1) mrg32k3a-m1)
|
||||
(check-value (list-ref s 2) mrg32k3a-m1)
|
||||
(check-value (list-ref s 3) mrg32k3a-m2)
|
||||
(check-value (list-ref s 4) mrg32k3a-m2)
|
||||
(check-value (list-ref s 5) mrg32k3a-m2)
|
||||
(if (or (zero? (+ (list-ref s 0) (list-ref s 1) (list-ref s 2)))
|
||||
(zero? (+ (list-ref s 3) (list-ref s 4) (list-ref s 5))))
|
||||
(error "illegal degenerate state" external-state))
|
||||
(mrg32k3a-pack-state (list->vector s)))
|
||||
(error "malformed state" external-state)))
|
||||
|
||||
|
||||
; Pseudo-Randomization
|
||||
; ====================
|
||||
;
|
||||
; Reference [1] above shows how to obtain many long streams and
|
||||
; substream from the backbone generator.
|
||||
;
|
||||
; The idea is that the generator is a linear operation on the state.
|
||||
; Hence, we can express this operation as a 3x3-matrix acting on the
|
||||
; three most recent states. Raising the matrix to the k-th power, we
|
||||
; obtain the operation to advance the state by k steps at once. The
|
||||
; virtual streams and substreams are now simply parts of the entire
|
||||
; periodic sequence (which has period around 2^191).
|
||||
;
|
||||
; For the implementation it is necessary to compute with matrices in
|
||||
; the ring (Z/(m1*m1)*Z)^(3x3). By the Chinese-Remainder Theorem, this
|
||||
; is isomorphic to ((Z/m1*Z) x (Z/m2*Z))^(3x3). We represent such a pair
|
||||
; of matrices
|
||||
; [ [[x00 x01 x02],
|
||||
; [x10 x11 x12],
|
||||
; [x20 x21 x22]], mod m1
|
||||
; [[y00 y01 y02],
|
||||
; [y10 y11 y12],
|
||||
; [y20 y21 y22]] mod m2]
|
||||
; as a vector of length 18 of the integers as writen above:
|
||||
; #(x00 x01 x02 x10 x11 x12 x20 x21 x22
|
||||
; y00 y01 y02 y10 y11 y12 y20 y21 y22)
|
||||
;
|
||||
; As the implementation should only use the range {-2^53..2^53-1}, the
|
||||
; fundamental operation (x*y) mod m, where x, y, m are nearly 2^32,
|
||||
; is computed by breaking up x and y as x = x1*w + x0 and y = y1*w + y0
|
||||
; where w = 2^16. In this case, all operations fit the range because
|
||||
; w^2 mod m is a small number. If proper multiprecision integers are
|
||||
; available this is not necessary, but pseudo-randomize! is an expected
|
||||
; to be called only occasionally so we do not provide this implementation.
|
||||
|
||||
(define mrg32k3a-m1 4294967087) ; modulus of component 1
|
||||
(define mrg32k3a-m2 4294944443) ; modulus of component 2
|
||||
|
||||
(define mrg32k3a-initial-state ; 0 3 6 9 12 15 of A^16, see below
|
||||
'#( 1062452522
|
||||
2961816100
|
||||
342112271
|
||||
2854655037
|
||||
3321940838
|
||||
3542344109))
|
||||
|
||||
(define mrg32k3a-generators #f) ; computed when needed
|
||||
|
||||
(define (mrg32k3a-pseudo-randomize-state i j)
|
||||
|
||||
(define (product A B) ; A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
|
||||
|
||||
(define w 65536) ; wordsize to split {0..2^32-1}
|
||||
(define w-sqr1 209) ; w^2 mod m1
|
||||
(define w-sqr2 22853) ; w^2 mod m2
|
||||
|
||||
(define (lc i0 i1 i2 j0 j1 j2 m w-sqr) ; linear combination
|
||||
(let ((a0h (quotient (vector-ref A i0) w))
|
||||
(a0l (modulo (vector-ref A i0) w))
|
||||
(a1h (quotient (vector-ref A i1) w))
|
||||
(a1l (modulo (vector-ref A i1) w))
|
||||
(a2h (quotient (vector-ref A i2) w))
|
||||
(a2l (modulo (vector-ref A i2) w))
|
||||
(b0h (quotient (vector-ref B j0) w))
|
||||
(b0l (modulo (vector-ref B j0) w))
|
||||
(b1h (quotient (vector-ref B j1) w))
|
||||
(b1l (modulo (vector-ref B j1) w))
|
||||
(b2h (quotient (vector-ref B j2) w))
|
||||
(b2l (modulo (vector-ref B j2) w)))
|
||||
(modulo
|
||||
(+ (* (+ (* a0h b0h)
|
||||
(* a1h b1h)
|
||||
(* a2h b2h))
|
||||
w-sqr)
|
||||
(* (+ (* a0h b0l)
|
||||
(* a0l b0h)
|
||||
(* a1h b1l)
|
||||
(* a1l b1h)
|
||||
(* a2h b2l)
|
||||
(* a2l b2h))
|
||||
w)
|
||||
(* a0l b0l)
|
||||
(* a1l b1l)
|
||||
(* a2l b2l))
|
||||
m)))
|
||||
|
||||
(vector
|
||||
(lc 0 1 2 0 3 6 mrg32k3a-m1 w-sqr1) ; (A*B)_00 mod m1
|
||||
(lc 0 1 2 1 4 7 mrg32k3a-m1 w-sqr1) ; (A*B)_01
|
||||
(lc 0 1 2 2 5 8 mrg32k3a-m1 w-sqr1)
|
||||
(lc 3 4 5 0 3 6 mrg32k3a-m1 w-sqr1) ; (A*B)_10
|
||||
(lc 3 4 5 1 4 7 mrg32k3a-m1 w-sqr1)
|
||||
(lc 3 4 5 2 5 8 mrg32k3a-m1 w-sqr1)
|
||||
(lc 6 7 8 0 3 6 mrg32k3a-m1 w-sqr1)
|
||||
(lc 6 7 8 1 4 7 mrg32k3a-m1 w-sqr1)
|
||||
(lc 6 7 8 2 5 8 mrg32k3a-m1 w-sqr1)
|
||||
(lc 9 10 11 9 12 15 mrg32k3a-m2 w-sqr2) ; (A*B)_00 mod m2
|
||||
(lc 9 10 11 10 13 16 mrg32k3a-m2 w-sqr2)
|
||||
(lc 9 10 11 11 14 17 mrg32k3a-m2 w-sqr2)
|
||||
(lc 12 13 14 9 12 15 mrg32k3a-m2 w-sqr2)
|
||||
(lc 12 13 14 10 13 16 mrg32k3a-m2 w-sqr2)
|
||||
(lc 12 13 14 11 14 17 mrg32k3a-m2 w-sqr2)
|
||||
(lc 15 16 17 9 12 15 mrg32k3a-m2 w-sqr2)
|
||||
(lc 15 16 17 10 13 16 mrg32k3a-m2 w-sqr2)
|
||||
(lc 15 16 17 11 14 17 mrg32k3a-m2 w-sqr2)))
|
||||
|
||||
(define (power A e) ; A^e
|
||||
(cond
|
||||
((zero? e)
|
||||
'#(1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 0 1))
|
||||
((= e 1)
|
||||
A)
|
||||
((even? e)
|
||||
(power (product A A) (quotient e 2)))
|
||||
(else
|
||||
(product (power A (- e 1)) A))))
|
||||
|
||||
(define (power-power A b) ; A^(2^b)
|
||||
(if (zero? b)
|
||||
A
|
||||
(power-power (product A A) (- b 1))))
|
||||
|
||||
(define A ; the MRG32k3a recursion
|
||||
'#( 0 1403580 4294156359
|
||||
1 0 0
|
||||
0 1 0
|
||||
527612 0 4293573854
|
||||
1 0 0
|
||||
0 1 0))
|
||||
|
||||
; check arguments
|
||||
(if (not (and (integer? i)
|
||||
(exact? i)
|
||||
(integer? j)
|
||||
(exact? j)))
|
||||
(error "i j must be exact integer" i j))
|
||||
|
||||
; precompute A^(2^127) and A^(2^76) only once
|
||||
|
||||
(if (not mrg32k3a-generators)
|
||||
(set! mrg32k3a-generators
|
||||
(list (power-power A 127)
|
||||
(power-power A 76)
|
||||
(power A 16))))
|
||||
|
||||
; compute M = A^(16 + i*2^127 + j*2^76)
|
||||
(let ((M (product
|
||||
(list-ref mrg32k3a-generators 2)
|
||||
(product
|
||||
(power (list-ref mrg32k3a-generators 0)
|
||||
(modulo i (expt 2 28)))
|
||||
(power (list-ref mrg32k3a-generators 1)
|
||||
(modulo j (expt 2 28)))))))
|
||||
(mrg32k3a-pack-state
|
||||
(vector
|
||||
(vector-ref M 0)
|
||||
(vector-ref M 3)
|
||||
(vector-ref M 6)
|
||||
(vector-ref M 9)
|
||||
(vector-ref M 12)
|
||||
(vector-ref M 15)))))
|
||||
|
||||
; True Randomization
|
||||
; ==================
|
||||
;
|
||||
; The value obtained from the system time is feed into a very
|
||||
; simple pseudo random number generator. This in turn is used
|
||||
; to obtain numbers to randomize the state of the MRG32k3a
|
||||
; generator, avoiding period degeneration.
|
||||
|
||||
(define (mrg32k3a-randomize-state state)
|
||||
;; G. Marsaglia's simple 16-bit generator with carry
|
||||
(let* ((m 65536)
|
||||
(x (modulo (:random-source-current-time) m)))
|
||||
(define (random-m)
|
||||
(let ((y (modulo x m)))
|
||||
(set! x (+ (* 30903 y) (quotient x m)))
|
||||
y))
|
||||
(define (random n) ; m < n < m^2
|
||||
(modulo (+ (* (random-m) m) (random-m)) n))
|
||||
|
||||
; modify the state
|
||||
(let ((m1 mrg32k3a-m1)
|
||||
(m2 mrg32k3a-m2)
|
||||
(s (mrg32k3a-unpack-state state)))
|
||||
(mrg32k3a-pack-state
|
||||
(vector
|
||||
(+ 1 (modulo (+ (vector-ref s 0) (random (- m1 1))) (- m1 1)))
|
||||
(modulo (+ (vector-ref s 1) (random m1)) m1)
|
||||
(modulo (+ (vector-ref s 2) (random m1)) m1)
|
||||
(+ 1 (modulo (+ (vector-ref s 3) (random (- m2 1))) (- m2 1)))
|
||||
(modulo (+ (vector-ref s 4) (random m2)) m2)
|
||||
(modulo (+ (vector-ref s 5) (random m2)) m2))))))
|
||||
|
||||
|
||||
; Large Integers
|
||||
; ==============
|
||||
;
|
||||
; To produce large integer random deviates, for n > m-max, we first
|
||||
; construct large random numbers in the range {0..m-max^k-1} for some
|
||||
; k such that m-max^k >= n and then use the rejection method to choose
|
||||
; uniformly from the range {0..n-1}.
|
||||
|
||||
(define mrg32k3a-m-max
|
||||
(mrg32k3a-random-range))
|
||||
|
||||
(define (mrg32k3a-random-power state k) ; n = m-max^k, k >= 1
|
||||
(if (= k 1)
|
||||
(mrg32k3a-random-integer state mrg32k3a-m-max)
|
||||
(+ (* (mrg32k3a-random-power state (- k 1)) mrg32k3a-m-max)
|
||||
(mrg32k3a-random-integer state mrg32k3a-m-max))))
|
||||
|
||||
(define (mrg32k3a-random-large state n) ; n > m-max
|
||||
(do ((k 2 (+ k 1))
|
||||
(mk (* mrg32k3a-m-max mrg32k3a-m-max) (* mk mrg32k3a-m-max)))
|
||||
((>= mk n)
|
||||
(let* ((mk-by-n (quotient mk n))
|
||||
(a (* mk-by-n n)))
|
||||
(do ((x (mrg32k3a-random-power state k)
|
||||
(mrg32k3a-random-power state k)))
|
||||
((< x a) (quotient x mk-by-n)))))))
|
||||
|
||||
|
||||
; Multiple Precision Reals
|
||||
; ========================
|
||||
;
|
||||
; To produce multiple precision reals we produce a large integer value
|
||||
; and convert it into a real value. This value is then normalized.
|
||||
; The precision goal is unit <= 1/(m^k + 1), or 1/unit - 1 <= m^k.
|
||||
; If you know more about the floating point number types of the
|
||||
; Scheme system, this can be improved.
|
||||
|
||||
(define (mrg32k3a-random-real-mp state unit)
|
||||
(do ((k 1 (+ k 1))
|
||||
(u (- (/ 1 unit) 1) (/ u mrg32k3a-m1)))
|
||||
((<= u 1)
|
||||
(/ (exact->inexact (+ (mrg32k3a-random-power state k) 1))
|
||||
(exact->inexact (+ (expt mrg32k3a-m-max k) 1))))))
|
||||
|
||||
|
||||
; Provide the Interface as Specified in the SRFI
|
||||
; ==============================================
|
||||
;
|
||||
; An object of type random-source is a record containing the procedures
|
||||
; as components. The actual state of the generator is stored in the
|
||||
; binding-time environment of make-random-source.
|
||||
|
||||
(define (make-random-source)
|
||||
(let ((state (mrg32k3a-pack-state ; make a new copy
|
||||
(list->vector (vector->list mrg32k3a-initial-state)))))
|
||||
(:random-source-make
|
||||
(lambda ()
|
||||
(mrg32k3a-state-ref state))
|
||||
(lambda (new-state)
|
||||
(set! state (mrg32k3a-state-set new-state)))
|
||||
(lambda ()
|
||||
(set! state (mrg32k3a-randomize-state state)))
|
||||
(lambda (i j)
|
||||
(set! state (mrg32k3a-pseudo-randomize-state i j)))
|
||||
(lambda ()
|
||||
(lambda (n)
|
||||
(cond
|
||||
((not (and (integer? n) (exact? n) (positive? n)))
|
||||
(error "range must be exact positive integer" n))
|
||||
((<= n mrg32k3a-m-max)
|
||||
(mrg32k3a-random-integer state n))
|
||||
(else
|
||||
(mrg32k3a-random-large state n)))))
|
||||
(lambda args
|
||||
(cond
|
||||
((null? args)
|
||||
(lambda ()
|
||||
(mrg32k3a-random-real state)))
|
||||
((null? (cdr args))
|
||||
(let ((unit (car args)))
|
||||
(cond
|
||||
((not (and (real? unit) (< 0 unit 1)))
|
||||
(error "unit must be real in (0,1)" unit))
|
||||
((<= (- (/ 1 unit) 1) mrg32k3a-m1)
|
||||
(lambda ()
|
||||
(mrg32k3a-random-real state)))
|
||||
(else
|
||||
(lambda ()
|
||||
(mrg32k3a-random-real-mp state unit))))))
|
||||
(else
|
||||
(error "illegal arguments" args)))))))
|
||||
|
||||
(define random-source?
|
||||
:random-source?)
|
||||
|
||||
(define (random-source-state-ref s)
|
||||
((:random-source-state-ref s)))
|
||||
|
||||
(define (random-source-state-set! s state)
|
||||
((:random-source-state-set! s) state))
|
||||
|
||||
(define (random-source-randomize! s)
|
||||
((:random-source-randomize! s)))
|
||||
|
||||
(define (random-source-pseudo-randomize! s i j)
|
||||
((:random-source-pseudo-randomize! s) i j))
|
||||
|
||||
; ---
|
||||
|
||||
(define (random-source-make-integers s)
|
||||
((:random-source-make-integers s)))
|
||||
|
||||
(define (random-source-make-reals s . unit)
|
||||
(apply (:random-source-make-reals s) unit))
|
||||
|
||||
; ---
|
||||
|
||||
(define default-random-source
|
||||
(make-random-source))
|
||||
|
||||
(define random-integer
|
||||
(random-source-make-integers default-random-source))
|
||||
|
||||
(define random-real
|
||||
(random-source-make-reals default-random-source))
|
||||
67
srfi/27.sld
67
srfi/27.sld
|
|
@ -1,67 +0,0 @@
|
|||
; MODULE DEFINITION FOR SRFI-27
|
||||
; =============================
|
||||
;
|
||||
; Sebastian.Egner@philips.com, Mar-2002, in Scheme 48 0.57
|
||||
;
|
||||
; This file contains the top-level definition for the 54-bit integer-only
|
||||
; implementation of SRFI-27 for the Scheme 48 0.57 system.
|
||||
;
|
||||
; 1. The core generator is implemented in 'mrg32k3a-a.scm'.
|
||||
; 2. The generic parts of the interface are in 'mrg32k3a.scm'.
|
||||
; 3. The non-generic parts (record type, time, error) are here.
|
||||
;
|
||||
; creating the module:
|
||||
; ,config ,load srfi-27-a.scm
|
||||
;
|
||||
; loading the module, once created:
|
||||
; ,open srfi-27
|
||||
;
|
||||
; history of this file:
|
||||
; SE, 22-Mar-2002: initial version
|
||||
; SE, 27-Mar-2002: checked again
|
||||
|
||||
(define-library
|
||||
(srfi 27)
|
||||
(import (scheme base)
|
||||
(scheme time))
|
||||
(export random-integer
|
||||
random-real
|
||||
default-random-source
|
||||
make-random-source
|
||||
random-source?
|
||||
random-source-state-ref
|
||||
random-source-state-set!
|
||||
random-source-randomize!
|
||||
random-source-pseudo-randomize!
|
||||
random-source-make-integers
|
||||
random-source-make-reals)
|
||||
#;(open
|
||||
scheme-level-1
|
||||
(subset srfi-9 (define-record-type))
|
||||
(subset srfi-23 (error))
|
||||
(subset posix-time (current-time))
|
||||
(subset posix (time-seconds)))
|
||||
|
||||
(begin
|
||||
(define-record-type :random-source
|
||||
(:random-source-make
|
||||
state-ref
|
||||
state-set!
|
||||
randomize!
|
||||
pseudo-randomize!
|
||||
make-integers
|
||||
make-reals)
|
||||
:random-source?
|
||||
(state-ref :random-source-state-ref)
|
||||
(state-set! :random-source-state-set!)
|
||||
(randomize! :random-source-randomize!)
|
||||
(pseudo-randomize! :random-source-pseudo-randomize!)
|
||||
(make-integers :random-source-make-integers)
|
||||
(make-reals :random-source-make-reals))
|
||||
|
||||
(define (:random-source-current-time)
|
||||
(exact (floor (current-second)))))
|
||||
|
||||
;(include "mrg32k3a-a.scm")
|
||||
;(include "mrg32k3a.scm")
|
||||
(include "27.scm"))
|
||||
165
srfi/27/LICENSE
165
srfi/27/LICENSE
|
|
@ -1,165 +0,0 @@
|
|||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
|
||||
This version of the GNU Lesser General Public License incorporates
|
||||
the terms and conditions of version 3 of the GNU General Public
|
||||
License, supplemented by the additional permissions listed below.
|
||||
|
||||
0. Additional Definitions.
|
||||
|
||||
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||
General Public License.
|
||||
|
||||
"The Library" refers to a covered work governed by this License,
|
||||
other than an Application or a Combined Work as defined below.
|
||||
|
||||
An "Application" is any work that makes use of an interface provided
|
||||
by the Library, but which is not otherwise based on the Library.
|
||||
Defining a subclass of a class defined by the Library is deemed a mode
|
||||
of using an interface provided by the Library.
|
||||
|
||||
A "Combined Work" is a work produced by combining or linking an
|
||||
Application with the Library. The particular version of the Library
|
||||
with which the Combined Work was made is also called the "Linked
|
||||
Version".
|
||||
|
||||
The "Minimal Corresponding Source" for a Combined Work means the
|
||||
Corresponding Source for the Combined Work, excluding any source code
|
||||
for portions of the Combined Work that, considered in isolation, are
|
||||
based on the Application, and not on the Linked Version.
|
||||
|
||||
The "Corresponding Application Code" for a Combined Work means the
|
||||
object code and/or source code for the Application, including any data
|
||||
and utility programs needed for reproducing the Combined Work from the
|
||||
Application, but excluding the System Libraries of the Combined Work.
|
||||
|
||||
1. Exception to Section 3 of the GNU GPL.
|
||||
|
||||
You may convey a covered work under sections 3 and 4 of this License
|
||||
without being bound by section 3 of the GNU GPL.
|
||||
|
||||
2. Conveying Modified Versions.
|
||||
|
||||
If you modify a copy of the Library, and, in your modifications, a
|
||||
facility refers to a function or data to be supplied by an Application
|
||||
that uses the facility (other than as an argument passed when the
|
||||
facility is invoked), then you may convey a copy of the modified
|
||||
version:
|
||||
|
||||
a) under this License, provided that you make a good faith effort to
|
||||
ensure that, in the event an Application does not supply the
|
||||
function or data, the facility still operates, and performs
|
||||
whatever part of its purpose remains meaningful, or
|
||||
|
||||
b) under the GNU GPL, with none of the additional permissions of
|
||||
this License applicable to that copy.
|
||||
|
||||
3. Object Code Incorporating Material from Library Header Files.
|
||||
|
||||
The object code form of an Application may incorporate material from
|
||||
a header file that is part of the Library. You may convey such object
|
||||
code under terms of your choice, provided that, if the incorporated
|
||||
material is not limited to numerical parameters, data structure
|
||||
layouts and accessors, or small macros, inline functions and templates
|
||||
(ten or fewer lines in length), you do both of the following:
|
||||
|
||||
a) Give prominent notice with each copy of the object code that the
|
||||
Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
4. Combined Works.
|
||||
|
||||
You may convey a Combined Work under terms of your choice that,
|
||||
taken together, effectively do not restrict modification of the
|
||||
portions of the Library contained in the Combined Work and reverse
|
||||
engineering for debugging such modifications, if you also do each of
|
||||
the following:
|
||||
|
||||
a) Give prominent notice with each copy of the Combined Work that
|
||||
the Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
c) For a Combined Work that displays copyright notices during
|
||||
execution, include the copyright notice for the Library among
|
||||
these notices, as well as a reference directing the user to the
|
||||
copies of the GNU GPL and this license document.
|
||||
|
||||
d) Do one of the following:
|
||||
|
||||
0) Convey the Minimal Corresponding Source under the terms of this
|
||||
License, and the Corresponding Application Code in a form
|
||||
suitable for, and under terms that permit, the user to
|
||||
recombine or relink the Application with a modified version of
|
||||
the Linked Version to produce a modified Combined Work, in the
|
||||
manner specified by section 6 of the GNU GPL for conveying
|
||||
Corresponding Source.
|
||||
|
||||
1) Use a suitable shared library mechanism for linking with the
|
||||
Library. A suitable mechanism is one that (a) uses at run time
|
||||
a copy of the Library already present on the user's computer
|
||||
system, and (b) will operate properly with a modified version
|
||||
of the Library that is interface-compatible with the Linked
|
||||
Version.
|
||||
|
||||
e) Provide Installation Information, but only if you would otherwise
|
||||
be required to provide such information under section 6 of the
|
||||
GNU GPL, and only to the extent that such information is
|
||||
necessary to install and execute a modified version of the
|
||||
Combined Work produced by recombining or relinking the
|
||||
Application with a modified version of the Linked Version. (If
|
||||
you use option 4d0, the Installation Information must accompany
|
||||
the Minimal Corresponding Source and Corresponding Application
|
||||
Code. If you use option 4d1, you must provide the Installation
|
||||
Information in the manner specified by section 6 of the GNU GPL
|
||||
for conveying Corresponding Source.)
|
||||
|
||||
5. Combined Libraries.
|
||||
|
||||
You may place library facilities that are a work based on the
|
||||
Library side by side in a single library together with other library
|
||||
facilities that are not Applications and are not covered by this
|
||||
License, and convey such a combined library under terms of your
|
||||
choice, if you do both of the following:
|
||||
|
||||
a) Accompany the combined library with a copy of the same work based
|
||||
on the Library, uncombined with any other library facilities,
|
||||
conveyed under the terms of this License.
|
||||
|
||||
b) Give prominent notice with the combined library that part of it
|
||||
is a work based on the Library, and explaining where to find the
|
||||
accompanying uncombined form of the same work.
|
||||
|
||||
6. Revised Versions of the GNU Lesser General Public License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions
|
||||
of the GNU Lesser General Public License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Library as you received it specifies that a certain numbered version
|
||||
of the GNU Lesser General Public License "or any later version"
|
||||
applies to it, you have the option of following the terms and
|
||||
conditions either of that published version or of any later version
|
||||
published by the Free Software Foundation. If the Library as you
|
||||
received it does not specify a version number of the GNU Lesser
|
||||
General Public License, you may choose any version of the GNU Lesser
|
||||
General Public License ever published by the Free Software Foundation.
|
||||
|
||||
If the Library as you received it specifies that a proxy can decide
|
||||
whether future versions of the GNU Lesser General Public License shall
|
||||
apply, that proxy's public statement of acceptance of any version is
|
||||
permanent authorization for you to choose that version for the
|
||||
Library.
|
||||
|
|
@ -1 +0,0 @@
|
|||
0.1.0
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
|
||||
(random-source-randomize! default-random-source)
|
||||
|
||||
(display (random-integer 100))
|
||||
(newline)
|
||||
Loading…
Reference in New Issue