mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
1665ce9e98
Fixed this function to prevent an error when it is called. Unfortunately randon number generation is not very sophisticated yet, and needs improvement.
108 lines
3.5 KiB
Scheme
108 lines
3.5 KiB
Scheme
;;;; Cyclone Scheme
|
|
;;;; https://github.com/justinethier/cyclone
|
|
;;;;
|
|
;;;; Copyright 2016 Jason K. MacDuffie
|
|
;;;; License: MIT (Expat) License
|
|
;;;;
|
|
;;;; Right now this uses an LCG, and should probably be replaced
|
|
;;;; with a higher-quality implementation as soon as possible.
|
|
;;;; For casual use this will work OK.
|
|
|
|
(define-library (srfi 27)
|
|
(import (scheme base)
|
|
(scheme case-lambda)
|
|
(scheme time))
|
|
(export random-integer random-real default-random-source
|
|
next-mrg32k3a ;; TODO: only here for testing
|
|
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)
|
|
(begin
|
|
;; Numbers taken from bsd random
|
|
;(define mult 1103515245)
|
|
(define incr 12345)
|
|
(define m 536870912)
|
|
;; Cutting off seems like a good idea
|
|
;(define cutoff 100)
|
|
|
|
(define-c next-lcg
|
|
"(void *data, int argc, closure _, object k, object seed)"
|
|
"object result = NULL;
|
|
unsigned int s = obj_obj2int(seed);
|
|
unsigned int mult = 1103515245;
|
|
unsigned int incr = 12345;
|
|
unsigned int m = 536870912;
|
|
unsigned int next_seed = ((s * mult) + incr) % m;
|
|
result = obj_int2obj(next_seed);
|
|
return_closcall1(data, k, result);")
|
|
|
|
;; Testing this out
|
|
;; TODO: handle ints, too. of course that also adds overhead...
|
|
(define-c next-mrg32k3a
|
|
"(void *data, int argc, closure _, object k, object seed)"
|
|
"double dval = MRG32k3a( double_value(seed) );
|
|
{
|
|
make_double(result, dval);
|
|
return_closcall1(data, k, &result);
|
|
}")
|
|
|
|
(define-record-type <random-source>
|
|
(raw-random-source n)
|
|
random-souce?
|
|
(n random-source-val set-random-source-val!))
|
|
|
|
(define (make-random-source)
|
|
(raw-random-source incr))
|
|
|
|
(define (random-source-make-integers s)
|
|
(lambda (n)
|
|
(define nextval
|
|
(next-lcg (random-source-val s)))
|
|
(set-random-source-val! s nextval)
|
|
(modulo nextval n)))
|
|
|
|
(define random-source-make-reals
|
|
(case-lambda
|
|
((s)
|
|
(random-source-make-reals s (/ m)))
|
|
((s unit)
|
|
(if (not (< 0.0 unit 1.0))
|
|
(error "unit must be between 0.0 and 1.0 (exclusive), but got " unit))
|
|
(let ((numgen (random-source-make-integers s)))
|
|
(define r (exact (floor (/ unit))))
|
|
(lambda ()
|
|
(* (numgen r) unit))))))
|
|
|
|
(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))
|
|
|
|
(define (random-source-state-ref s)
|
|
;; Just return the integer
|
|
(random-source-val s))
|
|
|
|
(define (random-source-state-set! s state)
|
|
;; Just set the integer
|
|
(set-random-source-val! s state))
|
|
|
|
(define (random-source-pseudo-randomize! s i j)
|
|
;; Pretty bad quality, upgrade after switch to better gen
|
|
(define n1
|
|
i) ;((random-source-make-integers i) m))
|
|
(define n2
|
|
j) ;((random-source-make-integers j) m))
|
|
(define n3
|
|
(abs (+ n1 n2)))
|
|
(random-source-state-set! s n3))
|
|
|
|
(define (random-source-randomize! s)
|
|
;; True randomness would be a good idea here
|
|
(define i (current-second))
|
|
(define j (+ (current-second) 2))
|
|
(random-source-pseudo-randomize! s i j))))
|
|
|