diff options
Diffstat (limited to 'random.scm')
| -rw-r--r-- | random.scm | 117 |
1 files changed, 56 insertions, 61 deletions
@@ -17,85 +17,80 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'byte) (require 'logical) -(define random:tap 24) -(define random:size 55) +(define (make-rng seed) + (define mutex #f) + (define idx 0) + (define idy 0) + (define sta (make-bytes 256)) + ; initialize state + (do ((idx #xff (+ -1 idx))) + ((negative? idx)) + (byte-set! sta idx idx)) -(define (random:size-int l) - (let ((trial (string->number (make-string l #\f) 16))) - (if (and (exact? trial) (>= most-positive-fixnum trial)) - l - (random:size-int (- l 1))))) -(define random:chunk-size (* 4 (random:size-int 8))) + (if (number? seed) + (set! seed (number->string seed))) -(define random:MASK - (string->number (make-string (quotient random:chunk-size 4) #\f) 16)) + ; merge seed into state + (do ((idx 0 (+ 1 idx)) + (kdx 0 (modulo (+ 1 kdx) seed-len)) + (seed-len (bytes-length seed))) + ((>= idx 256) (set! idy 0)) + (let ((swp (byte-ref sta idx))) + (set! idy (logand #xff (+ idy (byte-ref seed kdx) swp))) + (byte-set! sta idx (byte-ref sta idy)) + (byte-set! sta idy swp))) + ; spew + (lambda () + (if mutex (slib:error "random state called reentrantly")) + (set! mutex #t) + (set! idx (logand #xff (+ 1 idx))) + (let ((xtm (byte-ref sta idx))) + (set! idy (logand #xff (+ idy xtm))) + (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))))) + (set! mutex #f) + ans))))) (define *random-state* - '#( - "d909ef3e" "fd330ab3" "e33f7843" "76783fbd" "f3675fb3" - "b54ef879" "0be45590" "a6794679" "0bcd56d3" "fabcdef8" - "9cbd3efd" "3fd3efcd" "e064ef27" "dddecc08" "34444292" - "85444454" "4c519210" "c0366273" "54734567" "70abcddc" - "1bbdac53" "616c5a86" "a982efa9" "105996a0" "5f0cccba" - "1ea055e1" "fe2acd8d" "1891c1d4" "e6690270" "6912bccc" - "2678e141" "61222224" "907abcbb" "4ad6829b" "9cdd1404" - "57798841" "5b892496" "871c9cd1" "d1e67bda" "8b0a3233" - "578ef23f" "28274ef6" "823ef5ef" "845678c5" "e67890a5" - "5890abcb" "851fa9ab" "13efa13a" "b12278d6" "daf805ab" - "a0befc36" "0068a7b5" "e024fd90" "a7b690e2" "27f3571a" - 0)) + (make-rng "http://swissnet.ai.mit.edu/~jaffer/SLIB.html")) -(let ((random-strings *random-state*)) - (set! *random-state* (make-vector (+ random:size 1) 0)) - (let ((nibbles (quotient random:chunk-size 4))) - (do ((i 0 (+ i 1))) - ((= i random:size)) - (vector-set! - *random-state* i - (string->number (substring (vector-ref random-strings i) - 0 nibbles) - 16))))) - -;;; random:chunk returns an integer in the range of -;;; 0 to (- (expt 2 random:chunk-size) 1) -(define (random:chunk v) - (let* ((p (vector-ref v random:size)) - (ans (logical:logxor - (vector-ref v (modulo (- p random:tap) random:size)) - (vector-ref v p)))) - (vector-set! v p ans) - (vector-set! v random:size (modulo (- p 1) random:size)) - ans)) +;;; random:chunk returns an integer in the range of 0 to 255. +(define (random:chunk v) (v)) (define (random:random modu . args) (let ((state (if (null? args) *random-state* (car args)))) (if (exact? modu) - (do ((ilen 0 (+ 1 ilen)) - (s random:MASK - (+ random:MASK (* (+ 1 random:MASK) s)))) - ((>= s (- modu 1)) - (let ((slop (modulo (+ s (- 1 modu)) modu))) - (let loop ((n ilen) - (r (random:chunk state))) - (cond ((not (zero? n)) - (loop (+ -1 n) - (+ (* r (+ 1 random:MASK)) - (random:chunk state)))) - ((>= r slop) (modulo r modu)) - (else (loop ilen (random:chunk state)))))))) + (let ((bitlen (integer-length (+ -1 modu)))) + (do ((bln bitlen (+ -8 bln)) + (rbs 0 (+ (ash rbs 8) (random:chunk state)))) + ((<= bln 7) + (modulo + (if (zero? bln) rbs + (+ (ash rbs bln) + (logand (bit-field (random:chunk state) 0 bln)))) + modu)))) (* (random:uniform state) modu)))) ;;;random:uniform is in randinex.scm. It is needed only if inexact is ;;;supported. -(define (random:make-random-state . args) - (let ((state (if (null? args) *random-state* (car args)))) - (list->vector (vector->list state)))) +(define (make-random-state . args) + (let ((seed (if (null? args) + (do ((bts (make-bytes 10)) + (idx 0 (+ 1 idx))) + ((>= idx 10) bts) + (byte-set! bts idx (random:random 256))) + (let () + (require 'object->string) + (object->limited-string (car args) 20))))) + (make-rng seed))) (define random random:random) -(define make-random-state random:make-random-state) (provide 'random) ;to prevent loops (if (provided? 'inexact) (require 'random-inexact)) |