;;;; 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)

(import
  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)
  vector-lib)
(require-library
  data-structures
  numbers
  miscmacros
  random-source
  srfi-27 srfi-27-numbers
  vector-lib)

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

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

(define (*make-uniform-random-integers low high prec rndint)
  (let ((dist (- high low)))
    (if (< dist prec)
      (constantly prec)
      (let ((rng (quotient (+ dist 1) prec)))
        (cond
          ((= 0 rng)
            (constantly 0) )
          ((= 0 low)
            (if (= 1 prec)
              (lambda ()
                (rndint rng) )
              (lambda ()
                (* (rndint rng) prec) ) ) )
          (else
            (lambda ()
              (+ low (* (rndint rng) prec) ) ) ) ) ) ) ) )

(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)
  (let ((high (or high (- (*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