[PATCH] Support for SRFI 27

[PATCH] Support for SRFI 27

[Andreas Rottmann]

[-- Attachment #1: Type: text/plain, Size: 70 bytes --]

Hi!

Attached is my take on adding SRFI 27 "Sources of Random Bits".


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: srfi-27-new.diff --]
[-- Type: text/x-diff, Size: 8268 bytes --]

From: Andreas Rottmann <a.rottmann@gmx.at>
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
+;; <http://www.gnu.org/licenses/>.
+
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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)

[-- Attachment #3: Type: text/plain, Size: 63 bytes --]


Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>

Re: [PATCH] Support for SRFI 27

[Ludovic Courtès]

Hello!

Andreas Rottmann <a.rottmann@gmx.at> writes:

> Attached is my take on adding SRFI 27 "Sources of Random Bits".

Nice!  Looks good to me.  Could you also add a node to
doc/ref/srfi-modules.texi?

> +;; 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.

Perhaps you could run them anyway and throw 'unresolved when they appear
to fail?  The guardian tests do that when it’s impossible to determine
whether it’s a failure or whether some unrelated phenomenon prevented
the test to pass.

Thanks,
Ludo’.

Re: [PATCH] Support for SRFI 27

[Andy Wingo]

On Sun 15 Aug 2010 07:57, ludo@gnu.org (Ludovic Courtès) writes:

> Hello!
>
> Andreas Rottmann <a.rottmann@gmx.at> writes:
>
>> Attached is my take on adding SRFI 27 "Sources of Random Bits".
>
> Nice!  Looks good to me.  Could you also add a node to
> doc/ref/srfi-modules.texi?

Yes, looks quite good to me!

Just a friendly ping to write some docs :)

>> +;; 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.
>
> Perhaps you could run them anyway and throw 'unresolved when they appear
> to fail?  The guardian tests do that when it’s impossible to determine
> whether it’s a failure or whether some unrelated phenomenon prevented
> the test to pass.

Agreed.

Cheers,

Andy
-- 
http://wingolog.org/