1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
;;;; "random.scm" Pseudo-Random number generator for scheme.
;;; Copyright (C) 1991, 1993, 1998, 1999, 2002, 2003 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
(require 'byte)
(require 'logical)
(require-if 'compiling 'object->string) ; for make-random-state
;;@code{(require 'random)}
;;@ftindex random
;;; random:chunk returns an integer in the range of 0 to 255.
;;; export for random-inexact:
;;@
(define (random:chunk sta)
(cond ((positive? (byte-ref sta 258))
(byte-set! sta 258 0)
(slib:error "random state called reentrantly")))
(byte-set! sta 258 1)
(let* ((idx (logand #xff (+ 1 (byte-ref sta 256))))
(xtm (byte-ref sta idx))
(idy (logand #xff (+ (byte-ref sta 257) xtm))))
(byte-set! sta 256 idx)
(byte-set! sta 257 idy)
(let ((ytm (byte-ref sta idy)))
(byte-set! sta idy xtm)
(byte-set! sta idx ytm)
(let ((ans (byte-ref sta (logand #xff (+ ytm xtm)))))
(byte-set! sta 258 0)
ans))))
;;@args n state
;;@args n
;;
;;@1 must be an exact positive integer. @0 returns an exact integer
;;between zero (inclusive) and @1 (exclusive). The values returned by
;;@0 are uniformly distributed from 0 to @1.
;;
;;The optional argument @2 must be of the type returned by
;;@code{(seed->random-state)} or @code{(make-random-state)}. It
;;defaults to the value of the variable @code{*random-state*}. This
;;object is used to maintain the state of the pseudo-random-number
;;generator and is altered as a side effect of calls to @code{random}.
(define (random modu . args)
(define state (if (null? args) *random-state* (car args)))
(define bitlen (integer-length (+ -1 modu)))
(define (rnd)
(do ((bln bitlen (+ -8 bln))
(rbs 0 (+ (arithmetic-shift rbs 8) (random:chunk state))))
((<= bln 7)
(if (positive? bln)
(set! rbs (logxor (arithmetic-shift rbs bln)
(random:chunk state))))
(if (< rbs modu) rbs (rnd)))))
(rnd))
;;@defvar *random-state*
;;Holds a data structure that encodes the internal state of the
;;random-number generator that @code{random} uses by default. The nature
;;of this data structure is implementation-dependent. It may be printed
;;out and successfully read back in, but may or may not function correctly
;;as a random-number state object in another implementation.
;;@end defvar
;;@args state
;;Returns a new copy of argument @1.
;;
;;@args
;;Returns a new copy of @code{*random-state*}.
(define (copy-random-state . sta)
(bytes-copy (if (null? sta) *random-state* (car sta))))
;;@body
;;Returns a new object of type suitable for use as the value of the
;;variable @code{*random-state*} or as a second argument to @code{random}.
;;The number or string @1 is used to initialize the state. If
;;@0 is called twice with arguments which are
;;@code{equal?}, then the returned data structures will be @code{equal?}.
;;Calling @0 with unequal arguments will nearly
;;always return unequal states.
(define (seed->random-state seed)
(define sta (make-bytes (+ 3 256) 0))
(if (number? seed) (set! seed (number->string seed)))
; initialize state
(do ((idx #xff (+ -1 idx)))
((negative? idx))
(byte-set! sta idx idx))
; merge seed into state
(do ((i 0 (+ 1 i))
(j 0 (modulo (+ 1 j) seed-len))
(seed-len (string-length seed))
(k 0))
((>= i 256))
(let ((swp (byte-ref sta i)))
(set! k (logand #xff (+ k
(modulo (char->integer (string-ref seed j)) 255)
swp)))
(byte-set! sta i (byte-ref sta k))
(byte-set! sta k swp)))
sta)
;;@args
;;@args obj
;;Returns a new object of type suitable for use as the value of the
;;variable @code{*random-state*} or as a second argument to @code{random}.
;;If the optional argument @var{obj} is given, it should be a printable
;;Scheme object; the first 50 characters of its printed representation
;;will be used as the seed. Otherwise the value of @code{*random-state*}
;;is used as the seed.
(define (make-random-state . args)
(let ((seed (if (null? args) *random-state* (car args))))
(cond ((string? seed))
((number? seed) (set! seed (number->string seed)))
(else (let ()
(require 'object->string)
(set! seed (object->limited-string seed 50)))))
(seed->random-state seed)))
;@
(define *random-state*
(make-random-state "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"))
|
