From: Andreas Rottmann Subject: 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. --- NEWS | 4 ++ module/Makefile.am | 1 + module/srfi/srfi-27.scm | 86 +++++++++++++++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-27.test | 81 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 173 insertions(+), 0 deletions(-) diff --git a/NEWS b/NEWS index c6caed3..e4d1117 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,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/module/Makefile.am b/module/Makefile.am index a2fb0f3..588f560 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -252,6 +252,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 0000000..cb8aaf7 --- /dev/null +++ b/module/srfi/srfi-27.scm @@ -0,0 +1,86 @@ +;;; 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 not yet documented at all in the Guile 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)))) + +;; We ignore `unit', which should still be compliant behavior according to +;; SRFI-27. +(define* (random-source-make-reals s #:optional unit) + (lambda () + (random:uniform (random-source-state 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 eab1cd5..d9f3951 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -110,6 +110,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 0000000..bd1ebcc --- /dev/null +++ b/test-suite/tests/srfi-27.test @@ -0,0 +1,81 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; 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 program. If not, see . + +(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 are commented out 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. If you run +;; them manually, 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) + (pass-if "other number" + (not (= x1 (random-integer (expt 2 32))))))) + +#; +(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)))) + (pass-if "other number (0 1)" + (not (= x1 y1)))) + (random-source-state-set! default-random-source state1) + (random-source-pseudo-randomize! default-random-source 1 0) + (let ((y1 (random-integer (expt 2 32)))) + (pass-if "other number (1 0)" + (not (= x1 y1)))))) -- tg: (fe3f01f..) t/srfi-27-new (depends on: t/random-external t/fix-random-64bit)