Pete
I think the following was your previous version except that I changed limit&& and digits%, limit&& was 52 and digits% was 50, I also changed to console output
loop #13 is the last loop, loop #12 is accurate to 86 decimals
I think the following was your previous version except that I changed limit&& and digits%, limit&& was 52 and digits% was 50, I also changed to console output
loop #13 is the last loop, loop #12 is accurate to 86 decimals
Quote:loop #12 pi = 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628031244133064023
loop #13 pi = 3.141592704753823286968106636310008090364871048493655060239030000194318500280725372036486027296712004
Code: (Select All)
$Console:Only
_Dest _Console
Dim Shared digits%, limit&&, betatest%
limit&& = 102: betatest% = 0
Rem Jack's Ramanujan pi calculation algorithm with Pete's string math routine.
Dim As String n, m, c, sum, f, f4, f4k, c1, c2, c3, c34k, t1, t2, t3
Dim As Long k, k4
Dim t As Double
t = Timer
digits% = 100
c1 = "1103"
c2 = "26390"
c3 = "396"
f = "1"
f4k = "1"
sum = "1103"
c34k = "1"
k4 = 0
t1 = c3
t2 = c3
sm t1, "*", t2, c3
t1 = c3
t2 = c3
sm t1, "*", t2, c3
For k = 1 To digits% / 7.984
t1 = f
sm Str$(k), "*", t1, f
If betatest% Then Print "results = "; f: Sleep
t1 = f: t2 = f
sm t1, "*", t2, f4
If betatest% Then Print "results = "; f4: Sleep
t1 = f4: t2 = f4
sm t1, "*", t2, f4
If betatest% Then Print "results = "; f4: Sleep
t1 = c34k
sm c3, "*", t1, c34k
If betatest% Then Print "results = "; c34k: Sleep
t1 = Str$(k4 + 1)
t2 = f4k
sm t1, "*", t2, f4k
If betatest% Then Print "results = "; f4k: Sleep
t1 = Str$(k4 + 2)
t2 = f4k
sm t1, "*", t2, f4k
If betatest% Then Print "results = "; f4k: Sleep
t1 = Str$(k4 + 3)
t2 = f4k
sm t1, "*", t2, f4k
If betatest% Then Print "results = "; f4k: Sleep
t1 = Str$(k4 + 4)
t2 = f4k
sm t1, "*", t2, f4k
If betatest% Then Print "results = "; f4k: Sleep
k4 = k4 + 4
t1 = Str$(k)
sm t1, "*", c2, t2
If betatest% Then Print "results = "; t2: Sleep
sm c1, "+", t2, t1
If betatest% Then Print "results = "; t1: Sleep
sm f4k, "*", t1, t2
If betatest% Then Print "results = "; t2: Sleep
sm f4, "*", c34k, t1
If betatest% Then Print "results = "; t1: Sleep
sm t2, "/", t1, t3
If betatest% Then Print "results = "; t3: Sleep
t1 = sum
sm t1, "+", t3, sum
If betatest% Then Print "sum = "; sum: Sleep
Call pi(t1, sum, k)
Next
Color 14, 0: Print "Ramanujan pi = 3.1415926535897932384626433832795028841971693993751"
Color 7, 0
t = Timer - t
Print: Print "Time:"; t
End
Sub pi (t1$, sum$, k)
square_root "8", t1$
If betatest% Then Print "Pi # = "; t1$: Sleep
t2$ = "9801"
sm t1$, "/", t2$, t3$
If betatest% Then Print "Pi # = "; t3$: Sleep
sm t3$, "*", sum$, t2$
If betatest% Then Print "Pi # = "; t2$: Sleep
sm t1$, "/", t2$, t3$
If betatest% Then Print "Pi # = "; t3$: Sleep
sm "1", "/", t2$, t1$
If betatest% Then Print "Pi # = "; t1$: Sleep
Print "loop #"; LTrim$(Str$(k));: Locate , 10: Print " pi = "; Mid$(t1$, 1, digits% + 1)
End Sub
Sub sm (s_var1$, operator$, s_var2$, runningtotal$)
Dim As _Integer64 a, c, aa, cc, s, ss
stringmatha$ = s_var1$: stringmathb$ = s_var2$
Select Case operator$
Case "+", "-"
GoSub string_add_subtract_new
Case "*"
GoSub string_multiply_new
Case "/"
GoSub string_divide
Case Else
Print "Error, no operator selected. operator$ = "; operator$: End
End Select
Exit Sub
string_divide:
terminating_decimal% = 0: divsign% = 0: divremainder& = 0: divremainder$ = "": divplace& = 0: divplace2& = 0: quotient$ = "": divcarry& = 0
divbuffer& = Len(stringmathb$) - Len(stringmatha$)
If divbuffer& < 0 Then divbuffer& = 0
d2dividend$ = stringmatha$
d1divisor$ = stringmathb$
If Left$(d1divisor$, 1) = "0" And Len(d1divisor$) = 1 Then Print "Division by zero not allowed.": divsign% = 0: Exit Sub
If Left$(d1divisor$, 1) = "-" Then divsign% = -1: d1divisor$ = Mid$(d1divisor$, 2)
If Left$(d2dividend$, 1) = "-" Then
If divsign% Then
divsign% = 0
Else
divsign% = -1
End If
d2dividend$ = Mid$(d2dividend$, 2)
End If
If InStr(d1divisor$, ".") <> 0 Then
Do Until Right$(d1divisor$, 1) <> "0"
d1divisor$ = Mid$(d1divisor$, 1, Len(d1divisor$) - 1) ' Strip off trailing zeros
Loop
divplace& = Len(d1divisor$) - InStr(d1divisor$, ".")
d1divisor$ = Mid$(d1divisor$, 1, InStr(d1divisor$, ".") - 1) + Mid$(d1divisor$, InStr(d1divisor$, ".") + 1) ' Strip off decimal point.
Do Until Left$(d1divisor$, 1) <> "0"
d1divisor$ = Mid$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
Loop
End If
If InStr(d2dividend$, ".") <> 0 Then
d2dividend$ = d2dividend$ + String$(divplace& - Len(d2dividend$) - InStr(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace2& = InStr(d2dividend$, ".")
Do Until Right$(d2dividend$, 1) <> "0"
d2dividend$ = Mid$(d2dividend$, 1, Len(d2dividend$) - 1) ' Strip off trailing zeros
Loop
d2dividend$ = Mid$(d2dividend$, 1, InStr(d2dividend$, ".") - 1) + Mid$(d2dividend$, InStr(d2dividend$, ".") + 1) ' Strip off decimal point.
Else
d2dividend$ = d2dividend$ + String$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace& = 0
End If
Do
Do
divremainder& = divremainder& + 1: divremainder$ = divremainder$ + Mid$(d2dividend$, divremainder&, 1)
If Mid$(d2dividend$, divremainder&, 1) = "" Then
If divremainder$ = String$(Len(divremainder$), "0") And Len(quotient$) > Len(d2dividend$) Then
divflag% = -1
terminating_decimal% = -1
Exit Do
End If
divcarry& = divcarry& + 1
If divcarry& = 1 Then divplace3& = divremainder& - 1
If divcarry& > limit&& + 1 + divbuffer& Then
divflag% = -2: Exit Do
End If
divremainder$ = divremainder$ + "0" ' No more digits to bring down.
End If
If Len(divremainder$) > Len(d1divisor$) Or Len(divremainder$) = Len(d1divisor$) And divremainder$ >= d1divisor$ Then Exit Do
quotient$ = quotient$ + "0"
Loop
If divflag% Then divflag% = 0: Exit Do
For div_i% = 9 To 1 Step -1
stringmatha$ = LTrim$(Str$(div_i%)): stringmathb$ = d1divisor$
GoSub string_multiply_new ' Gets runningtotal$
tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
Do
If Len(tempcutd$) = 1 Then Exit Do
If Left$(tempcutd$, 1) = "0" Then
tempcutd$ = Mid$(tempcutd$, 2)
Else
Exit Do
End If
Loop
If Len(tempcutd$) > Len(runningtotal$) Or Len(tempcutd$) = Len(runningtotal$) And runningtotal$ <= tempcutd$ Then Exit For
Next
quotient$ = quotient$ + LTrim$(Str$(div_i%))
stringmatha$ = LTrim$(Str$(div_i%)): stringmathb$ = d1divisor$
GoSub string_multiply_new ' Gets runningtotal$
stringmatha$ = divremainder$: stringmathb$ = runningtotal$
operator$ = "-": GoSub string_add_subtract_new
divremainder$ = runningtotal$
Loop
If divplace& = 0 And divplace2& = 0 Then divplace& = divplace3&
If divplace2& Then divplace& = divplace& + divplace2& - 1
If quotient$ = "" Then divplace& = 0 ' dividend is zero.
If divplace& Or divplace2& Then
quotient$ = Mid$(quotient$, 1, divplace&) + "." + Mid$(quotient$, divplace& + 1)
Do Until Right$(quotient$, 1) <> "0"
quotient$ = Mid$(quotient$, 1, Len(quotient$) - 1) ' Strip off trailing zeros
Loop
If Right$(quotient$, 1) = "." Then quotient$ = Mid$(quotient$, 1, Len(quotient$) - 1) ' Strip off abandoned decimal.
End If
Do Until Left$(quotient$, 1) <> "0"
quotient$ = Mid$(quotient$, 2) ' Strip off leading zeros
Loop
If quotient$ = "" Then quotient$ = "0": divsign% = 0
stringmathb$ = quotient$: quotient$ = ""
If stringmathb$ = "overflow" Then divsign% = 0: Exit Sub
runningtotal$ = stringmathb$: stringmathb$ = ""
If divsign% Then runningtotal$ = "-" + runningtotal$
If stringmathround$ <> "" Then runningtotal$ = runningtotal$ + stringmathround$
Return
string_add_subtract_new:
a1$ = stringmatha$: b1$ = stringmathb$
s = 18: i&& = 0: c = 0
a$ = stringmatha$: b$ = stringmathb$: op$ = operator$
If op$ = "-" Then
If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2) Else b$ = "-" + b$
End If
If InStr(a$, ".") <> 0 Or InStr(b$, ".") <> 0 Then
decimal% = -1
If InStr(a$, ".") <> 0 Then
dec_a&& = Len(Mid$(a$, InStr(a$, ".") + 1))
a$ = Mid$(a$, 1, InStr(a$, ".") - 1) + Mid$(a$, InStr(a$, ".") + 1)
End If
If InStr(b$, ".") <> 0 Then
dec_b&& = Len(Mid$(b$, InStr(b$, ".") + 1))
b$ = Mid$(b$, 1, InStr(b$, ".") - 1) + Mid$(b$, InStr(b$, ".") + 1)
End If
' Line up decimal places by inserting trailing zeros.
If dec_b&& > dec_a&& Then
j&& = dec_b&&
a$ = a$ + String$(dec_b&& - dec_a&&, "0")
Else
j&& = dec_a&&
b$ = b$ + String$(dec_a&& - dec_b&&, "0")
End If
End If
If Left$(a$, 1) = "-" Or Left$(b$, 1) = "-" Then
If Left$(a$, 1) = "-" And Left$(b$, 1) = "-" Then
sign$ = "--": a$ = Mid$(a$, 2): b$ = Mid$(b$, 2)
Else
If Left$(a$, 1) = "-" Then a$ = Mid$(a$, 2): sign_a$ = "-"
If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2): sign_b$ = "-"
If Left$(a1$, 1) = "-" Then a1_x$ = Mid$(a1$, 2) Else a1_x$ = a1$
If Left$(b1$, 1) = "-" Then b1_x$ = Mid$(b1$, 2) Else b1_x$ = b1$
string_compare a1_x$, b1_x$, gl%
If gl% < 0 Then
If Len(sign_b$) Then sign$ = "-": Swap a$, b$
Else
If Len(sign_a$) Then sign$ = "-": Swap sign_a$, sign_b$
End If
End If
End If
z$ = ""
Do
i&& = i&& + s
x1$ = Mid$(a$, Len(a$) - i&& + 1, s)
x2$ = Mid$(b$, Len(b$) - i&& + 1, s)
zeros% = Len(x1$): If Len(x2$) > zeros% Then zeros% = Len(x2$)
a = Val(sign_a$ + x1$) + Val(sign_b$ + x2$) + c
If x1$ + x2$ = "" And c = 0 Then Exit Do
c = 0
If a > Val(String$(s, "9")) Then a = a - 10 ^ s: c = 1
If a < 0 Then a = a + 10 ^ s: c = -1
tmp$ = LTrim$(Str$(a))
z$ = String$(zeros% - Len(tmp$), "0") + tmp$ + z$
Loop
If decimal% Then
z$ = Mid$(z$, 1, Len(z$) - j&&) + "." + Mid$(z$, Len(z$) - j&& + 1)
End If
' Remove any leading zeros.
Do
If Left$(z$, 1) = "0" Then z$ = Mid$(z$, 2) Else Exit Do
Loop
If z$ = "" Or z$ = "0" Then z$ = "0" Else z$ = Left$(sign$, 1) + z$
runningtotal$ = z$
sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
Return
string_multiply_new:
z$ = "": sign$ = "": mult&& = 0: h&& = 0: i&& = 0: j&& = 0: c = 0: decimal% = 0
zz$ = "": ii&& = 0: jj&& = 0
s = 8: ss = 18
a$ = stringmatha$: b$ = stringmathb$
If InStr(a$, "-") <> 0 Or InStr(b$, "-") <> 0 Then
If InStr(a$, "-") <> 0 And InStr(b$, "-") <> 0 Then
a$ = Mid$(a$, 2): b$ = Mid$(b$, 2)
Else
If InStr(a$, "-") <> 0 Then a$ = Mid$(a$, 2) Else b$ = Mid$(b$, 2)
sign$ = "-"
End If
End If
If InStr(a$, ".") <> 0 Or InStr(b$, ".") <> 0 Then
decimal% = -1
If InStr(a$, ".") <> 0 Then
dec_a&& = Len(Mid$(a$, InStr(a$, ".") + 1))
a$ = Mid$(a$, 1, InStr(a$, ".") - 1) + Mid$(a$, InStr(a$, ".") + 1)
End If
If InStr(b$, ".") <> 0 Then
dec_b&& = Len(Mid$(b$, InStr(b$, ".") + 1))
b$ = Mid$(b$, 1, InStr(b$, ".") - 1) + Mid$(b$, InStr(b$, ".") + 1)
End If
End If
If Len(a$) < Len(b$) Then Swap a$, b$ ' Needed so x1$ is always the largest for leading zero replacements.
Do
h&& = h&& + s: i&& = 0
x2$ = Mid$(b$, Len(b$) - h&& + 1, s)
While -1
i&& = i&& + s
x1$ = Mid$(a$, Len(a$) - i&& + 1, s)
a = Val(sign_a$ + x1$) * Val(sign_b$ + x2$) + c
c = 0
tmp$ = LTrim$(Str$(a))
If Len(tmp$) > s Then c = Val(Mid$(tmp$, 1, Len(tmp$) - s)): tmp$ = Mid$(tmp$, Len(tmp$) - s + 1)
z$ = String$(Len(x1$) - Len(tmp$), "0") + tmp$ + z$
If i&& >= Len(a$) And c = 0 Then Exit While
Wend
jj&& = jj&& + 1
If jj&& > 1 Then
ii&& = 0: cc = 0
aa$ = holdaa$
bb$ = z$ + String$((jj&& - 1) * s, "0")
Do
ii&& = ii&& + ss
xx1$ = Mid$(aa$, Len(aa$) - ii&& + 1, ss)
xx2$ = Mid$(bb$, Len(bb$) - ii&& + 1, ss)
aa = Val(xx1$) + Val(xx2$) + cc
If xx1$ + xx2$ = "" And cc = 0 Then Exit Do ' Prevents leading zeros.
cc = 0
If aa > Val(String$(ss, "9")) Then aa = aa - 10 ^ ss: cc = 1
tmp$ = LTrim$(Str$(aa))
zz$ = String$(Len(xx1$) - Len(tmp$), "0") + tmp$ + zz$
Loop
Do While Left$(zz$, 1) = "0"
If Left$(zz$, 1) = "0" Then zz$ = Mid$(zz$, 2)
Loop
If zz$ = "" Then zz$ = "0"
holdaa$ = zz$
Else
holdaa$ = z$ + String$(jj&& - 1, "0")
End If
z$ = "": zz$ = ""
Loop Until h&& >= Len(b$)
z$ = holdaa$
If decimal% Then
Do Until Len(z$) >= dec_a&& + dec_b&&
z$ = "0" + z$
Loop
z$ = Mid$(z$, 0, Len(z$) - (dec_a&& + dec_b&& - 1)) + "." + Mid$(z$, Len(z$) - (dec_a&& + dec_b&&) + 1)
Do Until Right$(z$, 1) <> "0" And Right$(z$, 1) <> "."
z$ = Mid$(z$, 1, Len(z$) - 1)
Loop
End If
If z$ = "" Or z$ = "0" Then z$ = "0" Else z$ = sign$ + z$
decimal% = 0: sign$ = ""
runningtotal$ = z$
Return
End Sub
Sub string_compare (compa$, compb$, gl%)
Do
' Remove trailing zeros after a decimal point.
If InStr(compa$, ".") Then
Do Until Right$(compa$, 1) <> "0" And Right$(compa$, 1) <> "." And Right$(compa$, 1) <> "-"
compa$ = Mid$(compa$, 1, Len(compa$) - 1)
Loop
End If
If InStr(compb$, ".") Then
Do Until Right$(compb$, 1) <> "0" And Right$(compb$, 1) <> "." And Right$(compb$, 1) <> "-"
compb$ = Mid$(compb$, 1, Len(compb$) - 1)
Loop
End If
If Mid$(compa$, 1, 2) = "-0" Or compa$ = "" Or compa$ = "-" Then compa$ = "0"
If Mid$(compb$, 1, 2) = "-0" Or compb$ = "" Or compb$ = "-" Then compb$ = "0"
' A - and +
If Left$(compa$, 1) = "-" Then j% = -1
If Left$(compb$, 1) = "-" Then k% = -1
If k% = 0 And j% Then gl% = -1: Exit Do
If j% = 0 And k% Then gl% = 1: Exit Do
' A decimal and non-decimal.
j% = InStr(compa$, ".")
k% = InStr(compb$, ".")
If j% = 0 And k% Then
If compa$ = "0" Then gl% = -1 Else gl% = 1
Exit Do
End If
If k% = 0 And j% Then
If compb$ = "0" Then gl% = 1 Else gl% = -1
Exit Do
End If
' Both decimals.
If j% Then
If compa$ > compb$ Then
gl% = 1
ElseIf compa$ = compb$ Then gl% = 0
ElseIf compa$ < compb$ Then gl% = -1
End If
Exit Do
End If
' Both positive or both negative whole numbers.
Select Case Len(compa$)
Case Is < Len(compb$)
gl% = -1
Case Is = Len(compb$)
If compa$ = compb$ Then
gl% = 0
ElseIf compa$ > compb$ Then gl% = 1
ElseIf compa$ < compb$ Then gl% = -1
End If
Case Is > Len(compb$)
gl% = 1
End Select
Exit Do
Loop
End Sub
Sub square_root (x$, sqrt$)
oldy$ = "": sqrt$ = ""
If InStr(x$, ".") Then
decx$ = Mid$(x$, 1, InStr(x$, ".") - 1)
x$ = Mid$(x$, 1, InStr(x$, ".") - 1) + Mid$(x$, InStr(x$, ".") + 1)
If Len(x$) = 1 Then x$ = x$ + "0"
Else
decx$ = x$
End If
j&& = Len(decx$)
' VAL() okay, one character eval.
If Val(Right$(LTrim$(Str$(j&&)), 1)) / 2 = Val(Right$(LTrim$(Str$(j&&)), 1)) \ 2 Then
i&& = 1 ' Even number length.
Else
i&& = 0 ' Odd number length.
End If
Do
sm z$, "-", k$, runningtotal$
z$ = runningtotal$ + (Mid$(x$, i&&, 2))
If Left$(z$, 1) = "0" Then z$ = Mid$(z$, 2) ' Remove leading zeros
oldy$ = ""
For j&& = 1 To 10
If i&& > 1 Then
sm sqrt$, "*", "2", y$
y$ = y$ + LTrim$(Str$(j&&))
Else
y$ = LTrim$(Str$(j&&))
End If
sm y$, "*", LTrim$(Str$(j&&)), runningtotal$
string_compare runningtotal$, z$, gl%
If gl% > -1 Then
If gl% = 0 Then
h% = 0: oldy$ = y$ ' Perfect square division.
Else
h% = 1
End If
sm oldy$, "*", LTrim$(Str$(j&& - h%)), runningtotal$
If String$(Len(z$), "0") = z$ And runningtotal$ = "0" And i&& >= Len(decx$) Then Exit Do
If dpx&& = 0 Then ' Limited to && size unless converted to string.
If i&& >= Len(decx$) Then
dpx&& = Int(Len(decx$) / 2 + .5)
If dpx&& = 0 Then dpx&& = -1
End If
End If
If betatest% Then Print "Sqrt "; sqrt$; " * 2 = ";: Color 2, 0: Print LTrim$(Str$(Val(sqrt$) * 2));: Color 7, 0: Print LTrim$(Str$(j&& - h%)); " * "; LTrim$(Str$(j&& - h%)); " ="; Val(oldy$) * (j&& - h%)
sqrt$ = sqrt$ + LTrim$(Str$(j&& - h%))
sm oldy$, "*", LTrim$(Str$(j&& - h%)), runningtotal$
k$ = runningtotal$
If betatest% Then Print "Remainder "; z$; " minus "; k$; " = ";
Exit For
End If
oldy$ = y$
Next
i&& = i&& + 2
If Len(z$) >= limit&& Then Exit Do
x$ = x$ + "00"
Loop
If dpx&& Then
sqrt$ = Mid$(sqrt$, 0, dpx&& + 1) + "." + Mid$(sqrt$, dpx&& + 1)
End If
End Sub