extra/rosetta-code/dice7/dice7.factor

   1 ! Copyright (C) 2015 Alexander Ilin, Doug Coleman, John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs fry kernel locals math ranges math.statistics
   4 math.vectors prettyprint random sequences sorting ;
   5 IN: rosetta-code.dice7
   6
   7 ! http://rosettacode.org/wiki/Seven-sided_dice_from_five-sided_dice
   8
   9 ! Given an equal-probability generator of one of the integers 1
  10 ! to 5 as dice5; create dice7 that generates a pseudo-random
  11 ! integer from 1 to 7 in equal probability using only dice5 as a
  12 ! source of random numbers, and check the distribution for at
  13 ! least 1000000 calls using the function created in Simple
  14 ! Random Distribution Checker.
  15
  16 ! Implementation suggestion: dice7 might call dice5 twice,
  17 ! re-call if four of the 25 combinations are given, otherwise
  18 ! split the other 21 combinations into 7 groups of three, and
  19 ! return the group index from the rolls.
  20
  21 ! http://rosettacode.org/wiki/Simple_Random_Distribution_Checker
  22
  23 ! Create a function to check that the random integers returned
  24 ! from a small-integer generator function have uniform
  25 ! distribution.
  26
  27 ! The function should take as arguments:
  28
  29 ! * The function (or object) producing random integers.
  30 ! * The number of times to call the integer generator.
  31 ! * A 'delta' value of some sort that indicates how close to a
  32 !   flat distribution is close enough.
  33
  34 ! The function should produce:
  35
  36 ! * Some indication of the distribution achieved.
  37 ! * An 'error' if the distribution is not flat enough.
  38
  39 ! Show the distribution checker working when the produced
  40 ! distribution is flat enough and when it is not. (Use a
  41 ! generator from Seven-dice from Five-dice).
  42
  43 ! Output a random integer 1..5.
  44 : dice5 ( -- x )
  45    5 [1..b] random ;
  46
  47 ! Output a random integer 1..7 using dice5 as randomness source.
  48 : dice7 ( -- x )
  49     0 [ dup 21 < ] [
  50         drop dice5 5 * dice5 + 6 -
  51     ] do until 7 rem 1 + ;
  52
  53 ! Count the number of rolls for each side of the dice,
  54 ! inserting zeros for die rolls that never occur.
  55 : count-outcomes ( #sides rolls -- counts )
  56     histogram
  57     swap [1..b] [ over [ 0 or ] change-at ] each
  58     sort-keys values ;
  59
  60 ! Assumes a fair die [1..n] thrown for sum(counts),
  61 ! where n is length(counts).
  62 : fair-counts? ( counts error -- ? )
  63     [
  64         [ ] [ sum ] [ length ] tri
  65         [ / v-n vabs ]
  66         [ drop v/n ] 2bi
  67     ] dip '[ _ < ] all? ;
  68
  69 ! Verify distribution uniformity/naive. Error is the acceptable
  70 ! deviation from the ideal number of items in each bucket,
  71 ! expressed as a fraction of the total count.
  72 :: test-distribution ( #sides #trials quot error -- )
  73     #sides #trials quot replicate count-outcomes :> outcomes
  74     outcomes .
  75     outcomes error fair-counts?
  76     "Random enough" "Not random enough" ? . ; inline
  77
  78 CONSTANT: trial-counts { 1 10 100 1000 10000 100000 1000000 }
  79 CONSTANT: #sides 7
  80 CONSTANT: error-delta 0.02
  81
  82 : verify-all ( -- )
  83     #sides trial-counts [
  84         [ dice7 ] error-delta test-distribution
  85     ] with each ;