-
Notifications
You must be signed in to change notification settings - Fork 34
/
faulhaber_s_formulas_expanded_2.pl
executable file
·101 lines (77 loc) · 3.47 KB
/
faulhaber_s_formulas_expanded_2.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#!/usr/bin/perl
# Author: Daniel "Trizen" Șuteu
# License: GPLv3
# Date: 21 September 2015
# Website: https://github.com/trizen
# The script generates formulas for calculating the sum
# of consecutive numbers raised to a given power, such as:
# 1^p + 2^p + 3^p + ... + n^p
# where p is a positive integer.
# See also: https://en.wikipedia.org/wiki/Faulhaber%27s_formula
# To simplify the formulas, use Wolfram Alpha:
# https://www.wolframalpha.com/
use 5.010;
use strict;
use warnings;
use Math::AnyNum qw(:overload);
use Memoize qw( memoize );
memoize('binomial');
memoize('factorial');
memoize('bernoulli_number');
# Factorial
# See: https://en.wikipedia.org/wiki/Factorial
sub factorial {
my ($n) = @_;
return 1 if $n == 0;
my $f = $n;
while ($n-- > 1) {
$f = "$f*$n";
}
return $f;
}
# Binomial coefficient
# See: https://en.wikipedia.org/wiki/Binomial_coefficient
sub binomial {
my ($n, $k) = @_;
## This line expands the factorials
#return "(".factorial($n) .")" . "/((" . factorial($k).")*(". factorial($n-$k) . "))";
## This line expands the binomial coefficients into factorials
return "$n!/($k!*" . ($n - $k) . "!)";
## This line computes the binomial coefficients
#$k == 0 || $n == $k ? 1.0 : binomial($n - 1, $k - 1) + binomial($n - 1, $k);
}
# Bernoulli numbers
# See: https://en.wikipedia.org/wiki/Bernoulli_number#Algorithmic_description
sub bernoulli_number {
my ($n) = @_;
# return 0 if $n > 1 && $n % 2; # Bn = 0 for all odd n > 1
my @A;
for my $m (0 .. $n) {
$A[$m] = 1 / ($m + 1);
for (my $j = $m ; $j > 0 ; $j--) {
$A[$j - 1] = "$j*" . '(' . join('-', ($A[$j - 1], $A[$j])) . ')';
}
}
return $A[0]; # which is Bn
}
# Faulhaber's formula
# See: https://en.wikipedia.org/wiki/Faulhaber%27s_formula
sub faulhaber_s_formula {
my ($p, $n) = @_;
my @formula;
for my $j (0 .. $p) {
push @formula, ('(' . (binomial($p + 1, $j) . "*" . bernoulli_number($j)) . ')') . '*' . "n^" . ($p + 1 - $j);
}
my $formula = join(' + ', @formula);
"1/" . ($p + 1) . " * ($formula)";
}
for my $i (0 .. 5) {
printf "%d => %s\n", $i, faulhaber_s_formula($i + 0);
}
__END__
0 => 1/1 * ((1!/(0!*1!)*1)*n^1)
1 => 1/2 * ((2!/(0!*2!)*1)*n^2 + (2!/(1!*1!)*1*(1-1/2))*n^1)
2 => 1/3 * ((3!/(0!*3!)*1)*n^3 + (3!/(1!*2!)*1*(1-1/2))*n^2 + (3!/(2!*1!)*1*(1*(1-1/2)-2*(1/2-1/3)))*n^1)
3 => 1/4 * ((4!/(0!*4!)*1)*n^4 + (4!/(1!*3!)*1*(1-1/2))*n^3 + (4!/(2!*2!)*1*(1*(1-1/2)-2*(1/2-1/3)))*n^2 + (4!/(3!*1!)*1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4))))*n^1)
4 => 1/5 * ((5!/(0!*5!)*1)*n^5 + (5!/(1!*4!)*1*(1-1/2))*n^4 + (5!/(2!*3!)*1*(1*(1-1/2)-2*(1/2-1/3)))*n^3 + (5!/(3!*2!)*1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4))))*n^2 + (5!/(4!*1!)*1*(1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4)))-2*(2*(2*(1/2-1/3)-3*(1/3-1/4))-3*(3*(1/3-1/4)-4*(1/4-1/5)))))*n^1)
5 => 1/6 * ((6!/(0!*6!)*1)*n^6 + (6!/(1!*5!)*1*(1-1/2))*n^5 + (6!/(2!*4!)*1*(1*(1-1/2)-2*(1/2-1/3)))*n^4 + (6!/(3!*3!)*1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4))))*n^3 + (6!/(4!*2!)*1*(1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4)))-2*(2*(2*(1/2-1/3)-3*(1/3-1/4))-3*(3*(1/3-1/4)-4*(1/4-1/5)))))*n^2 + (6!/(5!*1!)*1*(1*(1*(1*(1*(1-1/2)-2*(1/2-1/3))-2*(2*(1/2-1/3)-3*(1/3-1/4)))-2*(2*(2*(1/2-1/3)-3*(1/3-1/4))-3*(3*(1/3-1/4)-4*(1/4-1/5))))-2*(2*(2*(2*(1/2-1/3)-3*(1/3-1/4))-3*(3*(1/3-1/4)-4*(1/4-1/5)))-3*(3*(3*(1/3-1/4)-4*(1/4-1/5))-4*(4*(1/4-1/5)-5*(1/5-1/6))))))*n^1)