67 lines
1 KiB
Text
67 lines
1 KiB
Text
: n:log10e ` 1 10 ln / ` ;
|
|
|
|
with: n
|
|
|
|
: n:log10 \ n -- n
|
|
ln log10e * ;
|
|
|
|
: benford \ x -- x
|
|
1 swap / 1+ log10 ;
|
|
|
|
: fibs \ xt n
|
|
swap >r
|
|
0.0 1.0 rot
|
|
( dup r@ w:exec tuck + ) swap times
|
|
2drop rdrop ;
|
|
|
|
var counts
|
|
|
|
: init
|
|
a:new ( 0 a:push ) 9 times counts ! ;
|
|
|
|
: leading \ n -- n
|
|
"%g" s:strfmt
|
|
0 s:@ '0 - nip ;
|
|
|
|
: bump-digit \ n --
|
|
1 swap
|
|
counts @ swap 1- ' + a:op! drop ;
|
|
|
|
: count-fibs \ --
|
|
( leading bump-digit ) 1000 fibs ;
|
|
|
|
: adjust \ --
|
|
counts @ ( 0.001 * ) a:map counts ! ;
|
|
|
|
: spaces \ n --
|
|
' space swap times ;
|
|
|
|
: .fw \ s n --
|
|
>r s:len r> rot . swap - spaces ;
|
|
|
|
: .header \ --
|
|
"Digit" 8 .fw "Expected" 10 .fw "Actual" 10 .fw cr ;
|
|
|
|
: .digit \ n --
|
|
>s 8 .fw ;
|
|
|
|
: .actual \ n --
|
|
"%.3f" s:strfmt 10 .fw ;
|
|
|
|
: .expected \ n --
|
|
"%.4f" s:strfmt 10 .fw ;
|
|
|
|
: report \ --
|
|
.header
|
|
counts @
|
|
( swap 1+ dup benford swap
|
|
.digit .expected .actual cr )
|
|
a:each drop ;
|
|
|
|
: benford-test
|
|
init count-fibs adjust report ;
|
|
|
|
;with
|
|
|
|
benford-test
|
|
bye
|