;;;; "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) (cond ((positive? bln) (set! rbs (logxor (arithmetic-shift rbs bln) (random:chunk state))) (if (>= rbs modu) (rnd) rbs)) ((>= rbs modu 1) (rnd)) ((positive? modu) rbs) (else (slib:error 'random 'not 'positive? modu)))))) (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"))