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:
parent
ea9f4f4b15
commit
56ec46a7c3
6 changed files with 346 additions and 0 deletions
4
NEWS
4
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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
94
module/srfi/srfi-27.scm
Normal 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))
|
||||
|
|
@ -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 \
|
||||
|
|
|
|||
91
test-suite/tests/srfi-27.test
Normal file
91
test-suite/tests/srfi-27.test
Normal 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)))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue