Commit | Line | Data |
---|---|---|
56ec46a7 AR |
1 | ;;; srfi-27.scm --- Sources of Random Bits |
2 | ||
3 | ;; Copyright (C) 2010 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This library is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 3 of the License, or (at your option) any later version. | |
9 | ||
10 | ;; This library is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;; Lesser General Public License for more details. | |
14 | ||
15 | ;; You should have received a copy of the GNU Lesser General Public | |
16 | ;; License along with this library. If not, see | |
17 | ;; <http://www.gnu.org/licenses/>. | |
18 | ||
19 | ;;; Commentary: | |
20 | ||
21 | ;; This module is fully documented in the Guile Reference Manual. | |
22 | ||
23 | ;;; Code: | |
24 | ||
25 | (define-module (srfi srfi-27) | |
26 | #:export (random-integer | |
27 | random-real | |
28 | default-random-source | |
29 | make-random-source | |
30 | random-source? | |
31 | random-source-state-ref | |
32 | random-source-state-set! | |
33 | random-source-randomize! | |
34 | random-source-pseudo-randomize! | |
35 | random-source-make-integers | |
36 | random-source-make-reals) | |
37 | #:use-module (srfi srfi-9)) | |
38 | ||
edb6de0b MW |
39 | (cond-expand-provide (current-module) '(srfi-27)) |
40 | ||
56ec46a7 AR |
41 | (define-record-type :random-source |
42 | (%make-random-source state) | |
43 | random-source? | |
44 | (state random-source-state set-random-source-state!)) | |
45 | ||
46 | (define (make-random-source) | |
47 | (%make-random-source (seed->random-state 0))) | |
48 | ||
49 | (define (random-source-state-ref s) | |
50 | (random-state->datum (random-source-state s))) | |
51 | ||
52 | (define (random-source-state-set! s state) | |
53 | (set-random-source-state! s (datum->random-state state))) | |
54 | ||
55 | (define (random-source-randomize! s) | |
56 | (let ((time (gettimeofday))) | |
57 | (set-random-source-state! s (seed->random-state | |
58 | (+ (* (car time) 1e6) (cdr time)))))) | |
59 | ||
60 | (define (random-source-pseudo-randomize! s i j) | |
61 | (set-random-source-state! s (seed->random-state (i+j->seed i j)))) | |
62 | ||
63 | (define (i+j->seed i j) | |
64 | (logior (ash (spread i 2) 1) | |
65 | (spread j 2))) | |
66 | ||
67 | (define (spread n amount) | |
68 | (let loop ((result 0) (n n) (shift 0)) | |
69 | (if (zero? n) | |
70 | result | |
71 | (loop (logior result | |
72 | (ash (logand n 1) shift)) | |
73 | (ash n -1) | |
74 | (+ shift amount))))) | |
75 | ||
76 | (define (random-source-make-integers s) | |
77 | (lambda (n) | |
78 | (random n (random-source-state s)))) | |
79 | ||
80 | (define random-source-make-reals | |
81 | (case-lambda | |
82 | ((s) | |
83 | (lambda () | |
84 | (let loop () | |
85 | (let ((x (random:uniform (random-source-state s)))) | |
86 | (if (zero? x) | |
87 | (loop) | |
88 | x))))) | |
89 | ((s unit) | |
90 | (or (and (real? unit) (< 0 unit 1)) | |
91 | (error "unit must be real between 0 and 1" unit)) | |
92 | (random-source-make-reals s)))) | |
93 | ||
94 | (define default-random-source (make-random-source)) | |
95 | (define random-integer (random-source-make-integers default-random-source)) | |
96 | (define random-real (random-source-make-reals default-random-source)) |