#lang scheme/base ;;; PLT Scheme Science Collection ;;; random-source.ss ;;; Copyright (c) 2004-2008 M. Douglas Williams ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public ;;; License as published by the Free Software Foundation; either ;;; version 2.1 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Lesser General Public License for more details. ;;; ;;; You should have received a copy of the GNU Lesser General Public ;;; License along with this library; if not, write to the Free ;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA ;;; 02111-1307 USA. ;;; ;;; ------------------------------------------------------------------- ;;; ;;; This code adds some additional functionality to the PLT Scheme ;;; implementation of SRFI 27 provided with PLT Scheme V207 (and ;;; presumably later versions). ;;; ;;; The main additional functionality is to define a parameter, ;;; current-random-source, that provides a separate random stream ;;; reference for each thread. The default value for this random ;;; stream reference is default-random-stream as provided by SRFI 27. ;;; A guard procedure ensures that the value of current-random-source ;;; is indeed a random-source, otherwise a type error is raised. ;;; ;;; As of V371.1, there is a new implementation of SRFI 27 in PLT ;;; Scheme. The underlying PLT Scheme random source rountines were ;;; modified at some point to use the same algorithms as SRFI 27. ;;; The new SRFI 27 implemtation wrappers this functionality. There ;;; are a few differences between the old implementation and the new ;;; that required changes in this module. In particular, some of the ;;; SRFI 27 procedures are now macros. ;;; ;;; Instead of the set-random-source-state! procedure just being an ;;; alias for random-source-state-set!, it now calls it directly. ;;; This was done because the latter is now a macro and the aliasing ;;; does not work. However, this also breaks the ability to set the ;;; state of the default-random-source. ;;; ;;; Version Date Description ;;; 0.9.0 08/05/04 This is the initial release of the random ;;; source module to augment SRFI 27. (Doug ;;; Williams) ;;; 1.0.0 09/20/04 Marked as ready for Release 1.0. (Doug ;;; Williams) ;;; 1.0.1 07/13/05 Added make-random-source-vector. (Doug ;;; Williams) ;;; 1.0.2 10/18/05 Added optional second argument to ;;; make-random-source-vector. (Doug Williams) ;;; 1.0.3 08/24/07 Updated to be compatible with the new ;;; SRFI 27 implementation. (Doug Williams) ;;; 1.0.4 09/12/07 The SRFI 27 implementation is changing ;;; back to the same interface as before, i.e., ;;; no macros for the standard functionality. ;;; (Doug Williams) ;;; 2.0.0 11/17/07 Added unchecked version of functions and ;;; getting ready for PLT Scheme V4.0. (Doug ;;; Williams) ;;; 2.1.0 06/07/08 More V4.0 changes. (Doug Williams) (require (lib "contract.ss")) (require (lib "27.ss" "srfi")) (provide (all-from-out (lib "27.ss" "srfi")) current-random-source with-random-source with-new-random-source (rename-out (random-uniform-int unchecked-random-uniform-int) (random-uniform unchecked-random-uniform) (random-source-state unchecked-random-source-state) (set-random-source-state! unchecked-set-random-source-state!) (make-random-source-vector unchecked-make-random-source-vector))) (provide/contract (random-uniform-int (case-> (-> random-source? (and/c integer? (>=/c 1)) natural-number/c) (-> (and/c integer? (>=/c 1)) natural-number/c))) (random-uniform (case-> (-> random-source? (real-in 0.0 1.0)) (-> (real-in 0.0 1.0)))) (random-source-state (-> random-source? any)) (set-random-source-state! (-> random-source? any/c any)) (make-random-source-vector (case-> (-> natural-number/c natural-number/c (vectorof random-source?)) (-> natural-number/c (vectorof random-source?))))) ;;; Provide a parameter for the current random source - See PLT ;;; MzScheme: Language Manual, Section 7.7 Parameters. (define current-random-source (make-parameter default-random-source (lambda (x) (when (not (random-source? x)) (raise-type-error 'current-random-source "random-source" x)) x))) ;;; The macros with-random-source and with-new-random-source provide ;;; a convenient method for executing a body of code with a given ;;; random stream. The body is executed with current-random-source ;;; set to the specified random-source. (define-syntax with-random-source (syntax-rules () ((with-random-source random-source body ...) (parameterize ((current-random-source random-source)) body ...)))) (define-syntax with-new-random-source (syntax-rules () ((with-new-random-source body ...) (parameterize ((current-random-source (make-random-source))) body ...)))) ;;; The procedure random-uniform-int returns an integer in the range ;;; 0 ... n-1 using the specified random-source or (current-random- ;;; source) is none is specified. Note that the random-integer and ;;; random-real functions from SRFI 27 DO NOT understand (current- ;;; random-source) and always use default random-source. (define random-uniform-int (case-lambda ((r n) ;; Note that random-source-make-integers returns a procedure ;; that must be applied to get the random integer. Thus the ;; extra set of parentheses. ((random-source-make-integers r) n)) ((n) (random-uniform-int (current-random-source) n)))) ;;; The procedure random-uniform returns a double precision real in ;;; the range (0.0, 1.0) (non-inclusive) using the specified ;;; random-source or (current-random-source) if none is specified. ;;; Note that the random-integer and random-real functions from SRFI ;;; 27 DO NOT understand (current-random-source) and always use ;;; default-random-source. (define random-uniform (case-lambda ((r) ;; Note that random-source-make-reals returns a procedure that ;; must be applied to get the random number. Thus the extra ;; set of parentheses. ((random-source-make-reals r))) (() (random-uniform (current-random-source))))) ;;; Also provide alternatives to random-source-state-ref and ;;; random-source-state-set! from SRFI 27. (define random-source-state random-source-state-ref) (define set-random-source-state! random-source-state-set!) ;The following was needed at a point during the V371 timeframe when the ;SRFI 27 implementation was in flux. Basically, random-source-state-set! ; was implemented as a macro and was not a first-class object. ;(define (set-random-source-state! s state) ; (random-source-state-set! s state)) ;;; make-random-source-vector: natural x natural -> (vectorof random-source?) ;;; make-random-source-vector: natural -> (vectorof random-source?) (define make-random-source-vector (case-lambda ((n i) (let ((random-vector (make-vector n))) (do ((j 0 (+ j 1))) ((= j n) random-vector) (let ((random-stream (make-random-source))) (random-source-pseudo-randomize! random-stream i j) (vector-set! random-vector j random-stream))))) ((n) (let ((random-vector (make-vector n))) (do ((i 0 (+ i 1))) ((= i n) random-vector) (let ((random-stream (make-random-source))) (random-source-pseudo-randomize! random-stream i 0) (vector-set! random-vector i random-stream)))))))