Initial data commit

Task/Probabilistic-choice/Racket/probabilistic-choice.rkt

@@ -0,0 +1,87 @@
+#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))