Happy Pi day!

[Jack]

Code: (Select All)

$Console:Only
_Dest _Console

Declare Function find_pi(n As Integer, nbase As Integer) As String

Print find_pi(70, 2)
Print find_pi(70, 3)
Print find_pi(70, 7)
Print find_pi(70, 10)
Print find_pi(70, 16)

Function convert$ (n As _Unsigned _Integer64, nbase As Long)
    If nbase < 2 Or nbase > 36 Then
        convert$ = "base must be between 2 and 36"
        Exit Function
    End If
    Dim As String sn
    Dim As _Unsigned _Integer64 r
    Dim As String * 1 h(35)
    h(0) = "0": h(1) = "1": h(2) = "2": h(3) = "3": h(4) = "4": h(5) = "5": h(6) = "6"
    h(7) = "7": h(8) = "8": h(9) = "9": h(10) = "A": h(11) = "B": h(12) = "C": h(13) = "D"
    h(14) = "E": h(15) = "F": h(16) = "G": h(17) = "H": h(18) = "I": h(19) = "J"
    h(20) = "K": h(21) = "L": h(22) = "M": h(23) = "N": h(24) = "O": h(25) = "P"
    h(26) = "Q": h(27) = "R": h(28) = "S": h(29) = "T": h(30) = "U": h(31) = "V"
    h(32) = "W": h(33) = "X": h(34) = "Y": h(35) = "Z"
    If n = 0 Then
        convert$ = "0"
        Exit Function
    ElseIf n < 0 Then
        convert$ = "positive number only"
        Exit Function
    End If
    sn = ""
    While n >= nbase
        r = n Mod nbase
        n = n \ nbase
        sn = h(r) + sn
    Wend
    sn = h(n) + sn
    convert$ = sn
End Function

Sub array_mul (a() As Long, f As Long, n As Long, nbase As Long)
    Dim As Long c, p, h
    c = 0
    For p = n To 0 Step -1
        h = a(p) * f + c
        c = h \ nbase
        a(p) = h Mod nbase
    Next p
End Sub

Sub array_div (a() As Long, f As Long, n As Long, nbase As Long)
    Dim As Long b, p, h
    b = 0
    For p = 0 To n
        h = a(p) + b * nbase
        a(p) = h \ f
        b = h Mod f
    Next p
End Sub

Sub array_add (a() As Long, b() As Long, n As Long, nbase As Long)
    Dim As Long c, p, h
    c = 0
    For p = n To 0 Step -1
        h = a(p) + b(p) + c
        c = h \ nbase
        a(p) = h Mod nbase
    Next p
End Sub

Sub array_sub (a() As Long, b() As Long, n As Long, nbase As Long)
    Dim As Long b1, p, h
    b1 = 0
    For p = n To 0 Step -1
        h = a(p) - b(p) + nbase
        b1 = h \ nbase
        a(p) = h Mod nbase
        If (b1 = 0) Then a(p - 1) = a(p - 1) - 1
    Next p
End Sub

Function is_zero& (a() As Long, n As Long)
    Dim As Long p
    For p = 0 To n
        If a(p) Then
            is_zero = 0
            Exit Function
        End If
    Next p
    is_zero = 1
End Function

Sub arctan (t() As Long, s() As Long, div As Long, n As Long, nbase As Long)
    Dim As Long w, i
    s(0) = 1
    i = 1
    w = div
    array_div s(), w, n, nbase
    array_add t(), s(), n, nbase
    Do
        array_mul s(), i, n, nbase
        w = div * div
        array_div s(), w, n, nbase
        i = i + 2
        w = i
        array_div s(), w, n, nbase
        array_sub t(), s(), n, nbase
        array_mul s(), i, n, nbase
        w = div * div
        array_div s(), w, n, nbase
        i = i + 2
        w = i
        array_div s(), w, n, nbase
        array_add t(), s(), n, nbase
    Loop Until is_zero(s(), n)
End Sub

Function find_pi$ (n As Long, nbase As Long)
    If nbase < 2 Or nbase > 36 Then
        find_pi$ = "base must be between 2 and 36"
        Exit Function
    End If
    If n < 2 Then n = 2
    'Dim As Double tm = Timer
    Dim As String digit, uit
    Dim As Long i, f, s(n + 2), t(n + 2)
    uit = "pi in base " + Str$(nbase) + " = " + convert$(3, nbase) + "."
    f = 2
    arctan t(), s(), f, n, nbase
    f = 3
    arctan t(), s(), f, n, nbase
    array_mul t(), 4, n, nbase
    'tm=timer-tm
    For i = 1 To n - 1
        digit = convert$(t(i), nbase)
        uit = uit + digit
    Next i
    'Print "elapsed time = ";tm;" seconds"
    find_pi$ = uit
End Function