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

(module srfi.27.uniform-random

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

(import scheme
  (chicken base)
  (chicken type)
  (chicken string)
  (only miscmacros exchange!)
  vector-lib
  (only (srfi 27) current-random-source)
  (type-checks-numbers integer)
  random-source
  (only srfi-27-numbers check-real-precision))

;;;

(include-relative "srfi-27-common-types")

(: *make-uniform-random-integers (number number number random-integer-function -> number-function))
(: make-uniform-random-integers (#!rest -> number-function procedure))
(: make-uniform-random-reals (#!rest -> number-function procedure))

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

;; Support

(define (*make-uniform-random-integers low high prec rndint)
  (let ((dist (abs (- high low))))
    ;not enough room
    (if (< dist prec)
        ;then what single
        (constantly low)
        ;else could fit
        (let ((rng (quotient (+ dist 1) prec)))
                ;not enough room then single
          (cond ((= 0 rng)
                  (constantly low) )
                ;identity special case?
                ((= 0 low)
                  (if (= 1 prec)
                      (lambda () (rndint rng))
                      (lambda () (* (rndint rng) prec))))
                ;else general case
                (else
                  (lambda () (+ low (* (rndint rng) prec))) ) ) ) ) ) )

;;;

(define (make-uniform-random-integers #!key high low precision source)
  ;delay the argument check until known if supplied or default
  (let ((high (if (not high) (- (*random-source-maximum-range source) 1)
                  (check-integer 'make-uniform-random-integers high 'high)))
        (low (if (not low) 0
                 (check-integer 'make-uniform-random-integers low 'low)))
        (precision (if (not precision) 1
                       (check-positive-integer
                        'make-uniform-random-integers precision 'precision)))
        (source (if (not source) (current-random-source)
                    (check-random-source 'make-uniform-random-integers source 'source))) )
    (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 precision

(define (make-uniform-random-reals #!key precision source)
  ;delay the argument check until known if supplied or default
  (let ((precision (and precision
                        (check-real-precision
                         'make-uniform-random-reals precision 'precision)))
        (source (if (not source) (current-random-source)
                    (check-random-source 'make-uniform-random-reals source 'source))) )
    (values ((@random-source-make-reals source) precision)
            (lambda () (values precision source)) ) ) )

) ;module srfi.27.uniform-random