07-09-2023, 02:25 PM
(07-09-2023, 02:20 PM)SMcNeill Wrote:Code: (Select All)Screen _NewImage(1280, 720, 32)
Limit = 10000
Print "Fib"; Limit; "="
last2$ = "0"
last$ = "1"
time## = Timer
For i = 1 To Limit - 2
result$ = StringAdd(last$, last2$)
last2$ = last$
last$ = result$
Next
Print result$
Print Using "###.### seconds to run."; Timer - time##
End
Function StringAdd$ (tempa$, tempb$)
a$ = tempa$: b$ = tempb$ 'don't alter our original numbers
Dim As _Unsigned _Integer64 a, b, c, carryover 'to hold our values
'first fix the numbers to notmalize their lengths
FixNumbers a$, b$
'find the signs and strip them off
If Left$(a$, 1) = "-" Then sa$ = "-": a$ = Mid$(a$, 2) Else sa$ = " "
If Left$(b$, 1) = "-" Then sb$ = "-": b$ = Mid$(b$, 2) Else sb$ = " "
'find the decimal position
dp = InStr(a$, ".")
If dp > 0 Then 'remove the decimal place from our numbers. We can put it back later, in its proper position
righta$ = Mid$(a$, dp + 1)
rightb$ = Mid$(b$, dp + 1)
a$ = Left$(a$, dp - 1) + righta$
b$ = Left$(b$, dp - 1) + rightb$
End If
'our strings are now nothing but numbers with no signs and no decimals to deal with. Let's start adding!
'are we adding or really subtracting?
If sa$ <> sb$ Then 'we're subtracting the two values if the signs aren't the same.
Select Case a$
Case Is < b$: s$ = sb$: Swap a$, b$ 'our sign is going to be determiined by b$
Case Is = b$ 'if the two values are the same and are subtracting, our result is zero!
StringAdd$ = "0" 'How easy was that?
Exit Function
Case Else: s$ = sa$ 'our sign is determined by a$
End Select
Do
lb = Len(b$)
a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)
b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)
If borrow Then b = b + 1~&& 'in case we had to borrow a digit for the last subtraction
If a < b Then
If lb < 18 Then a = a + 10 ^ lb Else a = a + 10 ^ 18
borrow = -1
Else
borrow = 0
End If
c = a - b
temp$ = _Trim$(Str$(c))
answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$
Loop Until Len(a$) = 0
'remove leading 0's
Do Until Left$(answer$, 1) <> "0"
answer$ = Mid$(answer$, 2)
Loop
'remember to add in the decimal place before finished
dp = Len(righta$)
If dp > 0 Then
answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)
End If
StringAdd$ = s$ + answer$
Exit Function
End If
Do
a1$ = Right$(a$, 18)
b1$ = Right$(b$, 18)
a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)
b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)
c = a + b + carryover
temp$ = _Trim$(Str$(c))
If Len(temp$) > 18 Then 'see if we have an answer that is more than 18 digits
temp$ = Right$(temp$, 18) 'keep 18 digits
carryover = 1 'store one for carry over
Else
carryover = 0 'no carryover
End If
answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$
Loop Until Len(a$) = 0
If carryover Then answer$ = "1" + answer$
'remember to add in the decimal place before finished
dp = Len(righta$)
If dp > 0 Then
answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)
End If
'remove leading 0's
Do Until Left$(answer$, 1) <> "0"
answer$ = Mid$(answer$, 2)
Loop
StringAdd$ = sa$ + answer$
End Function
Function StringSubtract$ (tempa$, tempb$)
a$ = tempa$: b$ = tempb$
FixNumbers a$, b$
If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2) Else b$ = "-" + b$
StringSubtract$ = StringAdd$(a$, b$)
End Function
Sub FixNumbers (a$, b$)
'first remove scientific notation and spaces from both
a$ = _Trim$(N2S$(a$)): b$ = _Trim$(N2S$(b$))
'then find the decimal position for both and normalize the expressions
d1 = InStr(a$, "."): d2 = InStr(b$, ".")
If d1 <> 0 Then 'break down the left and right side of the decimal point for ease of processing (this is a$)
lefta$ = Left$(a$, d1 - 1)
righta$ = Mid$(a$, d1)
Else
lefta$ = a$
End If
If d2 <> 0 Then 'break down the left and right side of the decimal point for ease of processing (this is b$)
leftb$ = Left$(b$, d2 - 1)
rightb$ = Mid$(b$, d2)
Else
leftb$ = b$
End If
'normalize the right side of our expressions
l1 = Len(righta$): l2 = Len(rightb$)
If l1 < l2 Then
addzero = l2 - l1
If l1 = 0 Then righta$ = ".": addzero = addzero - 1
righta$ = righta$ + String$(addzero, "0")
ElseIf l1 > l2 Then
addzero = l1 - l2
'If l2 = 0 Then rightb$ = ".": addzero = addzero - 1
rightb$ = rightb$ + String$(addzero, "0")
End If
'strip off any plus/minus signs from the two numbers.
If Left$(lefta$, 1) = "-" Then signa$ = "-": lefta$ = Mid$(lefta$, 2)
If Left$(leftb$, 1) = "-" Then signb$ = "-": leftb$ = Mid$(leftb$, 2)
If Left$(lefta$, 1) = "+" Then signa$ = "": lefta$ = Mid$(lefta$, 2)
If Left$(leftb$, 1) = "+" Then signb$ = "": leftb$ = Mid$(leftb$, 2)
'normalize the left side of our expressions
l1 = Len(lefta$): l2 = Len(leftb$)
If l1 < l2 Then
addzero = l2 - l1
lefta$ = String$(addzero, "0") + lefta$
ElseIf l1 > l2 Then
addzero = l1 - l2
leftb$ = String$(addzero, "0") + leftb$
End If
'and then put it all together
a$ = signa$ + lefta$ + righta$
b$ = signb$ + leftb$ + rightb$
End Sub
Function N2S$ (exp$) 'scientific Notation to String
t$ = LTrim$(RTrim$(exp$))
If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
ep = InStr(t$, "E+"): em = InStr(t$, "E-")
check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
If check1 < 1 Or check1 > 1 Then N2S = exp$: Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
Select Case l 'l now tells us where the SN starts at.
Case Is < dp: l = dp
Case Is < dm: l = dm
Case Is < ep: l = ep
Case Is < em: l = em
End Select
l$ = Left$(t$, l - 1) 'The left of the SN
r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
If InStr(l$, ".") Then 'Location of the decimal, if any
If r&& > 0 Then
r&& = r&& - Len(l$) + 2
Else
r&& = r&& + 1
End If
l$ = Left$(l$, 1) + Mid$(l$, 3)
End If
Select Case r&&
Case 0 'what the heck? We solved it already?
'l$ = l$
Case Is < 0
For i = 1 To -r&&
l$ = "0" + l$
Next
l$ = "0." + l$
Case Else
For i = 1 To r&&
l$ = l$ + "0"
Next
End Select
N2S$ = sign$ + l$
End Function
Function DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
Do
bad = 0
Do
l = InStr(t$, "++")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "+-")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "-+")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "--")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Loop Until Not bad
DWD$ = t$
End Function
Holy cow that's fast!