]> gitweb.factorcode.org Git - factor.git/commitdiff
Add 'dice7' implementation for RosettaCode.org.
authorAlexander Iljin <ajsoft@yandex.ru>
Tue, 7 Apr 2015 13:48:55 +0000 (20:48 +0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 12 Apr 2015 01:22:06 +0000 (18:22 -0700)
http://rosettacode.org/wiki/Seven-sided_dice_from_five-sided_dice#Factor
http://rosettacode.org/wiki/Verify_distribution_uniformity/Naive#Factor

dice7.factor [new file with mode: 0644]

diff --git a/dice7.factor b/dice7.factor
new file mode 100644 (file)
index 0000000..6f67b5c
--- /dev/null
@@ -0,0 +1,62 @@
+! Copyright (C) 2015 Alexander Ilin, John Benediktsson.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: kernel random sequences assocs locals sorting prettyprint\r
+  math math.functions math.statistics math.vectors math.ranges ;\r
+IN: rosetta-code.dice7\r
+\r
+! http://rosettacode.org/wiki/Seven-sided_dice_from_five-sided_dice\r
+! http://rosettacode.org/wiki/Simple_Random_Distribution_Checker\r
+\r
+! Output a random integer 1..5.\r
+: dice5 ( -- x )\r
+   5 [1,b] random\r
+;\r
+\r
+! Output a random integer 1..7 using dice5 as randomness source.\r
+: dice7 ( -- x )\r
+   0 [ dup 21 < ] [ drop dice5 5 * dice5 + 6 - ] do until\r
+   7 rem 1 +\r
+;\r
+\r
+! Roll the die by calling the quotation the given number of times and return\r
+! an array with roll results.\r
+! Sample call: 1000 [ dice7 ] roll\r
+: roll ( times quot: ( -- x ) -- array )\r
+   [ call( --  x ) ] curry replicate\r
+;\r
+\r
+! Input array contains outcomes of a number of die throws. Each die result is\r
+! an integer in the range 1..X. Calculate and return the number of each\r
+! of the results in the array so that in the first position of the result\r
+! there is the number of ones in the input array, in the second position\r
+! of the result there is the number of twos in the input array, etc.\r
+: count-dice-outcomes ( X array -- array )\r
+    histogram\r
+    swap [1,b] [ over [ 0 or ] change-at ] each\r
+    sort-keys values\r
+;\r
+\r
+! Verify distribution uniformity/Naive. Delta is the acceptable deviation\r
+! from the ideal number of items in each bucket, expressed as a fraction of\r
+! the total count. Sides is the number of die sides. Die-func is a word that\r
+! produces a random number on stack in the range [1..sides], times is the\r
+! number of times to call it.\r
+! Sample call: 0.02 7 [ dice7 ] 100000 verify\r
+:: verify ( delta sides die-func: ( -- random ) times -- )\r
+   sides\r
+   times die-func roll\r
+   count-dice-outcomes\r
+   dup .\r
+   times sides / :> ideal-count\r
+   ideal-count v-n vabs\r
+   times v/n\r
+   delta [ < ] curry all?\r
+   [ "Random enough" . ] [ "Not random enough" . ] if\r
+;\r
+\r
+\r
+! Call verify with 1, 10, 100, ... 1000000 rolls of 7-sided die.\r
+: verify-all ( -- )\r
+   { 1 10 100 1000 10000 100000 1000000 }\r
+   [| times | 0.02 7 [ dice7 ] times verify ] each\r
+;\r