From 56ec46a7c3f8761b3e1f4fb2f957882636fbaaee Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Mon, 27 Sep 2010 22:15:51 +0200 Subject: [PATCH] Add implementation of SRFI 27 * module/srfi/srfi-27.scm: New file; implementation of SRFI 27 in terms of the existing random number generator. * module/Makefile.am (SRFI_SOURCES): Add srfi/srfi-27.scm. * test-suite/tests/srfi-27.test: New file; minimal test suite for SRFI 27. * test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-27.test. * doc/ref/srfi-modules.texi: Add subsection on SRFI-27 based on the specification. --- NEWS | 4 + doc/ref/srfi-modules.texi | 155 ++++++++++++++++++++++++++++++++++ module/Makefile.am | 1 + module/srfi/srfi-27.scm | 94 +++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-27.test | 91 ++++++++++++++++++++ 6 files changed, 346 insertions(+) create mode 100644 module/srfi/srfi-27.scm create mode 100644 test-suite/tests/srfi-27.test diff --git a/NEWS b/NEWS index 85f81e598..0449b1d41 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,10 @@ latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0. Changes in 1.9.12 (since the 1.9.11 prerelease): +** Support for SRFI-27 + +SRFI-27 "Sources of Random Bits" is now available. + ** Many R6RS bugfixes `(rnrs bytevectors)' and `(rnrs io ports)' now have version information, diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 0d74202b5..188a71c8f 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -36,6 +36,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-18:: Multithreading support * SRFI-19:: Time/Date library. * SRFI-26:: Specializing parameters +* SRFI-27:: Sources of Random Bits * SRFI-30:: Nested multi-line block comments * SRFI-31:: A special form `rec' for recursive evaluation * SRFI-34:: Exception handling. @@ -3226,6 +3227,160 @@ or similar is typical. @end example @end deffn +@node SRFI-27 +@subsection SRFI-27 - Sources of Random Bits +@cindex SRFI-27 + +@c This subsection is based on the specification of SRFI-27, which has +@c the following license: + +@c Copyright (C) Sebastian Egner (2002). All Rights Reserved. + +@c Permission is hereby granted, free of charge, to any person obtaining a +@c copy of this software and associated documentation files (the +@c "Software"), to deal in the Software without restriction, including +@c without limitation the rights to use, copy, modify, merge, publish, +@c distribute, sublicense, and/or sell copies of the Software, and to +@c permit persons to whom the Software is furnished to do so, subject to +@c the following conditions: + +@c The above copyright notice and this permission notice shall be included +@c in all copies or substantial portions of the Software. + +@c THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +@c OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +@c MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +@c NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +@c LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +@c OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +@c WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + +This SRFI provides access to a (pseudo) random number generator; for +Guile's built-in random number facilities, which SRFI-27 is implemented +upon, @xref{Random}. With SRFI-27, random numbers are obtained from a +@emph{random source}, which encapsulates a random number generation +algorithm and its state. + +@menu +* SRFI-27 Default Random Source:: Obtaining random numbers +* SRFI-27 Random Sources:: Creating and manipulating random sources +* SRFI-27 Random Number Generators:: Obtaining random number generators +@end menu + +@node SRFI-27 Default Random Source +@subsubsection The Default Random Source +@cindex SRFI-27 + +@defun random-integer n +Return a random number between zero (inclusive) and @var{n} (exclusive), +using the default random source. The numbers returned have a uniform +distribution. +@end defun + +@defun random-real +Return a random number in (0,1), using the default random source. The +numbers returned have a uniform distribution. +@end defun + +@defun default-random-source +A random source from which @code{random-integer} and @code{random-real} +have been derived using @code{random-source-make-integers} and +@code{random-source-make-reals} (@pxref{SRFI-27 Random Number Generators} +for those procedures). Note that an assignment to +@code{default-random-source} does not change @code{random-integer} or +@code{random-real}; it is also strongly recommended not to assign a new +value. +@end defun + +@node SRFI-27 Random Sources +@subsubsection Random Sources +@cindex SRFI-27 + +@defun make-random-source +Create a new random source. The stream of random numbers obtained from +each random source created by this procedure will be identical, unless +its state is changed by one of the procedures below. +@end defun + +@defun random-source? object +Tests whether @var{object} is a random source. Random sources are a +disjoint type. +@end defun + +@defun random-source-randomize! source +Attempt to set the state of the random source to a truly random value. +The current implementation uses a seed based on the current system time. +@end defun + +@defun random-source-pseudo-randomize! source i j +Changes the state of the random source s into the initial state of the +(@var{i}, @var{j})-th independent random source, where @var{i} and +@var{j} are non-negative integers. This procedure provides a mechanism +to obtain a large number of independent random sources (usually all +derived from the same backbone generator), indexed by two integers. In +contrast to @code{random-source-randomize!}, this procedure is entirely +deterministic. +@end defun + +The state associated with a random state can be obtained an reinstated +with the following procedures: + +@defun random-source-state-ref source +@defunx random-source-state-set! source state +Get and set the state of a random source. No assumptions should be made +about the nature of the state object, besides it having an external +representation (i.e. it can be passed to @code{write} and subsequently +@code{read} back). +@end defun + +@node SRFI-27 Random Number Generators +@subsubsection Obtaining random number generator procedures +@cindex SRFI-27 + +@defun random-source-make-integers source +Obtains a procedure to generate random integers using the random source +@var{source}. The returned procedure takes a single argument @var{n}, +which must be a positive integer, and returns the next uniformly +distributed random integer from the interval @{0, ..., @var{n}-1@} by +advancing the state of @var{source}. + +If an application obtains and uses several generators for the same +random source @var{source}, a call to any of these generators advances +the state of @var{source}. Hence, the generators do not produce the +same sequence of random integers each but rather share a state. This +also holds for all other types of generators derived from a fixed random +sources. + +While the SRFI text specifies that ``Implementations that support +concurrency make sure that the state of a generator is properly +advanced'', this is currently not the case in Guile's implementation of +SRFI-27, as it would cause a severe performance penalty. So in +multi-threaded programs, you either must perform locking on random +sources shared between threads yourself, or use different random sources +for multiple threads. +@end defun + +@defun random-source-make-reals source +@defunx random-source-make-reals source unit +Obtains a procedure to generate random real numbers @math{0 < x < 1} +using the random source @var{source}. The procedure rand is called +without arguments. + +The optional parameter @var{unit} determines the type of numbers being +produced by the returned procedure and the quantization of the output. +@var{unit} must be a number such that @math{0 < @var{unit} < 1}. The +numbers created by the returned procedure are of the same numerical type +as @var{unit} and the potential output values are spaced by at most +@var{unit}. One can imagine rand to create numbers as @var{x} * +@var{unit} where @var{x} is a random integer in @{1, ..., +floor(1/unit)-1@}. Note, however, that this need not be the way the +values are actually created and that the actual resolution of rand can +be much higher than unit. In case @var{unit} is absent it defaults to a +reasonably small value (related to the width of the mantissa of an +efficient number format). +@end defun + @node SRFI-30 @subsection SRFI-30 - Nested Multi-line Comments @cindex SRFI-30 diff --git a/module/Makefile.am b/module/Makefile.am index aad8c7080..4ab649ba9 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -248,6 +248,7 @@ SRFI_SOURCES = \ srfi/srfi-18.scm \ srfi/srfi-19.scm \ srfi/srfi-26.scm \ + srfi/srfi-27.scm \ srfi/srfi-31.scm \ srfi/srfi-34.scm \ srfi/srfi-35.scm \ diff --git a/module/srfi/srfi-27.scm b/module/srfi/srfi-27.scm new file mode 100644 index 000000000..9777acea6 --- /dev/null +++ b/module/srfi/srfi-27.scm @@ -0,0 +1,94 @@ +;;; srfi-27.scm --- Sources of Random Bits + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; 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 3 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, see +;; . + +;;; Commentary: + +;; This module is fully documented in the Guile Reference Manual. + +;;; Code: + +(define-module (srfi srfi-27) + #:export (random-integer + random-real + default-random-source + make-random-source + random-source? + random-source-state-ref + random-source-state-set! + random-source-randomize! + random-source-pseudo-randomize! + random-source-make-integers + random-source-make-reals) + #:use-module (srfi srfi-9)) + +(define-record-type :random-source + (%make-random-source state) + random-source? + (state random-source-state set-random-source-state!)) + +(define (make-random-source) + (%make-random-source (seed->random-state 0))) + +(define (random-source-state-ref s) + (random-state->datum (random-source-state s))) + +(define (random-source-state-set! s state) + (set-random-source-state! s (datum->random-state state))) + +(define (random-source-randomize! s) + (let ((time (gettimeofday))) + (set-random-source-state! s (seed->random-state + (+ (* (car time) 1e6) (cdr time)))))) + +(define (random-source-pseudo-randomize! s i j) + (set-random-source-state! s (seed->random-state (i+j->seed i j)))) + +(define (i+j->seed i j) + (logior (ash (spread i 2) 1) + (spread j 2))) + +(define (spread n amount) + (let loop ((result 0) (n n) (shift 0)) + (if (zero? n) + result + (loop (logior result + (ash (logand n 1) shift)) + (ash n -1) + (+ shift amount))))) + +(define (random-source-make-integers s) + (lambda (n) + (random n (random-source-state s)))) + +(define random-source-make-reals + (case-lambda + ((s) + (lambda () + (let loop () + (let ((x (random:uniform (random-source-state s)))) + (if (zero? x) + (loop) + x))))) + ((s unit) + (or (and (real? unit) (< 0 unit 1)) + (error "unit must be real between 0 and 1" unit)) + (random-source-make-reals s)))) + +(define default-random-source (make-random-source)) +(define random-integer (random-source-make-integers default-random-source)) +(define random-real (random-source-make-reals default-random-source)) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index c504587d0..22f31d90c 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -113,6 +113,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/srfi-14.test \ tests/srfi-19.test \ tests/srfi-26.test \ + tests/srfi-27.test \ tests/srfi-31.test \ tests/srfi-34.test \ tests/srfi-35.test \ diff --git a/test-suite/tests/srfi-27.test b/test-suite/tests/srfi-27.test new file mode 100644 index 000000000..4b153d2ae --- /dev/null +++ b/test-suite/tests/srfi-27.test @@ -0,0 +1,91 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2002 Sebastian Egner +;;; +;;; This code is based on the file conftest.scm in the reference +;;; implementation of SRFI-27, provided under the following license: +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the +;;; "Software"), to deal in the Software without restriction, including +;;; without limitation the rights to use, copy, modify, merge, publish, +;;; distribute, sublicense, and/or sell copies of the Software, and to +;;; permit persons to whom the Software is furnished to do so, subject to +;;; the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;;; SOFTWARE. + +(define-module (test-srfi-27) + #:use-module (test-suite lib) + #:use-module (srfi srfi-27)) + +(with-test-prefix "large integers" + (pass-if "in range" + (let loop ((k 0) (n 1)) + (cond ((> k 1024) + #t) + ((<= 0 (random-integer n) (- n 1)) + (loop (+ k 1) (* n 2))) + (else + #f))))) + +(with-test-prefix "reals" + (pass-if "in range" + (let loop ((k 0) (n 1)) + (if (> k 1000) + #t + (let ((x (random-real))) + (if (< 0 x 1) + (loop (+ k 1) (* n 2)) + #f)))))) + +(with-test-prefix "get/set state" + (let* ((state1 (random-source-state-ref default-random-source)) + (x1 (random-integer (expt 2 32))) + (state2 (random-source-state-ref default-random-source)) + (x2 (random-integer (expt 2 32)))) + (random-source-state-set! default-random-source state1) + (pass-if "state1" + (= x1 (random-integer (expt 2 32)))) + (random-source-state-set! default-random-source state2) + (pass-if "state2" + (= x2 (random-integer (expt 2 32)))))) + +;; These tests throw 'unresolved instead of failing since it /could/ +;; happen that `random-source-randomize!' (or +;; `random-source-pseudo-randomize!') puts the RNG into a state where +;; it generates the same number as before. They should have a very high +;; chance of passing, though. + +(with-test-prefix "randomize!" + (let* ((state1 (random-source-state-ref default-random-source)) + (x1 (random-integer (expt 2 32)))) + (random-source-state-set! default-random-source state1) + (random-source-randomize! default-random-source) + (if (= x1 (random-integer (expt 2 32))) + (throw 'unresolved)))) + +(with-test-prefix "pseudo-randomize!" + (let* ((state1 (random-source-state-ref default-random-source)) + (x1 (random-integer (expt 2 32)))) + (random-source-state-set! default-random-source state1) + (random-source-pseudo-randomize! default-random-source 0 1) + (let ((y1 (random-integer (expt 2 32)))) + (if (= x1 y1) + (throw 'unresolved))) + (random-source-state-set! default-random-source state1) + (random-source-pseudo-randomize! default-random-source 1 0) + (let ((y1 (random-integer (expt 2 32)))) + (if (= x1 y1) + (throw 'unresolved))))) -- 2.20.1