diff options
Diffstat (limited to 'random.scm')
| -rw-r--r-- | random.scm | 69 |
1 files changed, 35 insertions, 34 deletions
@@ -1,5 +1,5 @@ ;;;; "random.scm" Pseudo-Random number generator for scheme. -;;; Copyright (C) 1991, 1993, 1998, 1999 Aubrey Jaffer +;;; 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 @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;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. ; @@ -19,8 +19,14 @@ (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) @@ -39,34 +45,30 @@ ans)))) -;;@args n ;;@args n state -;;Accepts a positive integer or real @1 and returns a number of the -;;same type between zero (inclusive) and @1 (exclusive). The values -;;returned by @0 are uniformly distributed from 0 to @1. +;;@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 @var{state} 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}. +;;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) - (let ((state (if (null? args) *random-state* (car args)))) - (if (exact? modu) - (letrec ((bitlen (integer-length (+ -1 modu))) - (rnd (lambda () - (do ((bln bitlen (+ -8 bln)) - (rbs 0 (+ (ash rbs 8) (random:chunk state)))) - ((<= bln 7) - (set! rbs (+ (ash rbs bln) - (bit-field (random:chunk state) 0 bln))) - (and (< rbs modu) rbs)))))) - (do ((ans (rnd) (rnd))) (ans ans))) - (* (random:uniform1 state) modu)))) - -(define random:random random) -;;;random:uniform is in randinex.scm. It is needed only if inexact is -;;;supported. + (define state (if (null? args) *random-state* (car args))) + (define bitlen (integer-length (+ -1 modu))) + (define (rnd) + (do ((bln bitlen (+ -8 bln)) + (rbs 0 (+ (ash rbs 8) (random:chunk state)))) + ((<= bln 7) + (if (positive? bln) + (set! rbs (logxor (ash rbs bln) + (random:chunk state)))) + (if (< rbs modu) rbs (rnd))))) + (rnd)) ;;@defvar *random-state* @@ -84,7 +86,7 @@ ;;@args ;;Returns a new copy of @code{*random-state*}. (define (copy-random-state . sta) - (string-copy (if (null? sta) *random-state* (car sta)))) + (bytes-copy (if (null? sta) *random-state* (car sta)))) ;;@body @@ -105,11 +107,13 @@ ; merge seed into state (do ((i 0 (+ 1 i)) (j 0 (modulo (+ 1 j) seed-len)) - (seed-len (bytes-length seed)) + (seed-len (string-length seed)) (k 0)) ((>= i 256)) (let ((swp (byte-ref sta i))) - (set! k (logand #xff (+ k (byte-ref seed j) swp))) + (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) @@ -131,9 +135,6 @@ (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")) - -(provide 'random) ;to prevent loops -(if (provided? 'inexact) (require 'random-inexact)) |