147 lines
3.5 KiB
Text
147 lines
3.5 KiB
Text
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
|