Given a mapping between items and their required probability of occurrence, generate a million items randomly subject to the given probabilities and compare the target probability of occurrence versus the generated values.

The total of all the probabilities should equal one. (Because floating point arithmetic is involved, this is subject to rounding errors).

aleph   1/5.0
beth    1/6.0
gimel   1/7.0
daleth  1/8.0
he      1/9.0
waw     1/10.0
zayin   1/11.0
heth    1759/27720 # adjusted so that probabilities add to 1
Related task

 Random number generator (device)


#lang racket
;;; returns a probabalistic choice from the sequence choices
;;; choices generates two values -- the chosen value and a
;;; probability (weight) of the choice.
;;;
;;; Note that a hash where keys are choices and values are probabilities
;;; is such a sequence.
;;;
;;; if the total probability < 1 then choice could return #f
;;; if the total probability > 1 then some choices may be impossible
(define (probabalistic-choice choices)
  (let-values
      (((_ choice) ;; the fold provides two values, we only need the second
                   ;; the first will always be a negative number showing that
                   ;; I've run out of random steam
        (for/fold
            ((rnd (random))
             (choice #f))
          (((v p) choices)
           #:break (<= rnd 0))
          (values (- rnd p) v))))
    choice))
 
;;; ditto, but all probabilities must be exact rationals
;;; the optional lcd
;;;
;;; not the most efficient, since it provides a wrapper (and demo)
;;; for p-c/i-w below
(define (probabalistic-choice/exact
         choices
         #:gcd (GCD (/ (apply gcd (hash-values choices)))))  
  (probabalistic-choice/integer-weights
   (for/hash (((k v) choices))
     (values k (* v GCD)))
   #:sum-of-weights GCD))
 
;;; this proves useful in Rock-Paper-Scissors
(define (probabalistic-choice/integer-weights
         choices
         #:sum-of-weights (sum-of-weights (apply + (hash-values choices))))
  (let-values
      (((_ choice)
        (for/fold
            ((rnd (random sum-of-weights))
             (choice #f))
          (((v p) choices)
           #:break (< rnd 0))
          (values (- rnd p) v))))
    choice))
 
(module+ test
  (define test-samples (make-parameter 1000000))
 
  (define (test-p-c-function f w)
    (define test-selection (make-hash))    
    (for* ((i (in-range 0 (test-samples)))
           (c (in-value (f w))))
      (when (zero? (modulo i 100000)) (eprintf "~a," (quotient i 100000)))
      (hash-update! test-selection c add1 0))    
    (printf "~a~%choice\tcount\texpected\tratio\terror~%" f)
    (for* (((k v) (in-hash test-selection))
           (e (in-value (* (test-samples) (hash-ref w k)))))
      (printf "~a\t~a\t~a\t~a\t~a%~%"
              k v e
              (/ v (test-samples))
              (real->decimal-string
               (exact->inexact (* 100 (/ (- v e) e)))))))
 
  (define test-weightings/rosetta
    (hash
     'aleph 1/5
     'beth 1/6
     'gimel 1/7
     'daleth 1/8
     'he 1/9
     'waw 1/10
     'zayin 1/11
     'heth 1759/27720; adjusted so that probabilities add to 1
     ))
 
  (define test-weightings/50:50 (hash 'woo 1/2 'yay 1/2))
  (define test-weightings/1:2:3 (hash 'woo 1 'yay 2 'foo 3))
 
  (test-p-c-function probabalistic-choice test-weightings/50:50)
  (test-p-c-function probabalistic-choice/exact test-weightings/50:50)
  (test-p-c-function probabalistic-choice test-weightings/rosetta)  
  (test-p-c-function probabalistic-choice/exact test-weightings/rosetta))