Verify distribution uniformity/Naive: Difference between revisions
Content added Content deleted
(Add Forth) |
|||
Line 568: | Line 568: | ||
"Random enough"</pre> |
"Random enough"</pre> |
||
=={{header|Forth}}== |
|||
requires Forth200x locals |
|||
<lang forth>: .bounds ( u1 u2 -- ) ." lower bound = " . ." upper bound = " 1- . cr ; |
|||
: init-bins ( n -- addr ) |
|||
cells dup allocate throw tuck swap erase ; |
|||
: expected ( u1 cnt -- u2 ) over 2/ + swap / ; |
|||
: calc-limits ( n cnt pct -- low high ) |
|||
>r expected r> over 100 */ 2dup + 1+ >r - r> ; |
|||
: make-histogram ( bins xt cnt -- ) |
|||
0 ?do 2dup execute 1- cells + 1 swap +! loop 2drop ; |
|||
: valid-bin? ( addr n low high -- f ) |
|||
2>r cells + @ dup . 2r> within ; |
|||
: check-distribution {: xt cnt n pct -- f :} |
|||
\ assumes xt generates numbers from 1 to n |
|||
n init-bins {: bins :} |
|||
n cnt pct calc-limits {: low high :} |
|||
high low .bounds |
|||
bins xt cnt make-histogram |
|||
true \ result flag |
|||
n 0 ?do |
|||
i 1+ . ." : " bins i low high valid-bin? |
|||
dup 0= if ." not " then ." ok" cr |
|||
and |
|||
loop |
|||
bins free throw ;</lang> |
|||
{{output}} |
|||
<pre>cr ' d7 1000000 7 1 check-distribution . |
|||
lower bound = 141429 upper bound = 144285 |
|||
1 : 143241 ok |
|||
2 : 142397 ok |
|||
3 : 143522 ok |
|||
4 : 142909 ok |
|||
5 : 142001 ok |
|||
6 : 142844 ok |
|||
7 : 143086 ok |
|||
-1 |
|||
cr ' d7 10000 7 1 check-distribution . |
|||
lower bound = 1415 upper bound = 1443 |
|||
1 : 1431 ok |
|||
2 : 1426 ok |
|||
3 : 1413 not ok |
|||
4 : 1427 ok |
|||
5 : 1437 ok |
|||
6 : 1450 not ok |
|||
7 : 1416 ok |
|||
0</pre> |
|||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|95 and later}} |
{{works with|Fortran|95 and later}} |