tasks a-s

Task/Probabilistic-choice/0DESCRIPTION

@@ -0,0 +1,13 @@
+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).
+
+Use the following mapping to test your programs:<pre>
+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</pre>

Task/Probabilistic-choice/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Probability and statistics

Task/Probabilistic-choice/ALGOL-68/probabilistic-choice.alg

@@ -0,0 +1,72 @@
+INT trials = 1 000 000;
+
+MODE LREAL = LONG REAL;
+
+MODE ITEM = STRUCT(
+  STRING name,
+  INT prob count,
+  LREAL expect,
+        mapping
+);
+INT col width = 9;
+FORMAT real repr = $g(-col width+1, 6)$,
+       item repr = $"Name: "g", Prob count: "g(0)", Expect: "f(real repr)", Mapping: ", f(real repr)l$;
+
+[8]ITEM items := (
+  ( "aleph",  0, ~, ~ ),
+  ( "beth",   0, ~, ~ ),
+  ( "gimel",  0, ~, ~ ),
+  ( "daleth", 0, ~, ~ ),
+  ( "he",     0, ~, ~ ),
+  ( "waw",    0, ~, ~ ),
+  ( "zayin",  0, ~, ~ ),
+  ( "heth",   0, ~, ~ )
+);
+
+main:
+(
+  LREAL offset = 5; # const #
+
+# initialise items #
+  LREAL total sum := 0;
+  FOR i FROM LWB items TO UPB items - 1 DO
+    expect OF items[i] := 1/(i-1+offset);
+    total sum +:= expect OF items[i]
+  OD;
+  expect OF items[UPB items] := 1 - total sum;
+
+  mapping OF items[LWB items] := expect OF items[LWB items];
+  FOR i FROM LWB items + 1 TO UPB items DO
+    mapping OF items[i] := mapping OF items[i-1] + expect OF items[i]
+  OD;
+
+  # printf((item repr, items)) #
+
+# perform the sampling #
+  PROC sample = (REF[]LREAL mapping)INT:(
+    INT out;
+    LREAL rand real = random;
+    FOR j FROM LWB items TO UPB items DO
+      IF rand real < mapping[j] THEN
+        out := j;
+	done
+      FI
+    OD;
+    done: out
+  );
+
+  FOR i TO trials DO
+      prob count OF items[sample(mapping OF items)] +:= 1
+  OD;
+
+  FORMAT indent = $17k$;
+
+# print the results #
+  printf(($"Trials: "g(0)l$, trials));
+  printf(($"Items:"$,indent));
+  FOR i FROM LWB items TO UPB items DO printf(($gn(col width)k" "$, name OF items[i])) OD;
+  printf(($l"Target prob.:"$, indent, $f(real repr)" "$, expect OF items));
+  printf(($l"Attained prob.:"$, indent));
+  FOR i FROM LWB items TO UPB items DO printf(($f(real repr)" "$, prob count OF items[i]/trials)) OD;
+  printf($l$)
+)

Task/Probabilistic-choice/AWK/probabilistic-choice.awk

@@ -0,0 +1,72 @@
+#!/usr/bin/awk -f
+
+BEGIN {
+    ITERATIONS = 1000000
+    delete symbMap
+    delete probMap
+    delete counts
+    initData();
+
+    for (i = 0; i < ITERATIONS; i++) {
+        distribute(rand())
+    }
+    showDistributions()
+
+    exit
+}
+
+function distribute(rnd,    cnt, symNum, sym, symPrb) {
+    cnt = length(symbMap)
+    for (symNum = 1; symNum <= cnt; symNum++) {
+        sym = symbMap[symNum];
+        symPrb = probMap[sym];
+        rnd -= symPrb;
+        if (rnd <= 0) {
+            counts[sym]++
+            return;
+        }
+    }
+}
+
+function showDistributions(    s, sym, prb, actSum, expSum, totItr) {
+    actSum = 0.0
+    expSum = 0.0
+    totItr = 0
+    printf "%-7s  %-7s  %-5s  %-5s\n", "symb", "num.", "act.", "expt."
+    print  "-------  -------  -----  -----"
+    for (s = 1; s <= length(symbMap); s++) {
+        sym = symbMap[s]
+        prb = counts[sym]/ITERATIONS
+        actSum += prb
+        expSum += probMap[sym]
+        totItr += counts[sym]
+        printf "%-7s  %7d  %1.3f  %1.3f\n", sym, counts[sym], prb, probMap[sym]
+    }
+    print  "-------  -------  -----  -----"
+    printf "Totals:  %7d  %1.3f  %1.3f\n", totItr, actSum, expSum
+}
+
+function initData(    sym) {
+    srand()
+
+    probMap["aleph"]  = 1.0 / 5.0
+    probMap["beth"]   = 1.0 / 6.0
+    probMap["gimel"]  = 1.0 / 7.0
+    probMap["daleth"] = 1.0 / 8.0
+    probMap["he"]     = 1.0 / 9.0
+    probMap["waw"]    = 1.0 / 10.0
+    probMap["zyin"]   = 1.0 / 11.0
+    probMap["heth"]   = 1759.0 / 27720.0
+
+    symbMap[1] = "aleph"
+    symbMap[2] = "beth"
+    symbMap[3] = "gimel"
+    symbMap[4] = "daleth"
+    symbMap[5] = "he"
+    symbMap[6] = "waw"
+    symbMap[7] = "zyin"
+    symbMap[8] = "heth"
+
+    for (sym in probMap)
+        counts[sym] = 0;
+}

Task/Probabilistic-choice/Ada/probabilistic-choice.ada

@@ -0,0 +1,34 @@
+with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+procedure Random_Distribution is
+   Trials : constant := 1_000_000;
+   type Outcome is (Aleph, Beth, Gimel, Daleth, He, Waw, Zayin, Heth);
+   Pr : constant array (Outcome) of Uniformly_Distributed :=
+        (1.0/5.0, 1.0/6.0, 1.0/7.0, 1.0/8.0, 1.0/9.0, 1.0/10.0, 1.0/11.0, 1.0);
+   Samples : array (Outcome) of Natural := (others => 0);
+   Value   : Uniformly_Distributed;
+   Dice    : Generator;
+begin
+   for Try in 1..Trials loop
+      Value := Random (Dice);
+      for I in Pr'Range loop
+         if Value <= Pr (I) then
+            Samples (I) := Samples (I) + 1;
+            exit;
+         else
+            Value := Value - Pr (I);
+         end if;
+      end loop;
+   end loop;
+      -- Printing the results
+   for I in Pr'Range loop
+      Put (Outcome'Image (I) & Character'Val (9));
+      Put (Float'Image (Float (Samples (I)) / Float (Trials)) & Character'Val (9));
+      if I = Heth then
+         Put_Line (" rest");
+      else
+         Put_Line (Uniformly_Distributed'Image (Pr (I)));
+      end if;
+   end loop;
+end Random_Distribution;

Task/Probabilistic-choice/AutoHotkey/probabilistic-choice.ahk

@@ -0,0 +1,39 @@
+s1 := "aleph",   p1 := 1/5.0                       ; Input
+s2 := "beth",    p2 := 1/6.0
+s3 := "gimel",   p3 := 1/7.0
+s4 := "daleth",  p4 := 1/8.0
+s5 := "he",      p5 := 1/9.0
+s6 := "waw",     p6 := 1/10.0
+s7 := "zayin",   p7 := 1/11.0
+s8 := "heth",    p8 := 1-p1-p2-p3-p4-p5-p6-p7
+n := 8, r0 := 0, r%n% := 1                         ; auxiliary data
+
+Loop % n-1
+   i := A_Index-1, r%A_Index% := r%i% + p%A_Index% ; cummulative distribution
+
+Loop 1000000 {
+   Random R, 0, 1.0
+   Loop %n%                                        ; linear search
+      If (R < r%A_Index%) {
+          c%A_Index%++
+          Break
+      }
+}
+                                                   ; Output
+Loop %n%
+   t .= s%A_Index% "`t" p%A_Index% "`t" c%A_Index%*1.0e-6 "`n"
+Msgbox %t%
+
+/*
+output:
+---------------------------
+aleph  0.200000   0.199960
+beth   0.166667   0.166146
+gimel  0.142857   0.142624
+daleth 0.125000   0.124924
+he     0.111111   0.111226
+waw    0.100000   0.100434
+zayin  0.090909   0.091344
+heth   0.063456   0.063342
+---------------------------
+*/

Task/Probabilistic-choice/BBC-BASIC/probabilistic-choice.bbc

@@ -0,0 +1,19 @@
+      DIM item$(7), prob(7), cnt%(7)
+      item$() = "aleph","beth","gimel","daleth","he","waw","zayin","heth"
+      prob()  = 1/5.0, 1/6.0, 1/7.0, 1/8.0, 1/9.0, 1/10.0, 1/11.0, 1759/27720
+      IF ABS(SUM(prob())-1) > 1E-6 ERROR 100, "Probabilities don't sum to 1"
+
+      FOR trial% = 1 TO 1E6
+        r = RND(1)
+        p = 0
+        FOR i% = 0 TO DIM(prob(),1)
+          p += prob(i%)
+          IF r < p cnt%(i%) += 1 : EXIT FOR
+        NEXT
+      NEXT
+
+      @% = &2060A
+      PRINT "Item        actual    theoretical"
+      FOR i% = 0 TO DIM(item$(),1)
+        PRINT item$(i%), cnt%(i%)/1E6, prob(i%)
+      NEXT

Task/Probabilistic-choice/C++/probabilistic-choice.cpp

@@ -0,0 +1,52 @@
+#include <cstdlib>
+#include <iostream>
+#include <vector>
+#include <utility>
+#include <algorithm>
+#include <ctime>
+#include <iomanip>
+
+int main( ) {
+   typedef std::vector<std::pair<std::string, double> >::const_iterator SPI ;
+   typedef std::vector<std::pair<std::string , double> > ProbType ;
+   ProbType probabilities ;
+   probabilities.push_back( std::make_pair( "aleph" , 1/5.0 ) ) ;
+   probabilities.push_back( std::make_pair( "beth" , 1/6.0 ) ) ;
+   probabilities.push_back( std::make_pair( "gimel" , 1/7.0 ) ) ;
+   probabilities.push_back( std::make_pair( "daleth" , 1/8.0 ) ) ;
+   probabilities.push_back( std::make_pair( "he" , 1/9.0 ) ) ;
+   probabilities.push_back( std::make_pair( "waw" , 1/10.0 ) ) ;
+   probabilities.push_back( std::make_pair( "zayin" , 1/11.0 ) ) ;
+   probabilities.push_back( std::make_pair( "heth" , 1759/27720.0 ) ) ;
+   std::vector<std::string> generated ; //for the strings that are generatod
+   std::vector<int> decider ; //holds the numbers that determine the choice of letters
+   for ( int i = 0 ; i < probabilities.size( ) ; i++ ) {
+      if ( i == 0 ) {
+	 decider.push_back( 27720 * (probabilities[ i ].second) ) ;
+      }
+      else {
+	 int number = 0 ;
+	 for ( int j = 0 ; j < i ; j++ ) {
+	    number +=  27720 * ( probabilities[ j ].second ) ;
+	 }
+	 number += 27720 * probabilities[ i ].second ;
+	 decider.push_back( number ) ;
+      }
+   }
+   srand( time( 0 ) ) ;
+   for ( int i = 0 ; i < 1000000 ; i++ ) {
+      int randnumber = rand( ) % 27721 ;
+      int j = 0 ;
+      while ( randnumber > decider[ j ] )
+	 j++ ;
+      generated.push_back( ( probabilities[ j ]).first ) ;
+   }
+   std::cout << "letter  frequency attained   frequency expected\n" ;
+   for ( SPI i = probabilities.begin( ) ; i != probabilities.end( ) ; i++ ) {
+      std::cout << std::left << std::setw( 8 ) << i->first ;
+      int found = std::count ( generated.begin( ) , generated.end( ) , i->first ) ;
+      std::cout << std::left << std::setw( 21 ) << found / 1000000.0 ;
+      std::cout << std::left << std::setw( 17 ) << i->second << '\n' ;
+   }
+   return 0 ;
+}

Task/Probabilistic-choice/C/probabilistic-choice-1.c

@@ -0,0 +1,34 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+/* pick a random index from 0 to n-1, according to probablities listed
+   in p[] which is assumed to have a sum of 1. The values in the probablity
+   list matters up to the point where the sum goes over 1 */
+int rand_idx(double *p, int n)
+{
+	double s = rand() / (RAND_MAX + 1.0);
+	int i;
+	for (i = 0; i < n - 1 && (s -= p[i]) >= 0; i++);
+	return i;
+}
+
+#define LEN 8
+#define N 1000000
+int main()
+{
+	const char *names[LEN] = { "aleph", "beth", "gimel", "daleth",
+			  "he", "waw", "zayin", "heth" };
+	double s, p[LEN] = { 1./5, 1./6, 1./7, 1./8, 1./9, 1./10, 1./11, 1e300 };
+	int i, count[LEN] = {0};
+
+	for (i = 0; i < N; i++) count[rand_idx(p, LEN)] ++;
+
+	printf("  Name  Count    Ratio Expected\n");
+	for (i = 0, s = 1; i < LEN; s -= p[i++])
+		printf("%6s%7d %7.4f%% %7.4f%%\n",
+			names[i], count[i],
+			(double)count[i] / N * 100,
+			((i < LEN - 1) ? p[i] : s) * 100);
+
+	return 0;
+}

Task/Probabilistic-choice/C/probabilistic-choice-2.c

@@ -0,0 +1,9 @@
+  Name  Count    Ratio Expected
+ aleph 199928 19.9928% 20.0000%
+  beth 166489 16.6489% 16.6667%
+ gimel 143211 14.3211% 14.2857%
+daleth 125257 12.5257% 12.5000%
+    he 110849 11.0849% 11.1111%
+   waw  99935  9.9935% 10.0000%
+ zayin  91001  9.1001%  9.0909%
+  heth  63330  6.3330%  6.3456%

Task/Probabilistic-choice/Clojure/probabilistic-choice.clj

@@ -0,0 +1,22 @@
+(defn to-cdf [pdf]
+  (reduce
+    (fn [acc n] (conj acc (+ (or (last acc) 0) n)))
+    []
+    pdf))
+
+(defn choose [cdf]
+  (let [r (rand)]
+    (count
+      (filter (partial > r) cdf))))
+
+(def *names* '[aleph beth gimel daleth he waw zayin heth])
+(def *pdf* (map double [1/5 1/6 1/7 1/8 1/9 1/10 1/11 1759/27720]))
+
+(let [num-trials 1000000
+      cdf (to-cdf *pdf*)
+      indexes (range (count *names*)) ;; use integer key internally, not name
+      expected (into (sorted-map) (zipmap indexes *pdf*))
+      actual (frequencies (repeatedly num-trials #(choose cdf)))]
+  (doseq [[idx exp] expected]
+    (println "Expected number of" (*names* idx) "was"
+             (* num-trials exp) "and actually got" (actual idx))))

Task/Probabilistic-choice/Common-Lisp/probabilistic-choice.lisp

@@ -0,0 +1,46 @@
+(defvar *probabilities* '((aleph  1/5)
+                          (beth   1/6)
+                          (gimel  1/7)
+                          (daleth 1/8)
+                          (he     1/9)
+                          (waw    1/10)
+                          (zayin  1/11)
+                          (heth   1759/27720)))
+(defun calculate-probabilities (choices &key (repetitions 1000000))
+  (assert (= 1 (reduce #'+ choices :key #'second)))
+  (labels ((make-ranges ()
+             (loop for (datum probability) in choices
+                   sum (coerce probability 'double-float) into total
+                   collect (list datum total)))
+           (pick (ranges)
+             (declare (optimize (speed 3) (safety 0) (debug 0)))
+             (loop with random = (random 1.0d0)
+                   for (datum below) of-type (t double-float) in ranges
+                   when (< random below)
+                     do (return datum)))
+           (populate-hash (ranges)
+             (declare (optimize (speed 3) (safety 0) (debug 0)))
+             (loop repeat (the fixnum repetitions)
+                   with hash = (make-hash-table)
+                   do (incf (the fixnum (gethash (pick ranges) hash 0)))
+                   finally (return hash)))
+           (make-table-data (hash)
+             (loop for (datum probability) in choices
+                   collect (list datum
+                                 (float (/ (gethash datum hash)
+                                           repetitions))
+                                 (float probability)))))
+    (format t "Datum~10,2TOccured~20,2TExpected~%")
+    (format t "~{~{~A~10,2T~F~20,2T~F~}~%~}"
+                 (make-table-data (populate-hash (make-ranges))))))
+
+CL-USER> (calculate-probabilities *probabilities*)
+Datum     Occured   Expected
+ALEPH     0.200156  0.2
+BETH      0.166521  0.16666667
+GIMEL     0.142936  0.14285715
+DALETH    0.124779  0.125
+HE        0.111601  0.11111111
+WAW       0.100068  0.1
+ZAYIN     0.090458  0.09090909
+HETH      0.063481  0.06345599

Task/Probabilistic-choice/D/probabilistic-choice-1.d

@@ -0,0 +1,15 @@
+import std.stdio, std.random, std.string, std.range;
+
+void main() {
+  enum int nTrials = 1_000_000;
+  enum items = "aleph beth gimel daleth he waw zayin heth".split();
+  enum pr = [1/5., 1/6., 1/7., 1/8., 1/9., 1/10., 1/11., 1759/27720.];
+
+  double[pr.length] counts = 0.0;
+  foreach (_; 0 .. nTrials)
+    counts[dice(pr)]++;
+
+  writeln("Item    Target prob  Attained prob");
+  foreach (name, p, co; zip(items, pr, counts[]))
+    writefln("%-7s %.8f   %.8f", name, p, co / nTrials);
+}

Task/Probabilistic-choice/D/probabilistic-choice-2.d

@@ -0,0 +1,24 @@
+import std.stdio, std.random, std.algorithm, std.range;
+
+void main() {
+  enum int nTrials = 1_000_000;
+  auto items = "aleph beth gimel daleth he waw zayin heth".split();
+  enum pr = [1/5., 1/6., 1/7., 1/8., 1/9., 1/10., 1/11., 1759/27720.];
+
+  double[pr.length] cumulatives = pr[];
+  foreach (i, ref c; cumulatives[1 .. $ - 1])
+    c += cumulatives[i];
+  cumulatives[$ - 1] = 1.0;
+
+  double[pr.length] counts = 0.0;
+  auto rnd = Xorshift(unpredictableSeed());
+  foreach (_; 0 .. nTrials) {
+    double rnd01 = rnd.front / cast(double)rnd.max;
+    rnd.popFront();
+    counts[cumulatives[].countUntil!(c => c >= rnd01)()]++;
+  }
+
+  writeln("Item    Target prob  Attained prob");
+  foreach (name, p, co; zip(items, pr, counts[]))
+    writefln("%-7s %.8f   %.8f", name, p, co / nTrials);
+}

Task/Probabilistic-choice/E/probabilistic-choice-1.e

@@ -0,0 +1 @@
+pragma.syntax("0.9")

Task/Probabilistic-choice/E/probabilistic-choice-2.e

@@ -0,0 +1,55 @@
+/** Makes leaves of the binary tree */
+def leaf(value) {
+    return def leaf {
+        to run(_) { return value }
+        to __printOn(out) { out.print("=> ", value) }
+    }
+}
+/** Makes branches of the binary tree */
+def split(leastRight, left, right) {
+    return def tree {
+        to run(specimen) {
+            return if (specimen < leastRight) {
+                left(specimen)
+            } else {
+                right(specimen)
+            }
+        }
+        to __printOn(out) {
+            out.print("    ")
+            out.indent().print(left)
+            out.lnPrint("< ")
+            out.print(leastRight)
+            out.indent().lnPrint(right)
+        }
+    }
+}
+def makeIntervalTree(assocs :List[Tuple[any, float64]]) {
+    def size :int := assocs.size()
+    if (size > 1) {
+        def midpoint := size // 2
+        return split(assocs[midpoint][1], makeIntervalTree(assocs.run(0, midpoint)),
+                                          makeIntervalTree(assocs.run(midpoint)))
+    } else {
+        def <nowiki>[[value, _]] := assocs</nowiki>
+        return leaf(value)
+    }
+}
+def setupProbabilisticChoice(entropy, table :Map[any, float64]) {
+    var cumulative := 0.0
+    var intervalTable := []
+    for value => probability in table {
+        intervalTable with= [value, cumulative]
+        cumulative += probability
+    }
+    def total := cumulative
+    def selector := makeIntervalTree(intervalTable)
+    return def probChoice {
+        # Multiplying by the total helps correct for any error in the sum of the inputs
+        to run() { return selector(entropy.nextDouble() * total) }
+        to __printOn(out) {
+            out.print("Probabilistic choice using tree:")
+            out.indent().lnPrint(selector)
+        }
+    }
+}

Task/Probabilistic-choice/E/probabilistic-choice-3.e

@@ -0,0 +1,22 @@
+def rosetta := setupProbabilisticChoice(entropy, def probTable := [
+    "aleph"  => 1/5,
+    "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"   => 0.063455988455988432,
+])
+
+var trials := 1000000
+var timesFound := [].asMap()
+for i in 1..trials {
+    if (i % 1000 == 0) { print(`${i//1000} `) }
+    def value := rosetta()
+    timesFound with= (value, timesFound.fetch(value, fn { 0 }) + 1)
+}
+stdout.println()
+for item in probTable.domain() {
+    stdout.print(item, "\t", timesFound[item] / trials, "\t", probTable[item], "\n")
+}

Task/Probabilistic-choice/Euphoria/probabilistic-choice.euphoria

@@ -0,0 +1,33 @@
+constant MAX = #3FFFFFFF
+constant times = 1e6
+atom d,e
+sequence Mapps
+Mapps = {
+    { "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, 0}
+}
+
+for i = 1 to times do
+    d = (rand(MAX)-1)/MAX
+    e = 0
+    for j = 1 to length(Mapps) do
+        e += Mapps[j][2]
+        if d <= e then
+            Mapps[j][3] += 1
+            exit
+        end if
+    end for
+end for
+
+printf(1,"Sample times: %d\n",times)
+for j = 1 to length(Mapps) do
+    d = Mapps[j][3]/times
+    printf(1,"%-7s should be %f is %f | Deviatation %6.3f%%\n",
+                {Mapps[j][1],Mapps[j][2],d,(1-Mapps[j][2]/d)*100})
+end for

Task/Probabilistic-choice/Factor/probabilistic-choice-1.factor

@@ -0,0 +1,37 @@
+USING: arrays assocs combinators.random io kernel macros math
+math.statistics prettyprint quotations sequences sorting formatting ;
+IN: rosettacode.proba
+
+CONSTANT: data
+{
+    { "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"    f }
+}
+
+MACRO: case-probas ( data -- case-probas )
+    [ first2 [ swap 1quotation 2array ] [ 1quotation ] if* ] map 1quotation ;
+
+: expected ( name data -- float )
+    2dup at [ 2nip ] [ nip values sift sum 1 swap - ] if* ;
+: generate ( # case-probas -- seq )
+    H{ } clone
+    [ [ [ casep ] [ inc-at ] bi* ] 2curry times ] keep ; inline
+: normalize ( seq # -- seq )
+    [ clone ] dip [ /f ] curry assoc-map ;
+: summarize1 ( name value data -- )
+    [ over ] dip expected
+    "%6s: %10f %10f\n" printf ;
+: summarize ( generated data -- )
+    "Key" "Value" "expected" "%6s  %10s %10s\n" printf
+    [ summarize1 ] curry assoc-each ;
+: generate-normalized ( # proba -- seq )
+    [ generate ] [ drop normalize ] 2bi ; inline
+: example ( # data -- )
+    [ case-probas generate-normalized ]
+    [ summarize ] bi ; inline

Task/Probabilistic-choice/Factor/probabilistic-choice-2.factor

@@ -0,0 +1,2 @@
+USE: rosettacode.proba
+1000000 data example

Task/Probabilistic-choice/Factor/probabilistic-choice-3.factor

@@ -0,0 +1,9 @@
+   Key       Value   expected
+  heth:   0.063469   0.063456
+   waw:   0.100226   0.100000
+daleth:   0.125844   0.125000
+  beth:   0.166264   0.166667
+ zayin:   0.090806   0.090909
+    he:   0.110562   0.111111
+ aleph:   0.199868   0.200000
+ gimel:   0.142961   0.142857

Task/Probabilistic-choice/Forth/probabilistic-choice.fth

@@ -0,0 +1,44 @@
+include random.fs
+
+\ common factors of desired probabilities (1/5 .. 1/11)
+2 2 * 2 * 3 * 3 * 5 * 7 * 11 * constant denom   \ 27720
+
+\ represent each probability as the numerator with 27720 as the denominator
+: ,numerators ( max min -- )
+  do denom i / , loop ;
+
+\  final item is 27720 - sum(probs)
+: ,remainder ( denom addr len -- )
+  cells bounds do  i @ -  1 cells +loop , ;
+
+create probs 12 5 ,numerators  denom probs 7 ,remainder
+create bins 8 cells allot
+
+: choose ( -- 0..7 )
+  denom random
+  8 0 do
+    probs i cells + @ -
+    dup 0< if drop i unloop exit then
+  loop
+  abort" can't get here" ;
+
+: trials ( n -- )
+  0 do  1  bins choose cells +  +!  loop ;
+
+: str-table
+  create ( c-str ... n -- ) 0 do , loop
+  does> ( n -- str len ) swap cells + @ count ;
+
+here ," heth"   here ," zayin" here ," waw"  here ," he"
+here ," daleth" here ," gimel" here ," beth" here ," aleph"
+8 str-table names
+
+: .header
+  cr ." Name" #tab emit ." Prob" #tab emit ." Actual" #tab emit ." Error" ;
+: .result ( n -- )
+  cr dup names type #tab emit
+  dup cells probs + @ s>f denom s>f f/ fdup f. #tab emit
+  dup cells bins  + @ s>f 1e6       f/ fdup f. #tab emit
+  f- fabs fs. ;
+
+: .results   .header 8 0 do i .result loop ;

Task/Probabilistic-choice/Fortran/probabilistic-choice.f

@@ -0,0 +1,33 @@
+PROGRAM PROBS
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: trials = 1000000
+  INTEGER :: i, j, probcount(8) = 0
+  REAL :: expected(8), mapping(8), rnum
+  CHARACTER(6) :: items(8) = (/ "aleph ", "beth  ", "gimel ", "daleth", "he    ", "waw   ", "zayin ", "heth  " /)
+
+  expected(1:7) = (/ (1.0/i, i=5,11) /)
+  expected(8) = 1.0 - SUM(expected(1:7))
+  mapping(1) = 1.0 / 5.0
+  DO i = 2, 7
+     mapping(i) = mapping(i-1) + 1.0/(i+4.0)
+  END DO
+  mapping(8) = 1.0
+
+  DO i = 1, trials
+     CALL RANDOM_NUMBER(rnum)
+     DO j = 1, 8
+        IF (rnum < mapping(j)) THEN
+           probcount(j) = probcount(j) + 1
+           EXIT
+        END IF
+     END DO
+  END DO
+
+  WRITE(*, "(A,I10)") "Trials:             ", trials
+  WRITE(*, "(A,8A10)") "Items:             ", items
+  WRITE(*, "(A,8F10.6)") "Target Probability:  ", expected
+  WRITE(*, "(A,8F10.6)") "Attained Probability:", REAL(probcount) / REAL(trials)
+
+ENDPROGRAM PROBS

Task/Probabilistic-choice/Go/probabilistic-choice.go

@@ -0,0 +1,63 @@
+package main
+
+import (
+    "fmt"
+    "math/rand"
+    "time"
+)
+
+type mapping struct {
+    item string
+    pr   float64
+}
+
+func main() {
+    // input mapping
+    m := []mapping{
+        {"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
+
+    // cumulative probability
+    cpr := make([]float64, len(m)-1)
+    var c float64
+    for i := 0; i < len(m)-1; i++ {
+        c += m[i].pr
+        cpr[i] = c
+    }
+
+    // generate
+    const samples = 1e6
+    occ := make([]int, len(m))
+    rand.Seed(time.Now().UnixNano())
+    for i := 0; i < samples; i++ {
+        r := rand.Float64()
+        for j := 0; ; j++ {
+            if r < cpr[j] {
+                occ[j]++
+                break
+            }
+            if j == len(cpr)-1 {
+                occ[len(cpr)]++
+                break
+            }
+        }
+    }
+
+    // report
+    fmt.Println("  Item  Target   Generated")
+    var totalTarget, totalGenerated float64
+    for i := 0; i < len(m); i++ {
+        target := m[i].pr
+        generated := float64(occ[i]) / samples
+        fmt.Printf("%6s  %8.6f  %8.6f\n", m[i].item, target, generated)
+        totalTarget += target
+        totalGenerated += generated
+    }
+    fmt.Printf("Totals  %8.6f  %8.6f\n", totalTarget, totalGenerated)
+}

Task/Probabilistic-choice/Haskell/probabilistic-choice.hs

@@ -0,0 +1,20 @@
+import System.Random
+import Data.List
+import Control.Monad
+import Control.Arrow
+
+labels = ["aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth" ]
+piv n = take n . (++  repeat ' ')
+
+main = do
+  g <- newStdGen
+  let rs,ps :: [Float]
+      rs = take 1000000 $ randomRs(0,1) g
+      ps = ap (++) (return. (1 -) .sum) $ map recip [5..11]
+      sps = scanl1 (+) ps
+      qs = (\xs -> map ((/1000000.0).fromIntegral.length. flip filter xs. (==))sps)
+           $ map (head . flip dropWhile sps . (>)) rs
+  putStrLn $ "       expected     actual"
+  mapM_ putStrLn $ zipWith3
+               (\l s c-> (piv 7 l) ++ (piv 13 $ show $ s)
+                    ++(piv 12 $ show $ c)) labels ps qs

Task/Probabilistic-choice/HicEst/probabilistic-choice.hicest

@@ -0,0 +1,17 @@
+REAL :: trials=1E6, n=8, map(n), limit(n), expected(n), outcome(n)
+
+expected = 1 / ($ + 4)
+expected(n) = 1 - SUM(expected) + expected(n)
+
+map = expected
+map = map($) + map($-1)
+
+DO i = 1, trials
+   random = RAN(1)
+   limit = random > map
+   item = INDEX(limit, 0)
+   outcome(item) = outcome(item) + 1
+ENDDO
+outcome = outcome / trials
+
+DLG(Text=expected, Text=outcome, Y=0)

Task/Probabilistic-choice/Icon/probabilistic-choice.icon

@@ -0,0 +1,50 @@
+record Item(value, probability)
+
+procedure find_item (items, v)
+  sum := 0.0
+  every item := !items do {
+    if v < sum+item.probability
+     then return item.value
+     else sum +:= item.probability
+  }
+  fail # v exceeded 1.0
+end
+
+# -- helper procedures
+
+# count the number of occurrences of i in list l,
+# assuming the items are strings
+procedure count (l, i)
+  result := 0.0
+  every x := !l do
+    if x == i then result +:= 1
+  return result
+end
+
+procedure rand_float ()
+  return ?1000/1000.0
+end
+
+# -- test the procedure
+procedure main ()
+  items := [
+    Item("aleph",   1/5.0),
+    Item("beth",    1/6.0),
+    Item("gimel",   1/7.0),
+    Item("daleth",  1/8.0),
+    Item("he",      1/9.0),
+    Item("waw",     1/10.0),
+    Item("zayin",   1/11.0),
+    Item("heth",    1759/27720.0)
+  ]
+
+  # collect a sample of results
+  sample := []
+  every (1 to 1000000) do push (sample, find_item(items, rand_float ()))
+
+  # return comparison of expected vs actual probability
+  every item := !items do
+    write (right(item.value, 7) || " " ||
+           left(item.probability, 15) || " " ||
+           left(count(sample, item.value)/*sample, 6))
+end

Task/Probabilistic-choice/J/probabilistic-choice-1.j

@@ -0,0 +1,17 @@
+main=: verb define
+  hdr=.  '       target   actual  '
+  lbls=. ; ,:&.> ;:'aleph beth gimel daleth he waw zayin heth'
+  prtn=. +/\ pt=. (, 1-+/)1r1%5+i.7
+  da=.   prtn I. ?y # 0
+  pa=.   y%~ +/ da =/ i.8
+  hdr, lbls,. 9j6 ": |: pt,:pa
+)
+
+Note 'named abbreviations'
+     hdr  (header)
+     lbls (labels)
+     pt   (target proportions)
+     prtn (partitions corresponding to target proportions)
+     da   (distribution of actual values among partitions)
+     pa   (actual proportions)
+)

Task/Probabilistic-choice/J/probabilistic-choice-2.j

@@ -0,0 +1,10 @@
+main 1e6
+       target   actual
+aleph  0.200000 0.200344
+beth   0.166667 0.166733
+gimel  0.142857 0.142611
+daleth 0.125000 0.124458
+he     0.111111 0.111455
+waw    0.100000 0.099751
+zayin  0.090909 0.091121
+heth   0.063456 0.063527

Task/Probabilistic-choice/J/probabilistic-choice-3.j

@@ -0,0 +1,5 @@
+   pt=. (, 1-+/)1r1%5+i.7
+   pt
+1r5 1r6 1r7 1r8 1r9 1r10 1r11 1759r27720
+   +/pt
+1

Task/Probabilistic-choice/Java/probabilistic-choice-1.java

@@ -0,0 +1,67 @@
+public class Prob{
+	static long TRIALS= 1000000;
+
+	private static class Expv{
+		public String name;
+		public int probcount;
+		public double expect;
+		public double mapping;
+
+		public Expv(String name, int probcount, double expect, double mapping){
+			this.name= name;
+			this.probcount= probcount;
+			this.expect= expect;
+			this.mapping= mapping;
+		}
+	}
+
+	static Expv[] items=
+			{new Expv("aleph", 0, 0.0, 0.0), new Expv("beth", 0, 0.0, 0.0),
+					new Expv("gimel", 0, 0.0, 0.0),
+					new Expv("daleth", 0, 0.0, 0.0),
+					new Expv("he", 0, 0.0, 0.0), new Expv("waw", 0, 0.0, 0.0),
+					new Expv("zayin", 0, 0.0, 0.0),
+					new Expv("heth", 0, 0.0, 0.0)};
+
+	public static void main(String[] args){
+		int i, j;
+		double rnum, tsum= 0.0;
+
+		for(i= 0, rnum= 5.0;i < 7;i++, rnum+= 1.0){
+			items[i].expect= 1.0 / rnum;
+			tsum+= items[i].expect;
+		}
+		items[7].expect= 1.0 - tsum;
+
+		items[0].mapping= 1.0 / 5.0;
+		for(i= 1;i < 7;i++){
+			items[i].mapping= items[i - 1].mapping + 1.0 / ((double)i + 5.0);
+		}
+		items[7].mapping= 1.0;
+
+
+		for(i= 0;i < TRIALS;i++){
+			rnum= Math.random();
+			for(j= 0;j < 8;j++){
+				if(rnum < items[j].mapping){
+					items[j].probcount++;
+					break;
+				}
+			}
+		}
+
+		System.out.printf("Trials: %d\n", TRIALS);
+		System.out.printf("Items:          ");
+		for(i= 0;i < 8;i++)
+			System.out.printf("%-8s ", items[i].name);
+		System.out.printf("\nTarget prob.:   ");
+		for(i= 0;i < 8;i++)
+			System.out.printf("%8.6f ", items[i].expect);
+		System.out.printf("\nAttained prob.: ");
+		for(i= 0;i < 8;i++)
+			System.out.printf("%8.6f ", (double)(items[i].probcount)
+					/ (double)TRIALS);
+		System.out.printf("\n");
+
+	}
+}

Task/Probabilistic-choice/Java/probabilistic-choice-2.java

@@ -0,0 +1,52 @@
+import java.util.EnumMap;
+
+public class Prob {
+	public static long TRIALS= 1000000;
+	public enum Glyph{
+		ALEPH, BETH, GIMEL, DALETH, HE, WAW, ZAYIN, HETH;
+	}
+	
+	public static EnumMap<Glyph, Double> probs = new EnumMap<Glyph, Double>(Glyph.class){{
+		put(Glyph.ALEPH,   1/5.0);
+		put(Glyph.BETH,    1/6.0);
+		put(Glyph.GIMEL,   1/7.0);
+		put(Glyph.DALETH,  1/8.0);
+		put(Glyph.HE,      1/9.0);
+		put(Glyph.WAW,     1/10.0);
+		put(Glyph.ZAYIN,   1/11.0);
+		put(Glyph.HETH,    1759./27720);
+	}};
+	
+	public static EnumMap<Glyph, Double> counts = new EnumMap<Glyph, Double>(Glyph.class){{
+		put(Glyph.ALEPH, 0.);put(Glyph.BETH,   0.);
+		put(Glyph.GIMEL, 0.);put(Glyph.DALETH, 0.);
+		put(Glyph.HE,    0.);put(Glyph.WAW,    0.);
+		put(Glyph.ZAYIN, 0.);put(Glyph.HETH,   0.);
+	}};
+	
+	public static void main(String[] args){
+		System.out.println("Target probabliities:\t" + probs);
+		for(long i = 0; i < TRIALS; i++){
+			Glyph choice = getChoice();
+			counts.put(choice, counts.get(choice) + 1);
+		}
+
+		//correct the counts to probablities in (0..1]
+		for(Glyph glyph:counts.keySet()){
+			counts.put(glyph, counts.get(glyph) / TRIALS);
+		}
+		
+		System.out.println("Actual probabliities:\t" + counts);
+	}
+	
+	private static Glyph getChoice() {
+		double rand = Math.random();
+		for(Glyph item:Glyph.values()){
+			if(rand < probs.get(item)){
+				return item;
+			}
+			rand -= probs.get(item);
+		}
+		return null;
+	}
+}

Task/Probabilistic-choice/JavaScript/probabilistic-choice.js

@@ -0,0 +1,32 @@
+var probabilities = {
+    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
+};
+
+var sum = 0;
+var iterations = 1000000;
+var cumulative = {};
+var randomly = {};
+for (var name in probabilities) {
+    sum += probabilities[name];
+    cumulative[name] = sum;
+    randomly[name] = 0;
+}
+for (var i = 0; i < iterations; i++) {
+    var r = Math.random();
+    for (var name in cumulative) {
+        if (r <= cumulative[name]) {
+            randomly[name]++;
+            break;
+        }
+    }
+}
+for (var name in probabilities)
+    // using WSH
+    WScript.Echo(name + "\t" + probabilities[name] + "\t" + randomly[name]/iterations);

Task/Probabilistic-choice/Liberty-BASIC/probabilistic-choice.liberty

@@ -0,0 +1,24 @@
+names$="aleph beth gimel daleth he waw zayin heth"
+dim sum(8)
+dim counter(8)
+
+s = 0
+for i = 1 to 7
+    s = s+1/(i+4)
+    sum(i)=s
+next
+
+N =1000000     '  number of throws
+
+for i =1 to N
+    rand =rnd( 1)
+    for j = 1 to 7
+        if sum(j)> rand then exit for
+    next
+    counter(j)=counter(j)+1
+next
+
+print "Observed", "Intended"
+for i = 1 to 8
+    print word$(names$, i), using( "#.#####", counter(i)  /N), using( "#.#####", 1/(i+4))
+next

Task/Probabilistic-choice/Lua/probabilistic-choice.lua

@@ -0,0 +1,34 @@
+items = {}
+items["aleph"]  = 1/5.0
+items["beth"]   = 1/6.0
+items["gimel"]  = 1/7.0
+items["daleth"] = 1/8.0
+items["he"]     = 1/9.0
+items["waw"]    = 1/10.0
+items["zayin"]  = 1/11.0
+items["heth"]   = 1759/27720
+
+num_trials = 1000000
+
+samples = {}
+for item, _ in pairs( items ) do
+    samples[item] = 0
+end
+
+math.randomseed( os.time() )
+for i = 1, num_trials do
+    z = math.random()
+	
+    for item, _ in pairs( items ) do
+	if z < items[item] then
+	    samples[item] = samples[item] + 1
+	    break;
+	else
+ 	    z = z - items[item]	
+	end
+    end
+end
+	
+for item, _ in pairs( items ) do
+    print( item, samples[item]/num_trials, items[item] )
+end

Task/Probabilistic-choice/Mathematica/probabilistic-choice-1.math

@@ -0,0 +1,2 @@
+choices={{"aleph", 1/5},{"beth", 1/6},{"gimel", 1/7},{"daleth", 1/8},{"he", 1/9},{"waw", 1/10},{"zayin", 1/11},{"heth", 1759/27720}};
+data=RandomChoice[choices[[All,2]]->choices[[All,1]],10^6];

Task/Probabilistic-choice/Mathematica/probabilistic-choice-2.math

@@ -0,0 +1 @@
+Grid[{#[[1]],N[Count[data,#[[1]]]/10^6],N[#[[2]]]}&/@choices]

Task/Probabilistic-choice/OCaml/probabilistic-choice.ocaml

@@ -0,0 +1,30 @@
+let p = [
+    "Aleph",   1.0 /. 5.0;
+    "Beth",    1.0 /. 6.0;
+    "Gimel",   1.0 /. 7.0;
+    "Daleth",  1.0 /. 8.0;
+    "He",      1.0 /. 9.0;
+    "Waw",     1.0 /. 10.0;
+    "Zayin",   1.0 /. 11.0;
+    "Heth", 1759.0 /. 27720.0;
+  ]
+
+let rec take k = function
+  | (v, p)::tl -> if k < p then v else take (k -. p) tl
+  | _ -> invalid_arg "take"
+
+let () =
+  let n = 1_000_000 in
+  Random.self_init();
+  let h = Hashtbl.create 3 in
+  List.iter (fun (v, _) -> Hashtbl.add h v 0) p;
+  let tot = List.fold_left (fun acc (_, p) -> acc +. p) 0.0 p in
+  for i = 1 to n do
+    let sel = take (Random.float tot) p in
+    let n = Hashtbl.find h sel in
+    Hashtbl.replace h sel (succ n)  (* count the number of each item *)
+  done;
+  List.iter (fun (v, p) ->
+    let d = Hashtbl.find h v in
+    Printf.printf "%s \t %f %f\n" v p (float d /. float n)
+  ) p

Task/Probabilistic-choice/PARI-GP/probabilistic-choice.pari

@@ -0,0 +1,14 @@
+pc()={
+  my(v=[5544,10164,14124,17589,20669,23441,25961,27720],u=vector(8),e);
+  for(i=1,1e6,
+    my(r=random(27720));
+    for(j=1,8,
+      if(r<v[j], u[j]++; break)
+    )
+  );
+  e=precision([1/5,1/6,1/7,1/8,1/9,1/10,1/11,1759/27720]*1e6,9); \\ truncate to 9 decimal places
+  print("Totals: "u);
+  print("Expected: "e);
+  print("Diff: ",u-e);
+  print("StDev: ",vector(8,i,sqrt(abs(u[i]-v[i])/e[i])));
+};

Task/Probabilistic-choice/Perl-6/probabilistic-choice.pl6

@@ -0,0 +1,27 @@
+constant TRIALS = 1e4;
+
+sub prob_choice_picker (%options is copy) {
+  my $n = 0;
+  $_ = ($n += $_) for values %options;
+  return sub {
+    my $r = rand;
+    (first { $r < .value }, %options).key;
+  };
+}
+
+my %ps = (
+  (map {$^w => 1/$^n}, (5 .. 11 Z <aleph beth gimel daleth he waw zayin>)),
+  heth => 0
+);
+%ps<heth> = 1 - [+] values %ps;
+
+&picker = prob_choice_picker %ps;
+my %results;
+++%results{picker} for ^TRIALS;
+
+say 'Event   Occurred  Expected  Difference';
+for sort { .value }, %results {
+    printf "%-6s  %f  %f  %f\n",
+        .key, .value/TRIALS, %ps{.key},
+        abs( .value/TRIALS - %ps{.key} );
+}

Task/Probabilistic-choice/Perl/probabilistic-choice.pl

@@ -0,0 +1,38 @@
+use List::Util qw(first sum);
+use constant TRIALS => 1e6;
+
+sub prob_choice_picker {
+  my %options = @_;
+  my ($n, @a) = 0;
+  while (my ($k,$v) = each %options) {
+      $n += $v;
+      push @a, [$n, $k];
+  }
+  return sub {
+      my $r = rand;
+      ( first {$r <= $_->[0]} @a )->[1];
+  };
+}
+
+my %ps =
+  (aleph  => 1/5,
+   beth   => 1/6,
+   gimel  => 1/7,
+   daleth => 1/8,
+   he     => 1/9,
+   waw    => 1/10,
+   zayin  => 1/11);
+$ps{heth} = 1 - sum values %ps;
+
+my $picker = prob_choice_picker %ps;
+my %results;
+for (my $n = 0 ; $n < TRIALS ; ++$n) {
+    ++$results{$picker->()};
+}
+
+print "Event   Occurred  Expected  Difference\n";
+foreach (sort {$results{$b} <=> $results{$a}} keys %results) {
+    printf "%-6s  %f  %f  %f\n",
+        $_, $results{$_}/TRIALS, $ps{$_},
+        abs($results{$_}/TRIALS - $ps{$_});
+}

Task/Probabilistic-choice/PicoLisp/probabilistic-choice.l

@@ -0,0 +1,17 @@
+(let (Count 1000000  Denom 27720  N Denom)
+   (let Probs
+      (mapcar
+         '((I S)
+            (prog1 (cons N (*/ Count I) 0 S)
+               (dec 'N (/ Denom I)) ) )
+         (range 5 12)
+         '(aleph beth gimel daleth he waw zayin heth) )
+      (do Count
+         (inc (cddr (rank (rand 1 Denom) Probs T))) )
+      (let Fmt (-6 12 12)
+         (tab Fmt NIL "Probability" "Result")
+         (for X Probs
+            (tab Fmt
+               (cdddr X)
+               (format (cadr X) 6)
+               (format (caddr X) 6) ) ) ) ) )

Task/Probabilistic-choice/PureBasic/probabilistic-choice.purebasic

@@ -0,0 +1,42 @@
+#times=1000000
+
+Structure Item
+  name.s
+  prob.d
+  Amount.i
+EndStructure
+
+If OpenConsole()
+  Define i, j, d.d, e.d, txt.s
+  Dim Mapps.Item(7)
+  Mapps(0)\name="aleph": Mapps(0)\prob=1/5.0
+  Mapps(1)\name="beth":  Mapps(1)\prob=1/6.0
+  Mapps(2)\name="gimel": Mapps(2)\prob=1/7.0
+  Mapps(3)\name="daleth":Mapps(3)\prob=1/8.0
+  Mapps(4)\name="he":    Mapps(4)\prob=1/9.0
+  Mapps(5)\name="waw":   Mapps(5)\prob=1/10.0
+  Mapps(6)\name="zayin": Mapps(6)\prob=1/11.0
+  Mapps(7)\name="heth":  Mapps(7)\prob=1759/27720.0
+
+  For i=1 To #times
+    d=Random(#MAXLONG)/#MAXLONG  ; Get a random number
+    e=0.0
+    For j=0 To ArraySize(Mapps())
+      e+Mapps(j)\prob            ; Get span for current itme
+      If d<=e                    ; Check if it is within this span?
+        Mapps(j)\Amount+1        ; If so, count it.
+        Break
+      EndIf
+    Next j
+  Next i
+
+  PrintN("Sample times: "+Str(#times)+#CRLF$)
+  For j=0 To ArraySize(Mapps())
+      d=Mapps(j)\Amount/#times
+      txt=LSet(Mapps(j)\name,7)+" should be "+StrD(Mapps(j)\prob)+" is "+StrD(d)
+      PrintN(txt+" | Deviatation "+RSet(StrD(100.0-100.0*Mapps(j)\prob/d,3),6)+"%")
+  Next
+
+  Print(#CRLF$+"Press ENTER to exit"):Input()
+  CloseConsole()
+EndIf

Task/Probabilistic-choice/Python/probabilistic-choice.py

@@ -0,0 +1,64 @@
+import random, bisect
+
+def probchoice(items, probs):
+  '''\
+  Splits the interval 0.0-1.0 in proportion to probs
+  then finds where each random.random() choice lies
+  '''
+
+  prob_accumulator = 0
+  accumulator = []
+  for p in probs:
+    prob_accumulator += p
+    accumulator.append(prob_accumulator)
+
+  while True:
+    r = random.random()
+    yield items[bisect.bisect(accumulator, r)]
+
+def probchoice2(items, probs, bincount=10000):
+  '''\
+  Puts items in bins in proportion to probs
+  then uses random.choice() to select items.
+
+  Larger bincount for more memory use but
+  higher accuracy (on avarage).
+  '''
+
+  bins = []
+  for item,prob in zip(items, probs):
+    bins += [item]*int(bincount*prob)
+  while True:
+    yield random.choice(bins)
+
+
+def tester(func=probchoice, items='good bad ugly'.split(),
+                    probs=[0.5, 0.3, 0.2],
+                    trials = 100000
+                    ):
+  def problist2string(probs):
+    '''\
+    Turns a list of probabilities into a string
+    Also rounds FP values
+    '''
+    return ",".join('%8.6f' % (p,) for p in probs)
+
+  from collections import defaultdict
+
+  counter = defaultdict(int)
+  it = func(items, probs)
+  for dummy in xrange(trials):
+    counter[it.next()] += 1
+  print "\n##\n## %s\n##" % func.func_name.upper()
+  print "Trials:              ", trials
+  print "Items:               ", ' '.join(items)
+  print "Target probability:  ", problist2string(probs)
+  print "Attained probability:", problist2string(
+    counter[x]/float(trials) for x in items)
+
+if __name__ == '__main__':
+  items = 'aleph beth gimel daleth he waw zayin heth'.split()
+  probs = [1/(float(n)+5) for n in range(len(items))]
+  probs[-1] = 1-sum(probs[:-1])
+  tester(probchoice, items, probs, 1000000)
+  tester(probchoice2, items, probs, 1000000)

Task/Probabilistic-choice/R/probabilistic-choice-1.r

@@ -0,0 +1,8 @@
+prob = c(aleph=1/5, beth=1/6, gimel=1/7, daleth=1/8, he=1/9, waw=1/10, zayin=1/11, heth=1759/27720)
+  # Note that R doesn't actually require the weights
+  # vector for rmultinom to sum to 1.
+hebrew = c(rmultinom(1, 1e6, prob))
+d = data.frame(
+    Requested = prob,
+    Obtained = hebrew/sum(hebrew))
+print(d)

Task/Probabilistic-choice/R/probabilistic-choice-2.r

@@ -0,0 +1,2 @@
+library(ggplot2)
+qplot(factor(names(prob), levels = names(prob)), hebrew, geom = "histogram")

Task/Probabilistic-choice/REXX/probabilistic-choice.rexx

@@ -0,0 +1,32 @@
+/*REXX pg shows results of probabilistic choices (gen rand#s per prob.) */
+parse arg trials digits seed .         /*obtain some optional arguments.*/
+if trials=='' | trials==','  then trials=1000000
+if digits=='' | digits==','  then digits=15;         digits=max(10,digits)
+if  seed\==''                then call random ,,seed /*for repeatability*/
+names='aleph beth gimel daleth he waw zayin heth ──totals───►'
+cells=words(names) - 1;      high=100000;  s=0;                 !.=0
+_=4
+       do n=1  for 7; _=_+1; prob.n=1/_;   Hprob.n=prob.n*high; s=s+prob.n
+       end   /*n*/                     /* [↑]  determine probabilities. */
+
+prob.8=1759/27720;  Hprob.8=prob.8*high;  s=s+prob.8; prob.9=s; !.9=trials
+
+  do j=1  for trials; r=random(1,high) /*generate X number of random #s.*/
+     do k=1  for cells                 /*now, for each cell, compute %s.*/
+     if r<=Hprob.k  then !.k=!.k+1     /*for each range, bump da counter*/
+     end   /*k*/
+  end      /*j*/
+
+w=digits+6;         d=max(length(trials), length('count')) + 4
+say center('name',15,'─') center('count',d,'─') center('target %',w,'─'),
+    center('actual %',w,'─')           /*display a formatted header line*/
+
+         do i=1  for cells+1           /*show for each cell and totals. */
+         say  '  '  left(word(names,i)            ,    12),
+                    right(!.i                     ,   d-2)  ' ',
+                    left(format(prob.i    *100, d),   w-2),
+                    left(format(!.i/trials*100, d),   w-2)
+         if i==8  then say center('',15,'─')    center('',d,'─'),
+                           center('', w,'─')    center('',w,'─')
+         end   /*i*/
+                                       /*stick a fork in it, we're done.*/

Task/Probabilistic-choice/Ruby/probabilistic-choice.rb

@@ -0,0 +1,35 @@
+ordered_keys = ["aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth"]
+probabilities = {
+  "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,
+}
+probabilities["heth"] = probabilities.each_value.inject(1) {|heth, value| heth -= value}
+
+sums = {}
+ordered_keys.each.inject(0) do |sum, key|
+  sum += probabilities[key]
+  sums[key] = sum
+end
+
+actual = Hash.new(0)
+
+samples = 1_000_000
+samples.times do
+  r = rand
+  for k in ordered_keys
+    if r < sums[k]
+      actual[k] += 1
+      break
+    end
+  end
+end
+
+printf "%-6s  %-19s  %s\n", "key", "expected", "actual"
+for k in ordered_keys
+  printf "%-6s  %.17f  %.6f\n", k, probabilities[k], Float(actual[k])/samples
+end

Task/Probabilistic-choice/Seed7/probabilistic-choice.seed7

@@ -0,0 +1,45 @@
+$ include "seed7_05.s7i";
+  include "float.s7i";
+
+const type: letter is new enum
+    aleph, beth, gimel, daleth, he, waw, zayin, heth
+  end enum;
+
+const func string: str (in letter: aLetter) is
+    return [] ("aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth") [succ(ord(aLetter))];
+
+enable_output(letter);
+
+const array [letter] integer: table is [letter] (
+    5544, 4620, 3960, 3465, 3080, 2772, 2520, 1759);
+
+const func letter: randomLetter is func
+  result
+    var letter: resultLetter is aleph;
+  local
+    var integer: number is 0;
+  begin
+    number := rand(1, 27720);
+    while number > table[resultLetter] do
+      number -:= table[resultLetter];
+      incr(resultLetter);
+    end while;
+  end func;
+
+const proc: main is func
+  local
+    var integer: count is 0;
+    var letter: aLetter is aleph;
+    var array [letter] integer: occurrence is letter times 0;
+  begin
+    for count range 1 to 1000000 do
+      aLetter := randomLetter;
+      incr(occurrence[aLetter]);
+    end for;
+    writeln("Name   Count  Ratio    Expected");
+    for aLetter range letter.first to letter.last do
+      writeln(aLetter rpad 7 <& occurrence[aLetter] lpad 6 <&
+              flt(occurrence[aLetter]) / 10000.9 digits 4 lpad 8 <& "%" <&
+              100.0 * flt(table[aLetter]) / 27720.0 digits 4 lpad 8 <& "%");
+    end for;
+  end func;

Task/Probabilistic-choice/Tcl/probabilistic-choice.tcl

@@ -0,0 +1,37 @@
+package require Tcl 8.5
+
+set map [dict create]
+set sum 0.0
+
+foreach name {aleph beth gimel daleth he waw zayin} \
+        prob {1/5.0 1/6.0 1/7.0 1/8.0 1/9.0 1/10.0 1/11.0} \
+{
+    set prob [expr $prob]
+    set sum [expr {$sum + $prob}]
+    dict set map $name [dict create probability $prob limit $sum count 0]
+}
+dict set map heth [dict create probability [expr {1.0 - $sum}] limit 1.0 count 0]
+
+set samples 1000000
+for {set i 0} {$i < $samples} {incr i} {
+    set n [expr {rand()}]
+    foreach name [dict keys $map] {
+        if {$n <= [dict get $map $name limit]} {
+            set count [dict get $map $name count]
+            dict set map $name count [incr count]
+            break
+        }
+    }
+}
+
+puts "using $samples samples:"
+puts [format "%-10s %-21s %-9s %s" "" expected actual difference]
+
+dict for {name submap} $map {
+    dict with submap {
+        set actual [expr {$count * 1.0 / $samples}]
+        puts [format "%-10s %-21s %-9s %4.2f%%" $name $probability $actual \
+                [expr {abs($actual - $probability)/$probability*100.0}]
+             ]
+    }
+}

Task/Probabilistic-choice/Ursala/probabilistic-choice.ursala

@@ -0,0 +1,18 @@
+#import std
+#import nat
+#import flo
+
+outcomes = <'aleph ','beth  ','gimel ','daleth','he    ','waw   ','zayin ','heth  '>
+probabilities = ^lrNCT(~&,minus/1.+ plus:-0) div/*1. float* skip/5 iota12
+
+simulation =
+
+^(~&rn,div+ float~~rmPlX)^*D/~& iota; ^A(~&h,length)*K2+ * stochasm@p/probabilities !* outcomes
+
+format =
+
+:/'        frequency   probability'+  * ^lrlrTPT/~&n (printf/'%12.8f')^~/~&m outcomes-$probabilities@n
+
+#show+
+
+results = format simulation 1000000

Task/Probabilistic-choice/XPL0/probabilistic-choice.xpl0

@@ -0,0 +1,27 @@
+include c:\cxpl\codes;
+def Size = 10_000_000;
+int Tbl(12+1);
+int I, J, N;
+real X, S0, S1;
+[for J:= 5 to 12 do Tbl(J):= 0;
+ for I:= 0 to 1_000_000-1 do                    \generate one million items
+        [N:= Ran(Size);
+        for J:= 5 to 11 do
+                [N:= N - Size/J;
+                if N < 0 then [Tbl(J):= Tbl(J)+1;  J:= 100];
+                ];
+        if J=12 then Tbl(12):= Tbl(12)+1;
+        ];
+S0:= 0.0;  S1:= 0.0;
+for J:= 5 to 11 do
+        [X:= 1.0/float(J);                      RlOut(0, X);  S0:= S0+X;
+         X:= float(Tbl(J)) / 1_000_000.0;       RlOut(0, X);  S1:= S1+X;
+        CrLf(0);
+        ];
+X:= 1759.0 / 27720.0;                           RlOut(0, X);  S0:= S0+X;
+X:= float(Tbl(12)) / 1_000_000.0;               RlOut(0, X);  S1:= S1+X;
+CrLf(0);
+Text(0, "    -------    -------
+");
+RlOut(0, S0);  RlOut(0, S1);
+]