Data update

Task/Faulhabers-formula/FreeBASIC/faulhabers-formula.basic

@@ -0,0 +1,147 @@
+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