#lang racket ;;; Science Collection ;;; random-source.rkt ;;; Copyright (c) 2004-2011 M. Douglas Williams ;;; ;;; This file is part of the Science Collection. ;;; ;;; The Science Collection 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 3 of the License ;;; or (at your option) any later version. ;;; ;;; The Science Collection is distributed in the hope that it will be useful, ;;; but WITHOUT 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 the Science Collection. If not, see ;;; <http://www.gnu.org/licenses/>. ;;; ;;; ----------------------------------------------------------------------------- ;;; ;;; 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 ;;; around this functionality. There are a few differences between the old ;;; implementation and the new one that required changes in this module. In ;;; particular, some of the SRFI 27 procedures are now macros. [This has been ;;; reverted in PLT Scheme.] ;;; ;;; The following is OBE. ;;; 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. (MDW) ;;; 1.0.0 09/20/04 Marked as ready for Release 1.0. (MDW) ;;; 1.0.1 07/13/05 Added make-random-source-vector. (MDW) ;;; 1.0.2 10/18/05 Added optional second argument to ;;; make-random-source-vector. (MDW) ;;; 1.0.3 08/24/07 Updated to be compatible with the new SRFI 27 ;;; implementation. (MDW) ;;; 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. (MDW) ;;; 2.0.0 11/17/07 Added unchecked version of functions and getting ready for ;;; PLT Scheme V4.0. (MDW) ;;; 2.1.0 06/07/08 More PLT Scheme V4.0 changes. (MDW) ;;; 4.0.0 05/12/10 Changed the header and restructured the code. (MDW) (require srfi/27) ;;; 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-rule (with-random-source random-source body ...) (parameterize ((current-random-source random-source)) body ...)) (define-syntax-rule (with-new-random-source body ...) (parameterize ((current-random-source (make-random-source))) body ...)) ;;; (random-uniform-int r n) -> exact-nonnegative-integer? ;;; r : random-source? ;;; n : exact-positive-integer? ;;; (random-uniform-int n) -> exact-nonnegative-integer? ;;; n : exact-positive-integer? ;;; 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)))) ;;; (random-uniform r) -> (and/c inexact-real? (real-in 0.0 1.0)) ;;; r : random-source? ;;; (random-uniform) -> (and/c inexact-real? (real-in 0.0 1.0)) ;;; 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 n i) -> (vectorof random-source) ;;; n : exact-nonnegative-integer? ;;; i : exact-non-negative-integer? ;;; (make-random-source-vector n) -> (vectorof random-source) ;;; n : exact-nonnegative-integer? (define make-random-source-vector (case-lambda ((n i) (build-vector n (lambda (j) (let ((random-stream (make-random-source))) (random-source-pseudo-randomize! random-stream i j) random-stream)))) ((n) (build-vector n (lambda (j) (let ((random-stream (make-random-source))) (random-source-pseudo-randomize! random-stream 0 j) random-stream)))))) ;;; Module Contracts (provide (all-from-out srfi/27) 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? exact-positive-integer? exact-nonnegative-integer?) (-> exact-positive-integer? exact-nonnegative-integer?))) (random-uniform (case-> (-> random-source? (and/c inexact-real? (real-in 0.0 1.0))) (-> (and/c inexact-real? (real-in 0.0 1.0))))) (random-source-state (-> random-source? any)) (set-random-source-state! (-> random-source? any/c void?)) (make-random-source-vector (case-> (-> exact-nonnegative-integer? exact-nonnegative-integer? (vectorof random-source?)) (-> exact-nonnegative-integer? (vectorof random-source?)))))