;;;; srfi-27-uniform-random.scm
;;;; Kon Lovett, Feb '10

(module srfi-27-uniform-random

  (;export
    *make-uniform-random-integers
    make-uniform-random-integers
    make-uniform-random-reals)

  (import
    (except scheme + - * quotient = <)
    chicken
    data-structures
    (only numbers + - * quotient = <)
    (only miscmacros exchange!)
    random-source
    (only srfi-27 current-random-source)
    (only srfi-27-numbers
      check-integer check-positive-integer
      check-real-precision))

  (require-library
    miscmacros
    vector-lib numbers
    random-source srfi-27 srfi-27-numbers)

  (declare (not usual-integrations + - * quotient = <))

;;; Uniform random integers in [low high] by precision

(define (*make-uniform-random-integers low high precision rand)
  (let ((range (quotient (+ (- high low) 1) precision)))
    (cond
      ((< (- high low) precision)
        (constantly precision))
      ((= 0 range)
        (constantly 0))
      ((and (= 0 low) (= 1 precision))
        (lambda () (rand range)))
      ((= 0 low)
        (lambda () (* (rand range) precision)))
      (else
        (lambda () (+ low (* (rand range) precision))))) ) )

(define (make-uniform-random-integers
          #!key (high #f) (low 0) (precision 1) (source (current-random-source)))
  (check-random-source 'make-uniform-random-integers source 'source)
  (unless high (set! high (- (*random-source-maximum-range source) 1))) ;(- (*random-source-maximum-range source) 1)
  (check-integer 'make-uniform-random-integers high 'high)
  (check-integer 'make-uniform-random-integers low 'low)
  (check-positive-integer 'make-uniform-random-integers precision 'precision)
  (values
    (*make-uniform-random-integers low high precision ((@random-source-make-integers source)))
    (lambda () (values high low precision source)) ) )

;;; Uniform random reals in (0.0 1.0) by precion

(define (make-uniform-random-reals
          #!key (precision #f) (source (current-random-source)))
  (check-random-source 'make-uniform-random-reals source 'source)
  (when precision (check-real-precision 'make-uniform-random-reals precision 'precision))
  (values
    ((@random-source-make-reals source) precision)
    (lambda () (values precision source)) ) )

) ;module srfi-27-uniform-random