Faulhaber's formula: Difference between revisions
Content deleted Content added
Added FreeBASIC |
|||
| (4 intermediate revisions by 2 users not shown) | |||
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:
Line 2,788 ⟶ 2,938:
f(8) = 1/9 * (n^9 + (9/2)*n^8 + (6/1)*n^7 + (-21/5)*n^5 + (2/1)*n^3 + (-3/10)*n)
f(9) = 1/10 * (n^10 + (5/1)*n^9 + (15/2)*n^8 + (-7/1)*n^6 + (5/1)*n^4 + (-3/2)*n^2)
</pre>
=={{header|RPL}}==
{{works with|HP|49}}
≪ → p
≪ 0
p 0 '''FOR''' m
p 1 + m 1 + COMB
p m - IBERNOULLI
'''IF''' LASTARG 1 == '''THEN''' NEG '''END'''
* EVAL + 'n' *
-1 '''STEP'''
p 1 + / EXPAN
≫ ≫ '<span style="color:blue>FAULH</span>' STO
≪ P <span style="color:blue>FAULH</span> ≫ 'P' 0 9 1 SEQ
{{out}}
<pre>
1: {'n' '1/2n^2+1/2n' '1/3n^3+1/2n^2+1/6n' '1/4n^4+1/2n^3+1/4n^2' '1/5n^5+1/2n^4+1/3n^3-1/30n' '1/6n^6+1/2n^5+5/12n^4-1/12n^2' '1/7n^7+1/2n^6+1/2n^5-1/6n^3+1/42n' '1/8n^8+1/2n^7+7/12n^6-7/24n^4+1/12n^2' '1/9n^9+1/2n^8+2/3n^7-7/15n^5+2/9n^3-1/30n' '1/10n^10+1/2n^9+3/4n^8-7/10n^6+1/2n^4-3/20n^2'}
</pre>
Line 3,282 ⟶ 3,451:
{{libheader|Wren-math}}
{{libheader|Wren-rat}}
<syntaxhighlight lang="
import "./rat" for Rat
var bernoulli = Fn.new { |n|
| |||