guile-random-utils/random-utils.scm

(library (random-utils)
  (export make-random-integer-generator
          try-for-probability
          choose-random-element
          fisher-yates-shuffle)
  (import
    (except (rnrs base) error)
    (only (guile) lambda* λ values error
          ;; random numbers
          random:uniform
          ;; vectors
          list->vector
          vector-ref
          vector?)
    ;; 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)])))


(define fisher-yates-shuffle
  (lambda* (lst #:key (seed #f))
    (let ([get-rand-int (make-random-integer-generator #:seed seed)]
          [lst-as-vec (list->vector lst)])
      (let loop
          ;; Build up a list as result, which contains the elements of the
          ;; original list.
          ([result '()]
           ;; The list needs to have the same amount of elements as the original
           ;; list.
           [elements-to-pick (vector-length lst-as-vec)])
        (cond
         [(zero? elements-to-pick) result]
         [else
          (let*
              ;; Get a random number. [0,limit)
              ;; example: limit = 10, rand-int = 9
              ([rand-int (get-rand-int elements-to-pick)]
               ;; Get randomly an existing value from the vector of values, which
               ;; was created from the given list.
               ;; example: val = 9th value
               [val (vector-ref lst-as-vec rand-int)])
            ;; At the position, where we go the value from, set another value,
            ;; overwriting the value we already picked.  Overwrite it with the
            ;; value, which otherwise cannot be picked any longer, as we count
            ;; down the elements-to-pick and lower the limit for the random
            ;; integer generation.

            ;; There are 2 cases here:

            ;; Case 1: The picked value was already the value at the position (-
            ;; elements-to-pick 1). In this case, it does not matter, that the
            ;; value can not be picked again and we only write it back to its own
            ;; position.

            ;; Case 2: The picked value was any value at an index lower than (-
            ;; elements-to-pick 1). In this case, we keep the possibility, that
            ;; the value at (- elements-to-pick 1) can be picked in the next
            ;; iteration, by writing that value to the position of the picked
            ;; value.

            ;; This way, as the limit for random integers gets lower, all values
            ;; will eventually be picked.

            ;; Save the value at the highest possible index, so that it can be
            ;; picked next iteration. Overwrite already picked value.
            (vector-set! lst-as-vec
                         rand-int
                         ;; Take the value at the highest index.
                         (vector-ref lst-as-vec
                                     (- elements-to-pick 1)))
            (loop
             ;; Add the randomly chosen value to the list of values.
             (cons val result)
             ;; Count down the elements, which we still need to pick.
             (- elements-to-pick 1)))])))))