Faulhaber's formula: Difference between revisions
Added FreeBASIC
m (→{{header|Wren}}: Minor tidy) |
(Added FreeBASIC) |
||
Line 827:
</pre>
=={{header|
{{trans|C}}
<syntaxhighlight lang="vbnet">Type Fraction
As Integer num
As Integer den
End Type
Function Binomial(n As Integer, k As Integer) As Integer
If n < 0 Or k < 0 Then Print "Arguments must be non-negative integers": Exit Function
If n < k Then Print "The second argument cannot be more than the first.": Exit Function
If n = 0 Or k = 0 Then Return 1
Dim As Integer i, num, den
num = 1
For i = k + 1 To n
num *= i
Next i
den = 1
For i = 2 To n - k
den *= i
Next i
Return num / den
End Function
Function GCD(n As Integer, d As Integer) As Integer
Return Iif(d = 0, n, GCD(d, n Mod d))
End Function
Function makeFrac(n As Integer, d As Integer) As Fraction
Dim As Fraction result
Dim As Integer g
If d = 0 Then
result.num = 0
result.den = 0
Return result
End If
If n = 0 Then
d = 1
Elseif d < 0 Then
n = -n
d = -d
End If
g = Abs(gcd(n, d))
If g > 1 Then
n /= g
d /= g
End If
result.num = n
result.den = d
Return result
End Function
Function negateFrac(f As Fraction) As Fraction
Return makeFrac(-f.num, f.den)
End Function
Function subFrac(lhs As Fraction, rhs As Fraction) As Fraction
Return makeFrac(lhs.num * rhs.den - lhs.den * rhs.num, rhs.den * lhs.den)
End Function
Function multFrac(lhs As Fraction, rhs As Fraction) As Fraction
Return makeFrac(lhs.num * rhs.num, lhs.den * rhs.den)
End Function
Function equalFrac(lhs As Fraction, rhs As Fraction) As Integer
Return (lhs.num = rhs.num) And (lhs.den = rhs.den)
End Function
Function lessFrac(lhs As Fraction, rhs As Fraction) As Integer
Return (lhs.num * rhs.den) < (rhs.num * lhs.den)
End Function
Sub printFrac(f As Fraction)
Print Str(f.num);
If f.den <> 1 Then Print "/" & f.den;
End Sub
Function Bernoulli(n As Integer) As Fraction
If n < 0 Then Print "Argument must be non-negative": Exit Function
Dim As Fraction a(16)
Dim As Integer j, m
If (n < 0) Then
a(0).num = 0
a(0).den = 0
Return a(0)
End If
For m = 0 To n
a(m) = makeFrac(1, m + 1)
For j = m To 1 Step -1
a(j - 1) = multFrac(subFrac(a(j - 1), a(j)), makeFrac(j, 1))
Next j
Next m
If n <> 1 Then Return a(0)
Return negateFrac(a(0))
End Function
Sub Faulhaber(p As Integer)
Dim As Fraction coeff, q
Dim As Integer j, pwr, sign
Print p & " : ";
q = makeFrac(1, p + 1)
sign = -1
For j = 0 To p
sign = -1 * sign
coeff = multFrac(multFrac(multFrac(q, makeFrac(sign, 1)), makeFrac(Binomial(p + 1, j), 1)), Bernoulli(j))
If (equalFrac(coeff, makeFrac(0, 1))) Then Continue For
If j = 0 Then
If Not equalFrac(coeff, makeFrac(1, 1)) Then
If equalFrac(coeff, makeFrac(-1, 1)) Then
Print "-";
Else
printFrac(coeff)
End If
End If
Else
If equalFrac(coeff, makeFrac(1, 1)) Then
Print " + ";
Elseif equalFrac(coeff, makeFrac(-1, 1)) Then
Print " - ";
Elseif lessFrac(makeFrac(0, 1), coeff) Then
Print " + ";
printFrac(coeff)
Else
Print " - ";
printFrac(negateFrac(coeff))
End If
End If
pwr = p + 1 - j
Print Iif(pwr > 1, "n^" & pwr, "n");
Next j
Print
End Sub
For i As Integer = 0 To 9
Faulhaber(i)
Next i
Sleep</syntaxhighlight>
{{out}}
<pre>Same as C entry.</pre>
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Faulhaber}}
'''Solution'''
The following function creates the Faulhaber's coefficients up to a given number of rows, according to the [http://www.ww.ingeniousmathstat.org/sites/default/files/Torabi-Dashti-CMJ-2011.pdf paper] of of Mohammad Torabi Dashti:
| |||