Verify distribution uniformity/Naive: Difference between revisions

Content added Content deleted
(Add Factor implementation.)
(Update Factor implementation: some functions were simplified thanks to John Benediktsson.)
Line 459: Line 459:


=={{header|Factor}}==
=={{header|Factor}}==
<lang factor>USING: kernel random math math.functions math.vectors sequences locals prettyprint ;
<lang factor>USING: kernel random sequences assocs locals sorting prettyprint
math math.functions math.statistics math.vectors math.ranges ;
IN: dice7
IN: rosetta-code.dice7


! Output a random number 1..5.
! Output a random integer 1..5.
: dice5 ( -- x )
: dice5 ( -- x )
5 [1,b] random
random-unit 5 * floor 1 + >integer
;
;


! Output a random number 1..7 using dice5 as randomness source.
! Output a random integer 1..7 using dice5 as randomness source.
: dice7 ( -- x )
: dice7 ( -- x )
0 [ dup 21 < ] [ drop dice5 5 * dice5 + 6 - ] do until
0 [ dup 21 < ] [ drop dice5 5 * dice5 + 6 - ] do until
7 rem 1 + >integer
7 rem 1 +
;
;


! Roll dice using the passed word the given number of times and produce an
! Roll the die by calling the quotation the given number of times and return
! array with roll results.
! an array with roll results.
! Sample call: \ dice7 1000 roll
! Sample call: 1000 [ dice7 ] roll
: roll ( word: ( -- x ) times -- array )
: roll ( times quot: ( -- x ) -- array )
iota [ drop dup execute( -- x ) ] map
[ call( -- x ) ] curry replicate
nip
;
;


Line 486: Line 486:
! there is the number of ones in the input array, in the second position
! there is the number of ones in the input array, in the second position
! of the result there is the number of twos in the input array, etc.
! of the result there is the number of twos in the input array, etc.
: count-diceX-outcomes ( array X -- array )
: count-dice-outcomes ( X array -- array )
histogram
iota [ 1 + dupd [ = ] curry count ] map
swap [1,b] [ over [ 0 or ] change-at ] each
swap length
sort-keys values
over sum
assert=
;
;


! Verify distribution uniformity/Naive. Delta is the acceptable deviation
! Verify distribution uniformity/Naive. Delta is the acceptable deviation
! from the ideal number of items in each bucket, expressed as a fraction of
! from the ideal number of items in each bucket, expressed as a fraction of
! the total count. Sides is the number of die sides. Rnd-func is a word that
! the total count. Sides is the number of die sides. Die-func is a word that
! produces a random number on stack in the range [1..sides], times is the
! produces a random number on stack in the range [1..sides], times is the
! number of times to call it.
! number of times to call it.
! Sample call: 0.02 7 \ dice7 100000 verify
! Sample call: 0.02 7 [ dice7 ] 100000 verify
:: verify ( delta sides rnd-func: ( -- random ) times -- )
:: verify ( delta sides die-func: ( -- random ) times -- )
sides
rnd-func times roll
times die-func roll
sides count-diceX-outcomes
count-dice-outcomes
dup .
dup .
times sides / :> ideal-count
times sides / :> ideal-count
ideal-count v-n vabs
ideal-count v-n vabs
times v/n
times v/n
delta [ < ] curry map
delta [ < ] curry all?
vall? [ "Random enough" . ] [ "Not random enough" . ] if
[ "Random enough" . ] [ "Not random enough" . ] if
;
;


Line 514: Line 514:
: verify-all ( -- )
: verify-all ( -- )
{ 1 10 100 1000 10000 100000 1000000 }
{ 1 10 100 1000 10000 100000 1000000 }
[| times | 0.02 7 \ dice7 times verify ] each
[| times | 0.02 7 [ dice7 ] times verify ] each
;</lang>
;</lang>


Output:
Output:
<pre>USE: dice7 verify-all
<pre>USE: rosetta-code.dice7 verify-all
{ 0 1 0 0 0 0 0 }
{ 0 0 0 1 0 0 0 }
"Not random enough"
"Not random enough"
{ 3 3 1 1 1 1 0 }
{ 0 2 3 1 1 1 2 }
"Not random enough"
"Not random enough"
{ 11 12 18 22 12 13 12 }
{ 17 12 15 11 13 13 19 }
"Not random enough"
"Not random enough"
{ 151 130 172 138 145 141 123 }
{ 140 130 141 148 143 155 143 }
"Not random enough"
"Random enough"
{ 1404 1446 1371 1460 1431 1440 1448 }
{ 1457 1373 1427 1433 1443 1382 1485 }
"Random enough"
"Random enough"
{ 14311 14139 14388 14346 14150 14405 14261 }
{ 14225 14320 14216 14326 14415 14084 14414 }
"Random enough"
"Random enough"
{ 142599 141910 142524 143029 143353 142696 143889 }
{ 142877 143514 142441 142380 143141 143203 142444 }
"Random enough"</pre>
"Random enough"</pre>


Retrieved from "https://rosettacode.org/wiki/Verify_distribution_uniformity/Naive"