aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/Benfords-law/8th/benfords-law.8th
View file

@ -24,8 +24,8 @@ var counts
0 s:@ '0 - nip ;
: bump-digit \ n --
counts @ swap 1- dup >r a:@
1+ r> swap a:! drop ;
1 swap
counts @ swap 1- ' + a:op! drop ;
: count-fibs \ --
( leading bump-digit ) 1000 fibs ;

25
Task/Benfords-law/Aime/benfords-law.aime
View file

@ -4,8 +4,8 @@ sum(text a, text b)
data d;
integer e, f, n, r;
e = length(a);
f = length(b);
e = ~a;
f = ~b;
r = 0;
@ -36,7 +36,7 @@ sum(text a, text b)
b_insert(d, 0, r + '0');
}
return b_string(d);
d;
}
text
@ -45,7 +45,7 @@ fibs(list l, integer n)
integer c, i;
text a, b, w;
l_r_integer(l, 1, 1);
l[1] = 1;
a = "0";
b = "1";
@ -55,11 +55,11 @@ fibs(list l, integer n)
a = b;
b = w;
c = w[0] - '0';
l_r_integer(l, c, 1 + l_q_integer(l, c));
l[c] = 1 + l[c];
i += 1;
}
return w;
w;
}
integer
@ -71,11 +71,7 @@ main(void)
n = 1000;
i = 10;
while (i) {
i -= 1;
lb_p_integer(f, 0);
}
f.pn_integer(0, 10, 0);
fibs(f, n);
@ -85,11 +81,8 @@ main(void)
i = 0;
while (i < 9) {
i += 1;
o_winteger(8, i);
o_wpreal(16, 3, 3, 100 * log10(1 + 1r / i));
o_wpreal(16, 3, 3, l_q_integer(f, i) * m);
o_text("\n");
o_form("%8d/p3d3w16//p3d3w16/\n", i, 100 * log10(1 + 1r / i), f[i] * m);
}
return 0;
0;
}

29
Task/Benfords-law/Factor/benfords-law.factor Normal file
View file

@ -0,0 +1,29 @@
USING: assocs compiler.tree.propagation.call-effect formatting
kernel math math.functions math.statistics math.text.utils
sequences ;
IN: rosetta-code.benfords-law
: expected ( n -- x ) recip 1 + log10 ;
: next-fib ( vec -- vec' )
[ last2 ] keep [ + ] dip [ push ] keep ;
: data ( -- seq ) V{ 1 1 } clone 998 [ next-fib ] times ;
: 1st-digit ( n -- m ) 1 digit-groups last ;
: leading ( -- seq ) data [ 1st-digit ] map ;
: .header ( -- )
"Digit" "Expected" "Actual" "%-10s%-10s%-10s\n" printf ;
: digit-report ( digit digit-count -- digit expected actual )
dupd [ expected ] dip 1000 /f ;
: .digit-report ( digit digit-count -- )
digit-report "%-10d%-10.4f%-10.4f\n" printf ;
: main ( -- )
.header leading histogram [ .digit-report ] assoc-each ;
MAIN: main

56
Task/Benfords-law/REXX/benfords-law.rexx
View file

@ -1,32 +1,38 @@
/*REXX program demonstrates some common functions (thirty decimal digits are shown). */
numeric digits 50 /*use only 50 dec digits for LN & LOG.*/
parse arg N .; if N=='' | N=="," then N=1000 /*allow sample size to be specified. */
@benny= "Benford's law applied to" /*a handy-dandy literal for some SAYs. */
w1= max(2+length('observed'), length(N-2) ); pad=" " /*used for aligning output.*/
w2= max(2+length('expected'), length(N ) ) /* " " " " */
@.=1; do j=3 to N; jm1=j-1; jm2=j-2; @.j=@.jm2 + @.jm1; end /*j*/
call show @benny N 'Fibonacci numbers'
p=1
@.1=2; do j=3 by 2 until p==N; if \isPrime(j) then iterate; p=p+1; @.p=j; end /*j*/
call show @benny N 'prime numbers'
!=1; do j=1 for N; !=!*j; end /*j*/
call show @benny N 'factorial products'
numeric digits length( e() ) - 1 /*use the width of (e) for LN & LOG. */
parse arg N .; if N=='' | N=="," then N= 1000 /*allow sample size to be specified. */
LN10=ln(10) /*calculate the natural log of ten #'s.*/
w1= max(2 + length('observed'), length(N-2) ) /*for aligning output for a number. */
w2= max(2 + length('expected'), length(N ) ) /* " " frequency distributions.*/
pad=" " /*W1, W2: # digs past the decimal point*/
do j=1 for 9; #.j=pad center( format( log( 1 + 1/j ), , length(N) + 2), w2)
end /*j*/ /* [↑] gen 9 frequencey coefficients.*/
@.=1
do j=3 for N; a=j-1; b=a-1; @.j= @.a + @.b
end /*j*/ /* [↑] generate N Fibonacci numbers.*/
call show "Benford's law applied to" N 'Fibonacci numbers'
@.1=1
do j=1 for N; @.j= @.j * N
end /*j*/ /* [↑] generate N factorials. */
call show "Benford's law applied to" N 'factorial products'
exit /*stick a fork in it, we're all done. */
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
e: return 2.7182818284590452353602874713526624977572470936999595749669676277240766303535
isPrime: procedure; parse arg x; if wordpos(x,'2 3 5 7')\==0 then return 1; if x//2==0 then return 0; if x//3==0 then return 0; do j=5 by 6 until j*j>x; if x//j==0 then return 0; if x//(j+2)==0 then return 0; end; return 1
ln: procedure; parse arg x; _=e(); ig=(x>1.5); is=1 - 2 * (ig \== 1); ii=0; s=x; return .ln()
.ln: do while ig&s>1.5|\ig&s<.5;do k=-1;iz=s*_**-is;if k>=0&(ig&iz<1|\ig&iz>.5) then leave;_=_*_;izz=iz;end;s=izz;ii=ii+is*2**k;end;x=x*e()**-ii-1;z=0;_=-1;p=z;do k=1;_=-_*x;z=z+_/k;if z=p then leave;p=z;end;return z+ii
log: return ln( arg(1) ) / ln(10)
/*──────────────────────────────────────────────────────────────────────────────────────*/
e: return 2.71828182845904523536028747135266249775724709369995957496696762772407663
log: return ln( arg(1) ) / LN10
ln: procedure; arg x; e=e(); _=e; ig=(x>1.5); is=1-2*(ig\=1); i=0; s=x; return .ln()
/*──────────────────────────────────────────────────────────────────────────────────────*/
.ln: do while ig&s>1.5 | \ig&s<.5
do k=-1; iz=s*_**-is; if k>=0 & (ig&iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz
end /*k*/
s=izz; i=i + is* 2**k; end /*while*/; x=x * e** - i - 1; z=0; _=-1; p=z
do k=1;_= -_ * x; z=z + _/k; if z=p then leave; p=z; end /*k*/; return z+i
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: say; say pad ' digit ' pad center("observed",w1) pad center('expected',w2)
say pad '───────' pad center("",w1,'─') pad center("",w2,'─') pad arg(1)
!.=0; do j=1 for N; _=left(@.j,1); !._=!._+1; end /*get 1st digits.*/
!.=0; do j=1 for N; _=left(@.j, 1); !._= !._ +1 /*get the 1st digit.*/
end /*j*/
do k=1 for 9 /*display results for decimal digits. */
say pad center(k,7) pad center(format(!.k /N , , length(N-2) ), w1),
pad center(format(log(1+1 /k) , , length(N)+2 ), w2)
end /*k*/
do f=1 for 9 /*show the results. */
say pad center(f,7) pad center( format( !.f/N, , length(N-2)), w1) #.f
end /*k*/
return

36
Task/Benfords-law/Ring/benfords-law.ring Normal file
View file

@ -0,0 +1,36 @@
# Project : Benford's law
# Date : 2017/11/29
# Author : Gal Zsolt (~ CalmoSoft ~)
# Email : <calmosoft@gmail.com>
decimals(3)
n= 1000
actual = list(n)
for x = 1 to len(actual)
actual[x] = 0
next
for nr = 1 to n
n1 = string(fibonacci(nr))
j = number(left(n1,1))
actual[j] = actual[j] + 1
next
see "Digit " + "Actual " + "Expected" + nl
for m = 1 to 9
fr = frequency(m)*100
see "" + m + " " + (actual[m]/10) + " " + fr + nl
next
func frequency(n)
freq = log10(n+1) - log10(n)
return freq
func log10(n)
log1 = log(n) / log(10)
return log1
func fibonacci(y)
if y = 0 return 0 ok
if y = 1 return 1 ok
if y > 1 return fibonacci(y-1) + fibonacci(y-2) ok