fantasy-vacation-planner/lib/random.scm

(library (lib random)
  (export make-random-integer-generator
          try-for-probability
          choose-random-element)
  (import
    (except (rnrs base) error)
    (only (guile) lambda* λ values error
          ;; random numbers
          random:uniform
          )
    ;; SRFI-27 for random number utilities
    (srfi srfi-27)))


(define make-random-integer-generator
  (lambda* (#:key seed)
    "Get a procedure for generating uniformly distributed
random integers from 0 up to a not included bound, which is
seeded by the keyword argument seed, which must be a
positive integer."
    (cond
     [seed
      (let ([rand-src (make-random-source)])
        ;; Set the given seed to guarantee same results for
        ;; same invokations.
        (random-source-pseudo-randomize! rand-src 0 seed)
        ;; Obtain a procedure, which gives uniformly
        ;; distributed integers.
        (random-source-make-integers rand-src))]
     [else
      (let ([rand-src (make-random-source)])
        ;; Try to make the random source truly random. How
        ;; this works depends on the specific implementation
        ;; of SRFI-27.
        (random-source-randomize! rand-src)
        (random-source-make-integers rand-src))])))


(define try-for-probability
  (lambda* (probability #:key (random-state #f))
    "Generate a random inexact uniformly distributed float
between [0,1) and test, if it is less than the given
PROBABILITY. Return #t if the number is smaller than the
given PROBABILITY and #t if the number is equal of bigger
the given PROBABILITY. If a RANDOM-STATE is given, use the
RANDOM-STATE to generate the random number and return both
the number and the updated RANDOM-STATE."
    (cond
     [random-state
      (values (< (random:uniform random-state) probability)
              random-state)]
     [else
      (< (random:uniform) probability)])))


(define choose-random-element
  (lambda* (seq #:key (rand-int-gen (make-random-integer-generator)))
    (cond
     [(pair? seq)
      (let* ([vec (list->vector seq)]
             [random-index (rand-int-gen (vector-length vec))])
        (vector-ref vec random-index))]
     [(vector? seq)
      (vector-ref seq (rand-int-gen (vector-length seq)))]
     [else
      (error "expected sequence of type list or vector, got:" seq)])))