1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
;;; random.lisp --- Random number generator.
;;; Author: R. Scott McIntire
;;; History:
;; Version 1.0: Aug 2003
(defpackage :rsm.random
(:use :common-lisp)
(:documentation
"This package provides a high quality random number generator.
Export Summary:
b-rand: Produces a uniform binary random number. That is its values are 0 or 1.
u-rand: Produces a uniform random number (double-float) on the interval [0,1).
i-rand: Produce a random number on the interval
[0, min(2^32, most-positive-fixnum)).
init : Initialize the random number generator.
set-rand: Set the seed of the random number generator.(takes one arg, a fixnum).
")
(:export
#:b-rand
#:init
#:i-rand
#:u-rand
))
(in-package rsm.random)
;;; To use the foreign function interface with the rule-30 random
;;; number generator. Add the following.
;;; Note: Since the ff's have been added after the in-package statement,
;;; they will be local to the package.
(eval-when (:load-toplevel :compile-toplevel :execute)
(uffi:def-function ("urand" u-rand) ()
:returning :double
:module "rsm-random")
(uffi:def-function ("brand" b-rand) ()
:returning :int
:module "rsm-random")
(uffi:def-function ("random" ii-rand) ()
:returning :int
:module "rsm-random")
(uffi:def-function ("rand_init" init)
((x :int))
:returning :void
:module "rsm-random")
(init 123451))
(defun i-rand ()
"Return a uniform random number on the interval
[0, min(2^32, most-positive-fixnum))."
(mod (ii-rand) most-positive-fixnum))
(defun init/current-time ()
"Initialize the random number generator using the current time."
(declare (optimize (speed 3) (debug 0) (safety 0) (space 0)))
(logand (+ (get-universal-time)
(get-internal-real-time))
#xFFFFFFFF))
(defun init/file-path (path-name)
"Initialize the random number generator using a seed from a file."
(with-open-file (str path-name :direction :input)
(let ((seed (parse-integer (read str) :junk-allowed t)))
(if seed
(init (logand (abs seed) #xFFFFFFFF))
(error "init/file-path: Bad seed from path ~s~%" path-name))
(init seed))))
|
