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.
This commit is contained in:
Andreas Rottmann 2010-09-27 22:15:51 +02:00 committed by Andy Wingo
commit 56ec46a7c3
6 changed files with 346 additions and 0 deletions

4
NEWS
View file

@ -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,

View file

@ -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

View file

@ -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 \

94
module/srfi/srfi-27.scm Normal file
View file

@ -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
;; <http://www.gnu.org/licenses/>.
;;; 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))

View file

@ -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 \

View file

@ -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)))))