;;;; composite-random-source.scm
;;;; Kon Lovett, Oct '09
#|
=== Composite Random Source
==== Usage
(use composite-random-source)
==== composite-random-source
(composite-random-source [RANDOM-SOURCE ...] [#:comb-int (COMB-INT INTEGER-COMBINE)] [#:comb-real (COMB-REAL REAL-COMBINE)]) => random-source
Returns a new {{random-source}} that combines the behaviors of the supplied
{{RANDOM-SOURCE ...}}.
{{INTEGER-COMBINE}} default is {{(lambda (ints bnd) (modulo (apply + ints) bnd))}}.
{{REAL-COMBINE}} default is {{(lambda (reals prec) (apply * reals))}}.
Does not register the constructed {{random-source}}.
Experimental at best.
|#
(module composite-random-source
(;export
*composite-random-source
composite-random-source)
(import scheme chicken)
(import
(only data-structures conc reverse-string-append ->string intersperse)
(only type-errors error-argument-type))
(require-library data-structures type-errors)
(use srfi-1)
(use numbers)
(use random-source srfi-27-vector-support srfi-27)
;;
(define (pull-rest-argument rest0)
(let loop ((irest rest0) (orest '()))
(cond
((null? irest)
(reverse! orest) )
((keyword? (car irest))
(loop (cddr irest) orest) )
(else
(loop (cdr irest) (cons (car irest) orest)) ) ) ) )
;; composite-random-source
;;
;; returns the composite name & constructor
;;
;; ((list-of (integer exact (<= 0 _ _2))) (integer exact positive)
;; -> (integer exact (<= 0 _ _2)))
;;
;; composite-random-real
;; ((list-of (real inexact (< 0.0 _ 1.0))) #!optional (real inexact (< 0.0 _2 1.0))
;; -> (real inexact (< 0.0 _ 1.0)))
;FIXME - the combinators are suspect
(define (composite-random-source
#!rest rest0
#!key
(comb-int (lambda (ints n) (modulo (reduce + 0 ints) n)))
(comb-real (lambda (reals unit) (reduce * 1.0 reals))))
;scrub keyword arguments
(let* (
(rest (pull-rest-argument rest0) )
(srcs0
(if (null? rest)
(error 'composite-random-source "no random-sources to combine")
(map (cut check-random-source 'composite-random-source <>) rest) ) ) )
; collect features
(let loop ((srcs srcs0) (names '()) (docus '()) (log2-periods '()) (maxrngs '()))
(if (null? srcs)
;then make composed random-source
(*composite-random-source
comb-int comb-real
(string->symbol (reverse-string-append (intersperse names "+")))
(reverse-string-append (intersperse docus " & "))
;FIXME minimum? (if this is good then apply along the way)
(apply min log2-periods)
(apply min maxrngs)
srcs0)
;else collect info
(let ((rs (car srcs)))
(loop
(cdr srcs)
(cons (->string (*random-source-name rs)) names)
(cons (*random-source-documentation rs) docus)
(cons (*random-source-log2-period rs) log2-periods)
(cons (*random-source-maximum-range rs) maxrngs)) ) ) ) ) )
;; *composite-random-source
;;
;; returns the composite constructor
(define (*composite-random-source comb-int comb-real def-name def-docu log2-period maxrng srcs)
(let ((srcs-cnt (length srcs))
(composite-make-integers (map random-source-make-integers srcs)) )
(letrec (
(ctor
(lambda (#!optional (name def-name) (docu def-docu))
(let ((name-state-set!-id (string->symbol (conc name #\- 'state-set!))))
(*make-random-source
;
ctor
;
name
;
docu
;
log2-period
;
maxrng
;entropy-source
#f
;state-ref
(lambda ()
(cons name (map composite-state-ref srcs)))
;state-set!
(lambda (state)
(if (composite-random-state? state name srcs-cnt)
(for-each composite-state-set! srcs (cdr state))
(error-argument-type name-state-set!-id state 'composite-random-state) ) )
;randomize!
(lambda (es)
(for-each
(lambda (rs)
((@random-source-randomize! rs) es) )
srcs) )
;pseudo-randomize!
(lambda (i j)
(for-each
(lambda (rs)
((@random-source-pseudo-randomize! rs) i j) )
srcs) )
;make-integers
(lambda ()
(lambda (n)
(comb-int (map (cut <> n) composite-make-integers) n)))
;make-reals
(lambda (unit)
(let (
(makrels
(map
(lambda (rs)
((@random-source-make-reals rs) unit) )
srcs)))
(lambda ()
(comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) ) )
ctor ) ) )
(define (composite-random-state? obj k n)
(and
(pair? obj)
(eq? k (car obj))
(fx= n (fx- (length obj) 1)) ) )
(define (composite-state-ref s)
((@random-source-state-ref s)) )
(define (composite-state-set! s state)
((@random-source-state-set! s) state) )
) ;module composite-random-source