;;;; composite-random-source.scm
;;;; Kon Lovett, Oct '09

(module composite-random-source

  (;export
    *composite-random-source
    composite-random-source)

  (import
    scheme
    chicken
    (only data-structures conc reverse-string-append ->string intersperse)
    (only type-errors error-argument-type)
    random-source)

  (require-library data-structures type-errors random-source)

;; *composite-random-source
;;
;; returns the composite constructor

(define *composite-random-source
  (let ((random-states?
         (lambda (obj k n)
           (and
            (pair? obj)
            (eq? k (car obj))
            (list? obj)
            (= n (- (length obj) 1)))))
        (state-ref
          (lambda (s)
            ((@random-source-state-ref s))))
        (state-set!
          (lambda (s state)
            ((@random-source-state-ref s) state)))
        (make-integers
          (lambda (s)
            ((@random-source-make-integers s)))) )
    (lambda (comb-int comb-real name docu log2-period maxrng srcs)
      (let ((srcs-cnt (length srcs))
            (make-integers (map make-integers srcs)) )
        (letrec ((ctor
                  (lambda (#!optional (name name) (docu docu))
                    (*make-random-source
                      ;
                      ctor
                      ;
                      name
                      ;
                      docu
                      ;
                      log2-period
                      ;
                      maxrng
                      ;entropy-source
                      ;FIXME provide combine entropy-source
                      #f
                      ;state-ref
                      (lambda ()
                        (cons name (map state-ref srcs)))
                      ;state-set!
                      (lambda (state)
                        (if (random-states? state name srcs-cnt)
                          (for-each state-set! srcs (cdr state))
                          (error-argument-type
                            (string->symbol (conc name #\- 'state-set!))
                            state
                            'composite-random-state) ) )
                      ;randomize!
                      (lambda (e)
                        (for-each
                          (lambda (s)
                            ((@random-source-randomize! s) e))
                          srcs) )
                      ;pseudo-randomize!
                      (lambda (i j)
                        (for-each
                          (lambda (s)
                            ((@random-source-pseudo-randomize! s) i j) )
                          srcs) )
                      ;make-integers
                      (lambda ()
                        (lambda (n)
                          (comb-int (map (cut <> n) make-integers) n)))
                      ;make-reals
                      (lambda (unit)
                        (let ((makrels
                                (map
                                  (lambda (s)
                                    ((@random-source-make-reals s) unit) )
                                  srcs)))
                          (lambda ()
                            (comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) )
          ctor ) ) ) ) )

;; 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 srcs0
          #!key
            (comb-int (lambda (ints n) (modulo (apply + ints) n)))
            (comb-real (lambda (reals unit) (apply * reals))))
  ; scrub keyword arguments
  (let ((srcs
          (let loop ((isrcs srcs0) (osrcs '()))
            (if (null? isrcs)
              (if (null? osrcs)
                (error 'composite-random-source "no random-sources to combine")
                (reverse osrcs) ) )
              (if (keyword? (car isrcs)) (loop (cddr isrcs) osrcs)
                (begin
                  (check-random-source 'composite-random-source (car isrcs))
                  (loop (cdr isrcs) (cons (car isrcs) osrcs)) ) ) ) ) )
    ; collect features
    (let loop ((srcs srcs) (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)
            srcs)
          ;else collect info
          (let ((s (car srcs)))
            (loop (cdr srcs)
                  (cons (->string (*random-source-name s)) names)
                  (cons (*random-source-documentation s) docus)
                  (cons (*random-source-log2-period s) log2-periods)
                  (cons (*random-source-maximum-range s) maxrngs)) ) ) ) ) )

) ; module composite-random-source