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

Update all new Tasks

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 09:02:09 -05:00
parent 00a190b0a6
commit 91df62d461
5697 changed files with 93386 additions and 804 deletions
Download patch file Download diff file Expand all files Collapse all files

23
Task/Bernoulli-numbers/00DESCRIPTION Normal file
View file

@ -0,0 +1,23 @@
[[wp:Bernoulli number|Bernoulli numbers]] are used in some series expansions of several functions (trigonometric, hyperbolic, gamma, etc.), and are extremely important in number theory and analysis. Note that there are two definitions of Bernoulli numbers; this task will be using the modern usage (as per the National Institute of Standards and Technology convention). The <math>n</math>'th Bernoulli number is expressed as <span style="font-family:serif">'''B'''<sub>''n''</sub></span>.
;Task
* show the Bernoulli numbers <span style="font-family:serif">'''B'''<sub>0</sub></span> through <span style="font-family:serif">'''B'''<sub>60</sub></span>, suppressing all output of values which are equal to zero. (Other than <span style="font-family:serif">'''B'''<sub>1</sub></span>, all odd Bernoulli numbers have a value of 0 (zero).
* express the numbers as fractions (most are improper fractions).
** fractions should be reduced.
** index each number in some way so that it can be discerned which number is being displayed.
** align the solidi (<tt>/</tt>) if used (extra credit).
;An algorithm
The Akiyama–Tanigawa algorithm for the "second Bernoulli numbers" as taken from [[wp:Bernoulli_number#Algorithmic_description|wikipedia]] is as follows:
'''for''' ''m'' '''from''' 0 '''by''' 1 '''to''' ''n'' '''do'''
''A''[''m''] ← 1/(''m''+1)
'''for''' ''j'' '''from''' ''m'' '''by''' -1 '''to''' 1 '''do'''
''A''[''j''-1] ← ''j''×(''A''[''j''-1] - ''A''[''j''])
'''return''' ''A''[0] (which is ''B''<sub>''n''</sub>)
;See also
* Sequence [http://oeis.org/A027641 A027641 Numerator of Bernoulli number B_n] on The On-Line Encyclopedia of Integer Sequences.
* Sequence [http://oeis.org/A027642 A027642 Denominator of Bernoulli number B_n] on The On-Line Encyclopedia of Integer Sequences.
* Entry [http://mathworld.wolfram.com/BernoulliNumber.html Bernoulli number] on The Eric Weisstein's World of Mathematics (TM).
* Luschny's [http://luschny.de/math/zeta/The-Bernoulli-Manifesto.html The Bernoulli Manifesto] for a discussion on <math>B_1</math> = -&frac12; vs. +&frac12;.

2
Task/Bernoulli-numbers/00META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
note: Mathematics

51
Task/Bernoulli-numbers/C/bernoulli-numbers.c Normal file
View file

@ -0,0 +1,51 @@
#include <stdlib.h>
#include <gmp.h>
#define mpq_for(buf, op, n)\
do {\
size_t i;\
for (i = 0; i < (n); ++i)\
mpq_##op(buf[i]);\
} while (0)
void bernoulli(mpq_t rop, unsigned int n)
{
unsigned int m, j;
mpq_t *a = malloc(sizeof(mpq_t) * (n + 1));
mpq_for(a, init, n + 1);
for (m = 0; m <= n; ++m) {
mpq_set_ui(a[m], 1, m + 1);
for (j = m; j > 0; --j) {
mpq_sub(a[j-1], a[j], a[j-1]);
mpq_set_ui(rop, j, 1);
mpq_mul(a[j-1], a[j-1], rop);
}
}
mpq_set(rop, a[0]);
mpq_for(a, clear, n + 1);
free(a);
}
int main(void)
{
mpq_t rop;
mpz_t n, d;
mpq_init(rop);
mpz_inits(n, d, NULL);
unsigned int i;
for (i = 0; i <= 60; ++i) {
bernoulli(rop, i);
if (mpq_cmp_ui(rop, 0, 1)) {
mpq_get_num(n, rop);
mpq_get_den(d, rop);
gmp_printf("B(%-2u) = %44Zd / %Zd\n", i, n, d);
}
}
mpz_clears(n, d, NULL);
mpq_clear(rop);
return 0;
}

43
Task/Bernoulli-numbers/Common-Lisp/bernoulli-numbers.lisp Normal file
View file

@ -0,0 +1,43 @@
(defun bernouilli (n)
(loop with a = (make-array (list (1+ n)))
for m from 0 to n do
(setf (aref a m) (/ 1 (+ m 1)))
(loop for j from m downto 1 do
(setf (aref a (- j 1))
(* j (- (aref a j) (aref a (- j 1))))))
finally (return (aref a 0))))
;;Print outputs to stdout:
(loop for n from 0 to 60 do
(let ((b (bernouilli n)))
(when (not (zerop b))
(format t "~a: ~a~%" n b))))
;;For the "extra credit" challenge, we need to align the slashes.
(let (results)
;;collect the results
(loop for n from 0 to 60 do
(let ((b (bernouilli n)))
(when (not (zerop b)) (push (cons b n) results))))
;;parse the numerators into strings; save the greatest length in max-length
(let ((max-length (apply #'max (mapcar (lambda (r)
(length (format nil "~a" (numerator r))))
(mapcar #'car results)))))
;;Print the numbers with using the fixed-width formatter: ~Nd, where N is
;;the number of leading spaces. We can't just pass in the width variable
;;but we can splice together a formatting string that includes it.
;;We also can't use the fixed-width formatter on a ratio, so we have to split
;;the ratio and splice it back together like idiots.
(loop for n in (mapcar #'cdr (reverse results))
for r in (mapcar #'car (reverse results)) do
(format t (concatenate 'string
"B(~2d): ~"
(format nil "~a" max-length)
"d/~a~%")
n
(numerator r)
(denominator r)))))

18
Task/Bernoulli-numbers/D/bernoulli-numbers.d Normal file
View file

@ -0,0 +1,18 @@
import std.stdio, std.range, std.algorithm, std.conv, arithmetic_rational;
auto bernoulli(in uint n) pure nothrow /*@safe*/ {
auto A = new Rational[n + 1];
foreach (immutable m; 0 .. n + 1) {
A[m] = Rational(1, m + 1);
foreach_reverse (immutable j; 1 .. m + 1)
A[j - 1] = j * (A[j - 1] - A[j]);
}
return A[0];
}
void main() {
immutable berns = 61.iota.map!bernoulli.enumerate.filter!(t => t[1]).array;
immutable width = berns.map!(b => b[1].numerator.text.length).reduce!max;
foreach (immutable b; berns)
writefln("B(%2d) = %*d/%d", b[0], width, b[1].tupleof);
}

33
Task/Bernoulli-numbers/Go/bernoulli-numbers.go Normal file
View file

@ -0,0 +1,33 @@
package main
import (
"fmt"
"math/big"
"strings"
)
func b(n int) *big.Rat {
var f big.Rat
a := make([]big.Rat, n+1)
for m := range a {
a[m].SetFrac64(1, int64(m+1))
for j := m; j >= 1; j-- {
d := &a[j-1]
d.Mul(f.SetInt64(int64(j)), d.Sub(d, &a[j]))
}
}
return f.Set(&a[0])
}
func align(b *big.Rat, w int) string {
s := b.String()
return strings.Repeat(" ", w-strings.Index(s, "/")) + s
}
func main() {
for n := 0; n <= 60; n++ {
if b := b(n); b.Num().BitLen() > 0 {
fmt.Printf("B(%2d) =%s\n", n, align(b, 45))
}
}
}

17
Task/Bernoulli-numbers/Haskell/bernoulli-numbers.hs Normal file
View file

@ -0,0 +1,17 @@
module Main where
import Data.Ratio
import System.Environment
main = getArgs >>= printM . defaultArg where
defaultArg as = if null as then 60 else read (head as)
printM m = mapM_ (putStrLn . printP) . takeWhile ((<= m).fst)
. filter (\(_,b) -> b /= 0%1) . zip [0..] $ bernoullis
printP (i,r) = "B(" ++ show i ++ ")=" ++ show (numerator r) ++ "/" ++ show (denominator r)
bernoullis = map head . iterate (ulli 1) . map berno $ enumFrom 0 where
berno i = 1 % (i+1)
ulli _ [_] = []
ulli i (x:y:xs) = (i%1)*(x-y) : ulli (i+1) (y:xs)

20
Task/Bernoulli-numbers/Icon/bernoulli-numbers.icon Normal file
View file

@ -0,0 +1,20 @@
link "rational"
procedure main(args)
limit := integer(!args) | 60
every b := bernoulli(i := 0 to limit) do
if b.numer > 0 then write(right(i,3),": ",align(rat2str(b),60))
end
procedure bernoulli(n)
(A := table(0))[0] := rational(1,1,1)
every m := 1 to n do {
A[m] := rational(1,m+1,1)
every j := m to 1 by -1 do A[j-1] := mpyrat(rational(j,1,1), subrat(A[j-1],A[j]))
}
return A[0]
end
procedure align(r,n)
return repl(" ",n-find("/",r))||r
end

3
Task/Bernoulli-numbers/J/bernoulli-numbers-1.j Normal file
View file

@ -0,0 +1,3 @@
B=:3 :0"0
+/,(<:*(_1^[)*!*(y^~1+[)%1+])"0/~i.1x+y
)

34
Task/Bernoulli-numbers/J/bernoulli-numbers-2.j Normal file
View file

@ -0,0 +1,34 @@
require'strings'
'B',.rplc&'r/_-'"1": (#~ 0 ~: {:"1)(,.B) i.61
B 0 1
B 1 1/2
B 2 1/6
B 4 -1/30
B 6 1/42
B 8 -1/30
B10 5/66
B12 -691/2730
B14 7/6
B16 -3617/510
B18 43867/798
B20 -174611/330
B22 854513/138
B24 -236364091/2730
B26 8553103/6
B28 -23749461029/870
B30 8615841276005/14322
B32 -7709321041217/510
B34 2577687858367/6
B36 -26315271553053477373/1919190
B38 2929993913841559/6
B40 -261082718496449122051/13530
B42 1520097643918070802691/1806
B44 -27833269579301024235023/690
B46 596451111593912163277961/282
B48 -5609403368997817686249127547/46410
B50 495057205241079648212477525/66
B52 -801165718135489957347924991853/1590
B54 29149963634884862421418123812691/798
B56 -2479392929313226753685415739663229/870
B58 84483613348880041862046775994036021/354
B60 -1215233140483755572040304994079820246041491/56786730

11
Task/Bernoulli-numbers/Maple/bernoulli-numbers.maple Normal file
View file

@ -0,0 +1,11 @@
k:=length(numer(bernoulli(60))):
G := proc(n) local b,i;
b := `if`(n=1/2,1/2,bernoulli(2*n));
printf("%a%s%a\n",'B'[2*n],
cat(" "$i=1..(5+k-length(numer(b))
+(1+signum(b))/2)-length(2*n)),b);
NULL;
end proc:
G(0), G(1/2), seq(G(i),i=1..30);

11
Task/Bernoulli-numbers/Mathematica/bernoulli-numbers-1.math Normal file
View file

@ -0,0 +1,11 @@
bernoulli[n_] := Module[{a = ConstantArray[0, n + 2]},
Do[
a[[m]] = 1/m;
If[m == 1 && a[[1]] != 0, Print[{m - 1, a[[1]]}]];
Do[
a[[j - 1]] = (j - 1)*(a[[j - 1]] - a[[j]]);
If[j == 2 && a[[1]] != 0, Print[{m - 1, a[[1]]}]];
, {j, m, 2, -1}];
, {m, 1, n + 1}];
]
bernoulli[60]

2
Task/Bernoulli-numbers/Mathematica/bernoulli-numbers-2.math Normal file
View file

@ -0,0 +1,2 @@
Table[{i, BernoulliB[i]}, {i, 0, 60}];
Select[%, #[[2]] != 0 &] // TableForm

1
Task/Bernoulli-numbers/PARI-GP/bernoulli-numbers.pari Normal file
View file

@ -0,0 +1 @@
for(n=0,60,t=bernfrac(n);if(t,print(n" "t)))

33
Task/Bernoulli-numbers/PL-I/bernoulli-numbers.pli Normal file
View file

@ -0,0 +1,33 @@
Bern: procedure options (main); /* 4 July 2014 */
declare i fixed binary;
declare B complex fixed (31);
Bernoulli: procedure (n) returns (complex fixed (31));
declare n fixed binary;
declare anum(0:n) fixed (31), aden(0:n) fixed (31);
declare (j, m) fixed;
declare F fixed (31);
do m = 0 to n;
anum(m) = 1;
aden(m) = m+1;
do j = m to 1 by -1;
anum(j-1) = j*( aden(j)*anum(j-1) - aden(j-1)*anum(j) );
aden(j-1) = ( aden(j-1) * aden(j) );
F = gcd(abs(anum(j-1)), abs(aden(j-1)) );
if F ^= 1 then
do;
anum(j-1) = anum(j-1) / F;
aden(j-1) = aden(j-1) / F;
end;
end;
end;
return ( complex(anum(0), aden(0)) );
end Bernoulli;
do i = 0, 1, 2 to 36 by 2; /* 36 is upper limit imposed by hardware. */
B = Bernoulli(i);
put skip edit ('B(' , trim(i) , ')=' , real(B) , '/' , trim(imag(B)) )
(3 A, column(10), F(32), 2 A);
end;
end Bern;

17
Task/Bernoulli-numbers/Perl-6/bernoulli-numbers-1.pl6 Normal file
View file

@ -0,0 +1,17 @@
sub bernoulli($n) {
my @a;
for 0..$n -> $m {
@a[$m] = FatRat.new(1, $m + 1);
for reverse 1..$m -> $j {
@a[$j - 1] = $j * (@a[$j - 1] - @a[$j]);
}
}
return @a[0];
}
constant @bpairs = grep *.value.so, ($_ => bernoulli($_) for 0..60);
my $width = [max] @bpairs.map: *.value.numerator.chars;
my $form = "B(%2d) = \%{$width}d/%d\n";
printf $form, .key, .value.nude for @bpairs;

18
Task/Bernoulli-numbers/Perl-6/bernoulli-numbers-2.pl6 Normal file
View file

@ -0,0 +1,18 @@
constant bernoulli = gather {
my @a;
for 0..* -> $m {
@a = FatRat.new(1, $m + 1),
-> $prev {
my $j = @a.elems;
$j * (@a.shift - $prev);
} ... { not @a.elems }
take $m => @a[*-1] if @a[*-1];
}
}
constant @bpairs = bernoulli[^52];
my $width = [max] @bpairs.map: *.value.numerator.chars;
my $form = "B(%d)\t= \%{$width}d/%d\n";
printf $form, .key, .value.nude for @bpairs;

7
Task/Bernoulli-numbers/Perl-6/bernoulli-numbers-3.pl6 Normal file
View file

@ -0,0 +1,7 @@
my sub infix:<bop>(\prev,\this) { this.key => this.key * (this.value - prev.value) }
constant bernoulli = grep *.value, map { (.key => .value.[*-1]) }, do
0 => [FatRat.new(1,1)],
-> (:key($pm),:value(@pa)) {
$pm + 1 => [ map *.value, [\bop] ($pm + 2 ... 1) Z=> FatRat.new(1, $pm + 2), @pa ];
} ... *;

24
Task/Bernoulli-numbers/Perl/bernoulli-numbers-1.pl Normal file
View file

@ -0,0 +1,24 @@
#!perl
use strict;
use warnings;
use List::Util qw(max);
use Math::BigRat;
my $one = Math::BigRat->new(1);
sub bernoulli_print {
my @a;
for my $m ( 0 .. 60 ) {
push @a, $one / ($m + 1);
for my $j ( reverse 1 .. $m ) {
# This line:
( $a[$j-1] -= $a[$j] ) *= $j;
# is a faster version of the following line:
# $a[$j-1] = $j * ($a[$j-1] - $a[$j]);
# since it avoids unnecessary object creation.
}
next unless $a[0];
printf "B(%2d) = %44s/%s\n", $m, $a[0]->parts;
}
}
bernoulli_print();

6
Task/Bernoulli-numbers/Perl/bernoulli-numbers-2.pl Normal file
View file

@ -0,0 +1,6 @@
use ntheory qw/bernfrac/;
for my $n (0 .. 60) {
my($num,$den) = bernfrac($n);
printf "B(%2d) = %44s/%s\n", $n, $num, $den if $num != 0;
}

6
Task/Bernoulli-numbers/Perl/bernoulli-numbers-3.pl Normal file
View file

@ -0,0 +1,6 @@
use Math::Pari qw/bernfrac/;
for my $n (0 .. 60) {
my($num,$den) = split "/", bernfrac($n);
printf("B(%2d) = %44s/%s\n", $n, $num, $den||1) if $num != 0;
}

74
Task/Bernoulli-numbers/PicoLisp/bernoulli-numbers.l Normal file
View file

@ -0,0 +1,74 @@
(load "@lib/frac.l")
(de fact (N)
(cache '(NIL) N
(if (=0 N) 1 (apply * (range 1 N))) ) )
(de binomial (N K)
(frac
(/
(fact N)
(* (fact (- N K)) (fact K)) )
1 ) )
(de A (N M)
(let Sum (0 . 1)
(for X M
(setq Sum
(f+
Sum
(f*
(binomial (+ N 3) (- N (* X 6)))
(berno (- N (* X 6)) ) ) ) ) )
Sum ) )
(de berno (N)
(cache '(NIL) N
(cond
((=0 N) (1 . 1))
((= 1 N) (-1 . 2))
((bit? 1 N) (0 . 1))
(T
(case (% N 6)
(0
(f/
(f-
(frac (+ N 3) 3)
(A N (/ N 6)) )
(binomial (+ N 3) N) ) )
(2
(f/
(f-
(frac (+ N 3) 3)
(A N (/ (- N 2) 6)) )
(binomial (+ N 3) N) ) )
(4
(f/
(f-
(f* (-1 . 1) (frac (+ N 3) 6))
(A N (/ (- N 4) 6)) )
(binomial (+ N 3) N) ) ) ) ) ) ) )
(de berno-brute (N)
(cache '(NIL) N
(let Sum (0 . 1)
(cond
((=0 N) (1 . 1))
((= 1 N) (-1 . 2))
((bit? 1 N) (0 . 1))
(T
(for (X 0 (> N X) (inc X))
(setq Sum
(f+
Sum
(f* (binomial (inc N) X) (berno-brute X)) ) ) )
(f/ (f* (-1 . 1) Sum) (binomial (inc N) N)) ) ) ) ) )
(for (N 0 (> 62 N) (inc N))
(if (or (= N 1) (not (bit? 1 N)))
(tab (2 4 -60) N " => " (sym (berno N))) ) )
(for (N 0 (> 400 N) (inc N))
(test (berno N) (berno-brute N)) )
(bye)

15
Task/Bernoulli-numbers/Python/bernoulli-numbers-1.py Normal file
View file

@ -0,0 +1,15 @@
from fractions import Fraction as Fr
def bernoulli(n):
A = [0] * (n+1)
for m in range(n+1):
A[m] = Fr(1, m+1)
for j in range(m, 0, -1):
A[j-1] = j*(A[j-1] - A[j])
return A[0] # (which is Bn)
bn = [(i, bernoulli(i)) for i in range(61)]
bn = [(i, b) for i,b in bn if b]
width = max(len(str(b.numerator)) for i,b in bn)
for i,b in bn:
print('B(%2i) = %*i/%i' % (i, width, b.numerator, b.denominator))

14
Task/Bernoulli-numbers/Python/bernoulli-numbers-2.py Normal file
View file

@ -0,0 +1,14 @@
def bernoulli2():
A, m = [], 0
while True:
A.append(Fr(1, m+1))
for j in range(m, 0, -1):
A[j-1] = j*(A[j-1] - A[j])
yield A[0] # (which is Bm)
m += 1
bn2 = [ix for ix in zip(range(61), bernoulli2())]
bn2 = [(i, b) for i,b in bn2 if b]
width = max(len(str(b.numerator)) for i,b in bn2)
for i,b in bn2:
print('B(%2i) = %*i/%i' % (i, width, b.numerator, b.denominator))

1
Task/Bernoulli-numbers/README Normal file
View file

@ -0,0 +1 @@
Data source: http://rosettacode.org/wiki/Bernoulli_numbers

53
Task/Bernoulli-numbers/REXX/bernoulli-numbers.rexx Normal file
View file

@ -0,0 +1,53 @@
/*REXX program calculates a number of Bernoulli numbers (as fractions). */
parse arg N .; if N=='' then N=60 /*get N. If ¬ given, use default*/
!.=0; w=max(length(N),4); Nw=N+N%5 /*used for aligning the output. */
say 'B(n)' center('Bernoulli number expressed as a fraction', max(78-w,Nw))
say copies('─',w) copies('─', max(78-w,Nw+2*w))
do #=0 to N /*process numbers from 0 ──► N. */
b=bern(#); if b==0 then iterate /*calculate Bernoulli#, skip if 0*/
indent=max(0, nW-pos('/', b)) /*calculate alignment indentation*/
say right(#,w) left('',indent) b /*display the indented Bernoulli#*/
end /*#*/ /* [↑] align the Bernoulli number*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────BERN subroutine─────────────────────*/
bern: parse arg x /*obtain the subroutine argument.*/
if x==0 then return '1/1' /*handle the special case of zero*/
if x==1 then return '-1/2' /* " " " " " one.*/
if x//2 then return 0 /* " " " " " odds*/
/* [↓] process all #s up to X, */
do j=2 to x by 2; jp=j+1; d=j+j /* & set some shortcut vars.*/
if d>digits() then numeric digits d /*increase precision if needed. */
sn=1-j /*set the numerator. */
sd=2 /* " " denominator. */
do k=2 to j-1 by 2 /*calculate a SN/SD sequence. */
parse var @.k bn '/' ad /*get a previously calculated fra*/
an=comb(jp,k)*bn /*use COMBination for next term. */
lcm=lcm.(sd,ad) /*use Least Common Denominator. */
sn=lcm%sd*sn; sd=lcm /*calculate current numerator. */
an=lcm%ad*an; ad=lcm /* " next " */
sn=sn+an /* " current " */
end /*k*/ /* [↑] calculate SN/SD sequence.*/
sn=-sn /*adjust the sign for numerator. */
sd=sd*jp /*calculate the denominitator. */
if sn\==1 then do /*reduce the fraction if possible*/
_=gcd.(sn,sd) /*get Greatest Common Denominator*/
sn=sn%_; sd=sd%_ /*reduce numerator & denominator.*/
end /* [↑] done with the reduction.*/
@.j=sn'/'sd /*save the result for next round.*/
end /*j*/ /* [↑] done with calculating B#.*/
return sn'/'sd
/*──────────────────────────────────COMB subroutine─────────────────────*/
comb: procedure expose !.; parse arg x,y; if x==y then return 1
if !.!c.x.y\==0 then return !.!c.x.y /*combination computed before ? */
if x-y<y then y=x-y; z=perm(x,y); do j=2 to y; z=z%j; end
!.!c.x.y=z; return z /*assign memoization; then return*/
/*──────────────────────────────────GCD. subroutine (simplified)────────*/
gcd.: procedure; parse arg x,y; x=abs(x)
do until y==0; parse value x//y y with y x; end; return x
/*──────────────────────────────────LCM. subroutine (simplified)────────*/
lcm.: procedure; parse arg x,y; x=abs(x); return x*y/gcd.(x,y)
/*──────────────────────────────────PERM subroutine─────────────────────*/
perm: procedure expose !.; parse arg x,y; z=1
if !.!p.x.y\==0 then return !.!p.x.y /*permutation computed before ? */
do j=x-y+1 to x; z=z*j; end; !.!p.x.y=z; return z

84
Task/Bernoulli-numbers/Racket/bernoulli-numbers.rkt Normal file
View file

@ -0,0 +1,84 @@
#lang racket
;; For: http://rosettacode.org/wiki/Bernoulli_numbers
;; As described in task...
(define (bernoulli.1 n)
(define A (make-vector (add1 n)))
(for ((m (in-range 0 (add1 n))))
(vector-set! A m (/ (add1 m)))
(for ((j (in-range m (sub1 1) -1)))
(define new-A_j-1 (* j (- (vector-ref A (sub1 j)) (vector-ref A j))))
(vector-set! A (sub1 j) new-A_j-1)))
(vector-ref A 0))
(define (non-zero-bernoulli-indices s)
(sequence-filter (λ (n) (or (even? n) (= n 1))) s))
(define (bernoulli_0..n B N)
(for/list ((n (non-zero-bernoulli-indices (in-range (add1 N))))) (B n)))
;; From REXX description / http://mathworld.wolfram.com/BernoulliNumber.html #33
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; bernoulli.2 is for illustrative purposes, binomial is very costly if there is no memoisation
;; (which math/number-theory doesn't do)
(require (only-in math/number-theory binomial))
(define (bernoulli.2 n)
(for/sum ((k (in-range 0 (add1 n))))
(* (/ (add1 k))
(for/sum ((r (in-range 0 (add1 k))))
(* (expt -1 r) (binomial k r) (expt r n))))))
;; Three things to do:
;; 1. (expt -1 r): is 1 for even r, -1 for odd r... split the sum between those two.
;; 2. splitting the sum might has arithmetic advantages, too. We're using rationals, so the smaller
;; summations should require less normalisation of intermediate, fractional results
;; 3. a memoised binomial... although the one from math/number-theory is fast, it is (and its
;; factorials are) computed every time which is redundant
(define kCr-memo (make-hasheq))
(define !-memo (make-vector 1000 #f))
(vector-set! !-memo 0 1) ;; seed the memo
(define (! k)
(cond [(vector-ref !-memo k) => values]
[else (define k! (* k (! (- k 1)))) (vector-set! !-memo k k!) k!]))
(define (kCr k r)
; If we want (kCr ... r>1000000) we'll have to reconsider this. However, until then...
(define hash-key (+ (* 1000000 k) r))
(hash-ref! kCr-memo hash-key (λ () (/ (! k) (! r) (! (- k r))))))
(define (bernoulli.3 n)
(for/sum ((k (in-range 0 (add1 n))))
(define k+1 (add1 k))
(* (/ k+1)
(- (for/sum ((r (in-range 0 k+1 2))) (* (kCr k r) (expt r n)))
(for/sum ((r (in-range 1 k+1 2))) (* (kCr k r) (expt r n)))))))
(define (display/align-fractions caption/idx-fmt Bs)
;; widths are one more than the order of magnitude
(define oom+1 (compose add1 order-of-magnitude))
(define-values (I-width N-width D-width)
(for/fold ((I 0) (N 0) (D 0))
((b Bs) (n (non-zero-bernoulli-indices (in-naturals))))
(define +b (abs b))
(values (max I (oom+1 (max n 1)))
(max N (+ (oom+1 (numerator +b)) (if (negative? b) 1 0)))
(max D (oom+1 (denominator +b))))))
(define (~a/w/a n w a) (~a n #:width w #:align a))
(for ((n (non-zero-bernoulli-indices (in-naturals))) (b Bs))
(printf "~a ~a/~a~%"
(format caption/idx-fmt (~a/w/a n I-width 'right))
(~a/w/a (numerator b) N-width 'right)
(~a/w/a (denominator b) D-width 'left))))
(module+ main
(display/align-fractions "B(~a) =" (bernoulli_0..n bernoulli.3 60)))
(module+ test
(require rackunit)
; correctness and timing tests
(check-match (time (bernoulli_0..n bernoulli.1 60))
(list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
(check-match (time (bernoulli_0..n bernoulli.2 60))
(list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
(check-match (time (bernoulli_0..n bernoulli.3 60))
(list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
; timing only ...
(void (time (bernoulli_0..n bernoulli.3 100))))

13
Task/Bernoulli-numbers/Ruby/bernoulli-numbers.rb Normal file
View file

@ -0,0 +1,13 @@
bernoulli = Enumerator.new do |y|
ar, m = [], 0
loop do
ar << Rational(1, m+1)
m.downto(1){|j| ar[j-1] = j*(ar[j-1] - ar[j]) }
y << ar.first # yield
m += 1
end
end
b_nums = bernoulli.take(61)
width = b_nums.map{|b| b.numerator.to_s.size}.max
b_nums.each_with_index {|b,i| puts "B(%2i) = %*i/%i" % [i, width, b.numerator, b.denominator] unless b.zero? }

26
Task/Bernoulli-numbers/Tcl/bernoulli-numbers.tcl Normal file
View file

@ -0,0 +1,26 @@
proc bernoulli {n} {
for {set m 0} {$m <= $n} {incr m} {
lappend A [list 1 [expr {$m + 1}]]
for {set j $m} {[set i $j] >= 1} {} {
lassign [lindex $A [incr j -1]] a1 b1
lassign [lindex $A $i] a2 b2
set x [set p [expr {$i * ($a1*$b2 - $a2*$b1)}]]
set y [set q [expr {$b1 * $b2}]]
while {$q} {set q [expr {$p % [set p $q]}]}
lset A $j [list [expr {$x/$p}] [expr {$y/$p}]]
}
}
return [lindex $A 0]
}
set len 0
for {set n 0} {$n <= 60} {incr n} {
set b [bernoulli $n]
if {[lindex $b 0]} {
lappend result $n {*}$b
set len [expr {max($len, [string length [lindex $b 0]])}]
}
}
foreach {n num denom} $result {
puts [format {B_%-2d = %*lld/%lld} $n $len $num $denom]
}