Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
08-19-2022, 05:57 PM
(This post was last modified: 08-19-2022, 06:14 PM by SMcNeill.)
OMG!! @Pete -- you won't believe what my BLEEPING BLEEP of a BLEEPING BLEEEP BLEEEEEEP problem was!! I've spent forever and ever and ever and ever and ever trying to track down where the glitch was in the math routines...
Are you sitting down?? Ready for this one??
CARRYOVER is a variable that *only* holds a value of either 0 or 1. I didn't bother to define it manually, and even if I would've, I probably would've just defined it as a standard LONG...
There's a few lines in the code that look like these:
Code: (Select All) 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
c = a + b + carryover <--- This is the line that's causing the glitch!!
WHY??
Because since I didn't define carryover a type, it's defaulting to a SINGLE, thus forcing the routine to do floating point math -- and in this case, we're greater than what a single can hold without losing precision! GAAAAHH!!
Here's the fix:
Code: (Select All) Dim As _Unsigned _Integer64 a, b, c, carryover 'to hold our values
See the nicely defined carryover as an UINT64 now? /Blah!
On a sidenote, I took time to dig the old BTEN$ routines out of the old version of QB64 (most folks never even realized that they were in the source code since the days of the CONST math expansions, before they got removed since nobody even realized that they were in the source code...)
Now you have multiple string math routines which you can test and compare your answers against:
Code: (Select All) Screen _NewImage(1280, 720, 32)
a$ = "-10000000000000000000123.256"
b$ = " 60000000000000000000000.111"
Test a$, b$
a$ = " 100000000000000000000000000"
b$ = "-000000000000000000000000001.1"
Test a$, b$
a$ = "24123538548354853499345235498325489235982355952936529659265982635982398569.56466456"
b$ = "3.1"
Test a$, b$
Sub Test (a$, b$)
Print "==========================================================================="
Print a$
Print b$
Print "STEVE+:"; StringAdd(a$, b$)
Print "BTEN +:"; BTen$(a$, "+", b$)
Print "STEVE-:"; StringSubtract(a$, b$)
Print "BTEN -:"; BTen$(a$, "-", b$)
Print "==========================================================================="
Sleep
End Sub
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
Function BTen$ (InTop As String, Op As String, InBot As String)
Rem $DYNAMIC
InTop = LTrim$(RTrim$(InTop))
InBot = LTrim$(RTrim$(InBot))
l = InStr(InTop, "-")
If l = 0 Then l = InStr(InTop, "+")
If l = 0 Then InTop = "+" + InTop
l = InStr(InBot, "-")
If l = 0 Then l = InStr(InBot, "+")
If l = 0 Then InBot = "+" + InBot
l = InStr(InTop, ".")
If l = 0 Then InTop = InTop + "."
l = InStr(InBot, ".")
If l = 0 Then InBot = InBot + "."
If Op$ = "-" Then
Op$ = "+"
If Mid$(InBot, 1, 1) = "-" Then Mid$(InBot, 1, 1) = "+" Else Mid$(InBot, 1, 1) = "-"
End If
TDP& = Check&(10, InTop$)
BDP& = Check&(10, InBot$)
If TDP& < 0 Or BDP& < 0 Then Exit Function
TSign% = Check&(11, InTop$)
BSign% = Check&(11, InBot$)
' Calculate Array Size
If Op$ = Chr$(43) Or Op$ = Chr$(45) Then
' "+" (Add) OR "-" (Subtract)
Temp& = 9
ElseIf Op$ = Chr$(42) Or Op$ = Chr$(50) Then
' "*" (Multiply) OR "2" (SQRT Multiply)
Temp& = 7
Else
Exit Function
End If
' LSA (Left Side of Array)
LSA& = TDP& - 2
TLS& = LSA& \ Temp&
If LSA& Mod Temp& > 0 Then
TLS& = TLS& + 1
Do While (TLPad& + LSA&) Mod Temp& > 0
TLPad& = TLPad& + 1
Loop
End If
LSA& = BDP& - 2
BLS& = LSA& \ Temp&
If LSA& Mod Temp& > 0 Then
BLS& = BLS& + 1
Do While (BLPad& + LSA&) Mod Temp& > 0
BLPad& = BLPad& + 1
Loop
End If
If TLS& >= BLS& Then LSA& = TLS& Else LSA& = BLS&
' RSA (Right Side of Array)
RSA& = Len(InTop$) - TDP&
TRS& = RSA& \ Temp&
If RSA& Mod Temp& > 0 Then
TRS& = TRS& + 1
Do While (TRPad& + RSA&) Mod Temp& > 0
TRPad& = TRPad& + 1
Loop
End If
RSA& = Len(InBot$) - BDP&
BRS& = RSA& \ Temp&
If RSA& Mod Temp& > 0 Then
BRS& = BRS& + 1
Do While (BRPad& + RSA&) Mod Temp& > 0
BRPad& = BRPad& + 1
Loop
End If
If TRS& >= BRS& Then RSA& = TRS& Else RSA& = BRS&
If Op$ = Chr$(43) Or Op$ = Chr$(45) Then
' "+" (Add) OR "-" (Subtract)
Dim Result(1 To (LSA& + RSA&)) As Long
If (Op$ = Chr$(43) And TSign% = BSign%) Or (Op$ = Chr$(45) And TSign% <> BSign%) Then
' Add Absolute Values and Return Top Sign
' Left Side
For I& = 1 To LSA&
' Top
If I& <= (LSA& - TLS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
Result(I&) = Val(Mid$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
Else
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
End If
' Bottom
If I& <= (LSA& - BLS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (1 + LSA& - BLS&) Then
Result(I&) = Result(I&) + Val(Mid$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
Else
Result(I&) = Result(I&) + Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
End If
Next I&
' Right Side
TDP& = TDP& + 1: BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
' Top
If I& > (LSA& + TRS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
Result(I&) = (10 ^ TRPad&) * Val(Right$(InTop$, (9 - TRPad&)))
Else
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
End If
' Bottom
If I& > (LSA& + BRS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (LSA& + BRS&) Then
Result(I&) = Result(I&) + (10 ^ BRPad&) * Val(Right$(InBot$, (9 - BRPad&)))
Else
Result(I&) = Result(I&) + Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
End If
Next I&
' Carry
For I& = (LSA& + RSA&) To 2 Step -1
If Result(I&) >= 1000000000 Then
Result(I& - 1) = Result(I& - 1) + 1
Result(I&) = Result(I&) - 1000000000
End If
Next I&
' Return Sign
If TSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
Else
' Compare Absolute Values
If TDP& > BDP& Then
Compare& = 1
ElseIf TDP& < BDP& Then
Compare& = -1
Else
If Len(InTop$) > Len(InBot$) Then Compare& = Len(InBot$) Else Compare& = Len(InTop$)
For I& = 2 To Compare&
If Val(Mid$(InTop$, I&, 1)) > Val(Mid$(InBot$, I&, 1)) Then
Compare& = 1
Exit For
ElseIf Val(Mid$(InTop$, I&, 1)) < Val(Mid$(InBot$, I&, 1)) Then
Compare& = -1
Exit For
End If
Next I&
If Compare& > 1 Then
If Len(InTop$) > Len(InBot$) Then
Compare& = 1
ElseIf Len(InTop$) < Len(InBot$) Then
Compare& = -1
Else
Compare& = 0
End If
End If
End If
' Conditional Subtraction
If Compare& = 1 Then
' Subtract Bottom from Top and Return Top Sign
' Top
Result(1) = Val(Mid$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
For I& = 2 To LSA&
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
Next I&
TDP& = TDP& + 1
For I& = (LSA& + 1) To (LSA& + TRS& - 1)
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
Next I&
Result(LSA& + TRS&) = 10& ^ TRPad& * Val(Right$(InTop$, (9 - TRPad&)))
' Bottom
BDP& = (Len(InBot$) - 17) + BRPad&
For I& = (LSA& + BRS&) To (1 + LSA& - BLS&) Step -1
If I& = LSA& Then BDP& = BDP& - 1
If I& = (LSA& + BRS&) Then
Temp& = (10& ^ BRPad&) * Val(Right$(InBot$, (9 - BRPad&)))
ElseIf I& = (1 + LSA& - BLS&) Then
Temp& = Val(Mid$(InBot$, 2, (9 - BLPad&)))
Else
Temp& = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& - 9
End If
If Result(I&) < Temp& Then
' Borrow
For J& = (I& - 1) To 1 Step -1
If Result(J&) = 0 Then
Result(J&) = 999999999
Else
Result(J&) = Result(J&) - 1
Exit For
End If
Next J&
Result(I&) = Result(I&) + 1000000000
End If
Result(I&) = Result(I&) - Temp&
Next I&
' Return Sign
If TSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
ElseIf Compare& = -1 Then
' Subtract Top from Bottom and Return Bottom Sign
' Bottom
Result(1) = Val(Mid$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
For I& = 2 To LSA&
Result(I&) = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
Next I&
BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + BRS& - 1)
Result(I&) = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
Next I&
Result(LSA& + BRS&) = 10& ^ BRPad& * Val(Right$(InBot$, (9 - BRPad&)))
' Top
TDP& = (Len(InTop$) - 17) + TRPad&
For I& = (LSA& + TRS&) To (1 + LSA& - TLS&) Step -1
If I& = LSA& Then TDP& = TDP& - 1
If I& = (LSA& + TRS&) Then
Temp& = (10& ^ TRPad&) * Val(Right$(InTop$, (9 - TRPad&)))
ElseIf I& = (1 + LSA& - TLS&) Then
Temp& = Val(Mid$(InTop$, 2, (9 - TLPad&)))
Else
Temp& = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& - 9
End If
If Result(I&) < Temp& Then
' Borrow
For J& = (I& - 1) To 1 Step -1
If Result(J&) = 0 Then
Result(J&) = 999999999
Else
Result(J&) = Result(J&) - 1
Exit For
End If
Next J&
Result(I&) = Result(I&) + 1000000000
End If
Result(I&) = Result(I&) - Temp&
Next I&
' Build Return Sign
If BSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
Else
' Result will always be 0
LSA& = 1: RSA& = 1
RetStr$ = Chr$(43)
End If
End If
' Generate Return String
RetStr$ = RetStr$ + LTrim$(Str$(Result(1)))
For I& = 2 To LSA&
RetStr$ = RetStr$ + Right$(String$(8, 48) + LTrim$(Str$(Result(I&))), 9)
Next I&
RetStr$ = RetStr$ + Chr$(46)
For I& = (LSA& + 1) To (LSA& + RSA&)
RetStr$ = RetStr$ + Right$(String$(8, 48) + LTrim$(Str$(Result(I&))), 9)
Next I&
Erase Result
ElseIf Op$ = Chr$(42) Then
' * (Multiply)
Dim TArray(1 To (LSA& + RSA&)) As Long
Dim BArray(1 To (LSA& + RSA&)) As Long
Dim ResDBL(0 To (LSA& + RSA&)) As Double
' Push String Data Into Array
For I& = 1 To LSA&
If I& <= (LSA& - TLS&) Then
''' TArray(I&) = TArray(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
TArray(I&) = Val(Mid$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
Else
TArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
If I& <= (LSA& - BLS&) Then
''' BArray(I&) = BArray(I&) + 0
ElseIf I& = (1 + LSA& - BLS&) Then
BArray(I&) = Val(Mid$(InBot$, 2, (7 - BLPad&)))
BDP& = 9 - BLPad&
Else
BArray(I&) = Val(Mid$(InBot$, BDP&, 7))
BDP& = BDP& + 7
End If
Next I&
TDP& = TDP& + 1: BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
If I& > (LSA& + TRS&) Then
''' TArray(I&) = TArray(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
TArray(I&) = 10 ^ TRPad& * Val(Right$(InTop$, (7 - TRPad&)))
Else
TArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
If I& > (LSA& + BRS&) Then
''' BArray(I&) = BArray(I&) + 0
ElseIf I& = (LSA& + BRS&) Then
BArray(I&) = 10 ^ BRPad& * Val(Right$(InBot$, (7 - BRPad&)))
Else
BArray(I&) = Val(Mid$(InBot$, BDP&, 7))
BDP& = BDP& + 7
End If
Next I&
' Multiply from Arrays to Array
For I& = (LSA& + TRS&) To (1 + LSA& - TLS&) Step -1
For J& = (LSA& + BRS&) To (1 + LSA& - BLS&) Step -1
Temp# = 1# * TArray(I&) * BArray(J&)
If (I& + J&) Mod 2 = 0 Then
TL& = Int(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
Else
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
End If
If ResDBL((I& + J&) \ 2) >= 100000000000000# Then
Temp# = ResDBL((I& + J&) \ 2)
TL& = Int(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
End If
Next J&
Next I&
Erase TArray, BArray
' Generate Return String
If (TSign% * BSign%) = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
RetStr$ = RetStr$ + LTrim$(Str$(ResDBL(0)))
For I& = 1 To (LSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
RetStr$ = Left$(RetStr$, Len(RetStr$) - 7) + Chr$(46) + Right$(RetStr$, 7)
For I& = (LSA& + 1) To (LSA& + RSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
Erase ResDBL
ElseIf Op$ = Chr$(50) Then
' 2 (SQRT Multiply)
Dim IArray(1 To (LSA& + RSA&)) As Long
Dim ResDBL(0 To (LSA& + RSA&)) As Double
' Push String Data Into Array
For I& = 1 To LSA&
If I& <= (LSA& - TLS&) Then
''' IArray(I&) = IArray(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
IArray(I&) = Val(Mid$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
Else
IArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
Next I&
TDP& = TDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
If I& > (LSA& + TRS&) Then
''' IArray(I&) = IArray(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
IArray(I&) = 10 ^ TRPad& * Val(Right$(InTop$, (7 - TRPad&)))
Else
IArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
Next I&
' SQRT Multiply from Array to Array
For I& = (LSA& + TRS&) To 1 Step -1
For J& = I& To 1 Step -1
Temp# = 1# * IArray(I&) * IArray(J&)
If I& <> J& Then Temp# = Temp# * 2
If (I& + J&) Mod 2 = 0 Then
TL& = Int(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
Else
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
End If
If ResDBL((I& + J&) \ 2) >= 100000000000000# Then
Temp# = ResDBL((I& + J&) \ 2)
TL& = Int(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
End If
Next J&
Next I&
Erase IArray
' Generate Return String
If (TSign% * BSign%) = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
RetStr$ = RetStr$ + LTrim$(Str$(ResDBL(0)))
For I& = 1 To (LSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
RetStr$ = Left$(RetStr$, Len(RetStr$) - 7) + Chr$(46) + Right$(RetStr$, 7)
' Don't usually want the full right side for this, just enough to check the
' actual result against the expected result, which is probably an integer.
' Uncomment the three lines below when trying to find an oddball square root.
'FOR I& = (LSA& + 1) TO (LSA& + RSA&)
' RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
'NEXT I&
Erase ResDBL
End If
' Trim Leading and Trailing Zeroes
Do While Mid$(RetStr$, 2, 1) = Chr$(48) And Mid$(RetStr$, 3, 1) <> Chr$(46)
RetStr$ = Left$(RetStr$, 1) + Right$(RetStr$, Len(RetStr$) - 2)
Loop
Do While Right$(RetStr$, 1) = Chr$(48) And Right$(RetStr$, 2) <> Chr$(46) + Chr$(48)
RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
Loop
If Mid$(RetStr$, 1, 1) = "+" Then Mid$(RetStr$, 1, 1) = " "
Do
r$ = Right$(RetStr$, 1)
If r$ = "0" Then RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
Loop Until r$ <> "0"
r$ = Right$(RetStr$, 1)
If r$ = "." Then RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
BTen$ = RetStr$
End Function
Rem $STATIC
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
'
' * Op& = Type of string to expect and/or operation to perform
'
' { 00A } = (10) Test Base-10-Format String ( *!* ALTERS InString$ *!* )
' { 00B } = (11) Read Sign ("+", "-", or CHR$(241))
'
' Unlisted values are not used and will return [ Check& = 0 - Op& ].
' Different Op& values produce various return values.
' Refer to the in-code comments for details.
'
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
Function Check& (Op As Long, InString As String)
Rem $DYNAMIC
RetVal& = Len(InString$)
Select Case Op&
Case 10
' {00A} Test String for Base-10-Format ( *!* ALTERS InString$ *!* )
' Returns:
' {& > 0} = DP offset; {& < 0} = FAILED at negative offset
'
' After testing passes, the string is trimmed
' of nonessential leading and trailing zeroes.
If RetVal& = 0 Then
RetVal& = -1
Else
Select Case Asc(Left$(InString$, 1))
Case 43, 45 ' "+", "-"
For I& = 2 To RetVal&
Select Case Asc(Mid$(InString$, I&, 1))
Case 46 ' "."
If DPC% > 0 Then
RetVal& = 0 - I&
Exit For
Else
DPC% = DPC% + 1
RetVal& = I&
End If
Case 48 To 57
' keep going
Case Else
RetVal& = 0 - I&
Exit For
End Select
Next I&
Case Else
RetVal& = -1
End Select
If DPC% = 0 And RetVal& > 0 Then
RetVal& = 0 - RetVal&
ElseIf RetVal& = 2 Then
InString$ = Left$(InString$, 1) + Chr$(48) + Right$(InString$, Len(InString$) - 1)
RetVal& = RetVal& + 1
End If
If RetVal& = Len(InString$) Then InString$ = InString$ + Chr$(48)
Do While Asc(Right$(InString$, 1)) = 48 And RetVal& < (Len(InString$) - 1)
InString$ = Left$(InString$, Len(InString$) - 1)
Loop
Do While Asc(Mid$(InString$, 2, 1)) = 48 And RetVal& > 3
InString$ = Left$(InString$, 1) + Right$(InString$, Len(InString$) - 2)
RetVal& = RetVal& - 1
Loop
End If
Case 11
' {00B} Read Sign ("+", "-", or CHR$(241))
' Returns:
' Explicit: +1 = Positive; -1 = Negative; 0 = Unsigned;
' Implied: +64 = Positive; -64 = NULL String
If RetVal& = 0 Then RetVal& = -64
For I& = 1 To RetVal&
Select Case Asc(Mid$(InString$, I&, 1))
Case 32
RetVal& = 64
' keep going
Case 43
RetVal& = 1
Exit For
Case 45
RetVal& = -1
Exit For
Case 241
RetVal& = 0
Exit For
Case Else
RetVal& = 64
Exit For
End Select
Next I&
Case Else
RetVal& = 0 - Op&
End Select
Check& = RetVal&
End Function
And for what it's worth, BTEN$ does "+", "-", "*", and "SQRT", IIRC. 
Posts: 336
Threads: 24
Joined: Apr 2022
Reputation:
19
Hi Steve 
your bten$ routines are fast considering that it's string based, how would you call the Sqrt function?
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
08-19-2022, 11:48 PM
(This post was last modified: 08-19-2022, 11:48 PM by SMcNeill.)
(08-19-2022, 09:54 PM)Jack Wrote: Hi Steve
your bten$ routines are fast considering that it's string based, how would you call the Sqrt function?
BTEN wasn't mine; it was something someone else worked up ages ago. Dark...something... Darkstar, perhaps? You might remember him from the old .net forums of Galleons (not .org of Fellippes). He was the guy perpetually working on a space game with the idea of a 3d array storing every point in the universe. I was never certain exactly how you'd store such vast amounts of data in an array, but he claimed to have it all sorted out. Unfortunately, he disappeared back when the forums collapsed the first time at .net.
From what I recall, SQRT worked off the first parameter only, with the last parameter being ignored.
result$ = BTEN$("2", "SQRT", "ignored") -- IIRC.
I don't recall how you set a limit to how many digits to generate. I remember Dark once posted several thousand digits to the SQRT of 2, or something once, where he had it output the answer to a file as it calculated the result. You'll just have to skim the code and play with it, I'm afraid. I didn't write BTEN, and haven't used it for years. Last version of QB64.bas with it inside was back around v1.1, IIRC, and that was when Galleon was still doing releases!
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
@Jack I spent a little time digging into the source for BTEN$ -- apparently this version doesn't actually calculate SQRT for us. Instead, it SQUARES a number for us. (x ^ 2)
I definitely remember there being a string routine which did square roots, but from what I remember of the layout of the code, it wasn't structured anything like this. What Dark had created for his square root calculator was a simple process that took 2 numbers and multiplied them together to aim for the target value and expanded one digit at a time.
For example to calculate the square root of 2, it'd first see what QB64 would give it as a seed.
Seed = SQR(2) ... which QB64 tells us is 1.414213562373095
Then it'd multiple that value by itself to see if it had a perfect match.
If not, it'd then multiple that value + "5" by itself. 1.4142135623730955 <-- see the added 5?
That value would then multiply by itself.
If the result was > the target, ir changed 5 to 2 and tried again. 1.4142135623730952 <-- 2 at the end
If the result was < the target, it changed 5 to 8 and tried again. 1.4142135623730958 <-- 8 at the end
And it basically continued this process until it narrowed the range to being between to digits. 2 is too small, 3 is too large -- the target value is 2!
And then it repeated that same multiplication process once again to get the next digit. 1.4142135623730952 + "5"
And that's how Dark's SQRT code worked, from what I remember of it, wherever the heck it went!
As for what's in the BTEN, you can use it via a simple call like so:
result$ = BTEN$(num$, "2", "") <-- and this will square the number for you.
Why he wrote a whole operator to handle such a thing, I don't know, and there's no way to ask him now that I know of. Seems to me that it'd be just as easy to do a simple: result$ = BTEN$(num$, "*", num$)
I'll dig around on the hard drives some later and see if I can find his actual SQRT calculator. I remember well how it works, but for whatever reason, it's not a part of the BTEN string routine which he shared and put into QB64 back in the day.
Posts: 1,616
Threads: 157
Joined: Apr 2022
Reputation:
77
08-20-2022, 06:16 AM
(This post was last modified: 08-22-2022, 02:29 AM by Pete.)
@SMcNeill
Glad you found it.
I added (excuse the pun) a chunk multiple routine. It may be buggy, as I haven't tested it all that well. I had to vary a bit from the structure I used for addition/subtraction, but not too much. I might go back and tweak the two a bit latter. Anyway, these changes are proving to be a faster model than my old string routines from a few years ago.
The Holly grail would be a way to do chunk division, but that's one hell of a rabbit hole to go down.
Here's the updated code for +, - , and now *
Code: (Select All) betatest% = 0
DIM AS _INTEGER64 a, b, c, aa, bb, cc, s, ss
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
LINE INPUT "Number: "; a$
IF a$ = "" THEN EXIT DO ' Quit.
LINE INPUT "+ - * : "; op$
LINE INPUT "Number: "; b$
a1$ = a$: b1$ = b$
SELECT CASE op$
CASE "*"
z$ = "": sign$ = "": mult&& = 0: h&& = 0: i&& = 0: j&& = 0: c = 0: decimal% = 0
zz$ = "": ii&& = 0: jj&& = 0
s = 8: ss = 18
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$
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
IF betatest% THEN PRINT "x1$ = "; x1$;: LOCATE , 20: PRINT "x2$ = "; x2$;: LOCATE , 35: PRINT VAL(x1$) * VAL(x2$) + c;: LOCATE , 55: PRINT "c = "; c;: LOCATE , 75: PRINT "val = "; a,
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$ = tmp$ + z$
IF betatest% THEN LOCATE , 100: PRINT a;: LOCATE , 120: PRINT 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")
IF betatest% THEN PRINT "aa$ "; aa$; " + bb$ "; z$;: COLOR 14, 0: PRINT STRING$(jj&& - 1, "0"); " = ";: COLOR 7, 0: SLEEP
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$(ss - LEN(tmp$), "0") + tmp$ + zz$
REM PRINT xx1$;: LOCATE , 15: PRINT xx2$;: LOCATE , 30: PRINT VAL(xx1$) + VAL(xx2$);: LOCATE , 45: PRINT cc;: LOCATE , 60: PRINT aa, "z$ = "; zz$: SLEEP
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$
IF betatest% THEN COLOR 2, 0: PRINT holdaa$: COLOR 7, 0
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$
PRINT " " + LTRIM$(STR$(VAL(a1$) * VAL(b1$))), "QB64 VAL()."
PRINT " "; z$, "String Math."
PRINT
decimal% = 0: sign$ = ""
CASE "+", "-"
s = 18
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$ = "-"
string_compare LTRIM$(STR$(ABS(VAL(a1$)))), LTRIM$(STR$(ABS(VAL(b1$)))), 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)
a = VAL(sign_a$ + x1$) + VAL(sign_b$ + x2$) + c
IF x1$ + x2$ = "" AND c = 0 THEN EXIT DO ' Prevents leading zeros.
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
z$ = LTRIM$(STR$(a)) + z$
REM PRINT x1$;: LOCATE , 15: PRINT x2$;: LOCATE , 30: PRINT VAL(x1$) - VAL(x2$);: LOCATE , 45: PRINT c;: LOCATE , 60: PRINT a, z$: SLEEP
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$
IF op$ = "+" THEN PRINT " " + LTRIM$(STR$(VAL(a1$) + VAL(b1$))), "QB64 VAL()." ELSE PRINT " " + LTRIM$(STR$(VAL(a1$) - VAL(b1$))), "QB64 VAL()."
PRINT " "; z$, "String Math."
PRINT
sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
END SELECT
LOOP
SYSTEM
SUB string_compare (compa$, compb$, gl%)
DO
REM 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
Edit fixed one bug by adding the statement: IF LEN(a$) < LEN(b$) THEN SWAP a$, b$
Pete
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
When dealing with division, I've found that the way to do it in "chunks" is just like I described for the SQRT method above.
Get a seed using floating point math for an estimate, and then basically multiply on a binary system and zoom in on your decimal values.
Say your next 9 digits are "123456789" in the answer.
Multiply (EA$ + _TRIM$(STR$(500000000))) by your divisor and compare if the result too large or too small. (EA$ is your Existing Answer that you've calculated.) In this case, it's too large.
Half the gap, try again. (250000000) Too large
Half the gap, try again. (125000000) Too large
Half the gap, try again. (062500000) Too small
Half the gap...
You seek the result based on a binary search of basically a value from 0 to 999999999.... at most 30 multiplication runs will get you the answer. 2 ^ 30 is > 999,999,999. And that gives 9 digits to the answer at a time.
There might be a better way to do it, but if so, my brain isn't coming up with it. When dealing with obscene values like dividing (37 digits with 14 decimal places) into a (1234 digit with 36 decimal place) value, I just can't comprehend an easier way towards the solution.
Posts: 1,616
Threads: 157
Joined: Apr 2022
Reputation:
77
I punted on the idea of estimate methods because of accuracy. When working with 200+ decimal places I would think it would take longer to form estimates than to grind out long division.
Oh, speaking of square root calculations, I did manage one with my older string math single digit turning method...
Code: (Select All) $CHECKING:OFF
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
limit&& = 32
'betatest% = -1
IF betatest% THEN limit&& = 16
DO
INPUT "Number: "; x$: PRINT
IF x$ = "" THEN SYSTEM
IF LEFT$(x$, 1) = "-" THEN
PRINT "Negatives not allowed. Redo..": _DELAY 2: PRINT
ELSE
validate_string x$
IF INSTR(x$, "invalid") = 0 THEN EXIT DO
PRINT "Sorry, "; x$: _DELAY 1: PRINT
END IF
LOOP
x# = VAL(x$) ' Needed for QB64 SQR() comparison only.
oldy$ = ""
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
stringmatha$ = z$: stringmathb$ = k$
string_math z$, "-", k$, runningtotal$, terminating_decimal%, limit&&
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
string_math sqrt$, "*", "2", y$, terminating_decimal%, limit&&
y$ = y$ + LTRIM$(STR$(j&&))
ELSE
y$ = LTRIM$(STR$(j&&))
END IF
string_math y$, "*", LTRIM$(STR$(j&&)), runningtotal$, terminating_decimal%, limit&&
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
string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
IF STRING$(LEN(z$), "0") = z$ AND runningtotal$ = "0" AND i&& >= LEN(decx$) THEN EXIT DO
IF dp&& = 0 THEN ' Limited to && size unless converted to string.
IF i&& >= LEN(decx$) THEN
dp&& = INT(LEN(decx$) / 2 + .5)
IF dp&& = 0 THEN dp&& = -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%))
string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
k$ = runningtotal$
IF betatest% THEN PRINT "Remainder "; z$; " minus "; k$; " = ";
EXIT FOR
END IF
oldy$ = y$
NEXT
IF betatest% THEN
string_math stringmatha$, "-", stringmathb$, runningtotal$, terminating_decimal%, limit&&
PRINT runningtotal$; " sqrt = "; sqrt$
END IF
i&& = i&& + 2
IF LEN(z$) >= limit&& THEN EXIT DO
x$ = x$ + "00"
LOOP
PRINT
IF dp&& THEN
sqrt$ = MID$(sqrt$, 0, dp&& + 1) + "." + MID$(sqrt$, dp&& + 1)
END IF
_CLIPBOARD$ = sqrt$
PRINT "QB64 SQR:"; SQR(x#)
PRINT "Pete SQR: "; sqrt$: _DELAY 1: CLEAR
PRINT
LOOP
SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, terminating_decimal%, limit&&)
SELECT CASE operator$
CASE "+", "-"
GOTO string_add_subtract
CASE "*"
GOTO string_multiply
CASE "/"
GOTO string_divide
CASE ELSE
PRINT "Error, no operator selected. operator$ = "; operator$
END SELECT
string_divide:
terminating_decimal% = 0: divsign% = 0: divremainder& = 0: divremainder$ = "": divplace& = 0: divplace2& = 0: quotient$ = "": divcarry& = 0
operationdivision% = -1
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: operationdivision% = 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$
m_product$ = "": GOSUB string_multiply
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(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
NEXT
quotient$ = quotient$ + LTRIM$(STR$(div_i%))
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract
divremainder$ = stringmatha$
operator$ = "/"
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
operationdivision% = 0
stringmathb$ = quotient$: quotient$ = ""
IF stringmathb$ = "overflow" THEN divsign% = 0: operationdivision% = 0: EXIT SUB
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
operationdivision% = 0
EXIT SUB
string_multiply:
m_decimal_places& = 0: m_product$ = ""
fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
IF INSTR(fac2$, ".") <> 0 THEN m_decimal_places& = m_decimal_places& + LEN(fac2$) - INSTR(fac2$, "."): fac2$ = MID$(fac2$, 1, INSTR(fac2$, ".") - 1) + MID$(fac2$, INSTR(fac2$, ".") + 1)
FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charater top and bottom.
m_k& = m_l&
m_x2$ = MID$(fac2$, m_i&, 1)
FOR m_j& = LEN(fac1$) TO 1 STEP -1
m_x1$ = MID$(fac1$, m_j&, 1)
IF m_product$ <> "" THEN
m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
m_t& = 0: m_xproduct$ = "": m_carry% = 0
DO ' Add multiplied characters together.
m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
IF m_x3$ = "" AND m_x4$ = "" THEN
IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
EXIT DO
END IF
m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
m_t& = m_t& + 1
LOOP
m_product$ = m_xproduct$: m_xproduct$ = ""
ELSE
m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
END IF
m_k& = m_k& + 1 ' Adds trailing zeros multiplication
NEXT
m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
NEXT
fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
IF m_decimal_places& > LEN(m_product$) THEN m_product$ = STRING$(m_decimal_places& - LEN(m_product$), "0") + m_product$ ' Add any leading zeros to a decimal. Ex: .02 * .01 is factored as 002. It needs one leading zero before adding the decimal point, .0002.
IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
END IF
DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
m_product$ = MID$(m_product$, 2)
LOOP
IF m_decimal_places& THEN
DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
LOOP
END IF
IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
IF RIGHT$(m_product$, 1) = "." THEN m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1) ' Remove decimal from the end of an integer total.
IF operationdivision% THEN m_sign% = 0: RETURN
stringmathb$ = m_product$: m_product$ = ""
IF stringmathb$ = "overflow" THEN EXIT SUB
runningtotal$ = stringmathb$: stringmathb$ = ""
IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
EXIT SUB
string_add_subtract:
IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
END IF
IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
END IF
IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
IF sumplace& > addsubplace& THEN
stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
ELSEIF addsubplace& > sumplace& THEN
stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
END IF
IF numplace& > addsubplace& THEN
stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
ELSEIF addsubplace& > numplace& THEN
stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
END IF ' END Decimal evaluations.
IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"
addsubsign% = 0
SELECT CASE sign_input$ + operator$ + sign_total$
CASE "+++", "+--"
operator$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
CASE "++-", "+-+"
operator$ = "-"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
GOSUB string_comp
IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "---", "-++"
operator$ = "-"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
GOSUB string_comp
IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "--+", "-+-"
operator$ = "+"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
addsubsign% = -1
END SELECT
IF LEN(stringmatha$) > LEN(stringmathb$) THEN
stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
END IF
addsubx1$ = ""
SELECT CASE operator$
CASE "+", "="
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
GOSUB replace_decimal
CASE "-"
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
addsubx1$ = MID$(addsubx1$, 2)
LOOP
IF addsubx1$ = "" THEN
addsubx1$ = "0": addsubsign% = 0
ELSE
IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
END IF
END SELECT
IF addsubsign% THEN
IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
END IF
stringmatha$ = addsubx1$: addsubx1$ = ""
IF operationdivision% THEN RETURN
stringmathb$ = stringmatha$: stringmatha$ = ""
IF LEFT$(stringmathb$, 1) = "-" THEN
stringmathb$ = MID$(stringmathb$, 2)
n2sign$ = "-"
ELSE
n2sign$ = ""
END IF
IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
EXIT SUB
replace_decimal:
IF addsubplace& THEN
addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
addsubplace& = addsubplace& - 1
LOOP
IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
END IF
RETURN
string_comp:
DO
REM Remove trailing zeros after a decimal point.
IF INSTR(acomp$, ".") THEN
DO UNTIL RIGHT$(acomp$, 1) <> "0" AND RIGHT$(acomp$, 1) <> "." AND RIGHT$(acomp$, 1) <> "-"
acomp$ = MID$(acomp$, 1, LEN(acomp$) - 1)
LOOP
END IF
IF INSTR(bcomp$, ".") THEN
DO UNTIL RIGHT$(bcomp$, 1) <> "0" AND RIGHT$(bcomp$, 1) <> "." AND RIGHT$(bcomp$, 1) <> "-"
bcomp$ = MID$(bcomp$, 1, LEN(bcomp$) - 1)
LOOP
END IF
IF MID$(acomp$, 1, 2) = "-0" OR acomp$ = "" OR acomp$ = "-" THEN acomp$ = "0"
IF MID$(bcomp$, 1, 2) = "-0" OR bcomp$ = "" OR bcomp$ = "-" THEN bcomp$ = "0"
' A - and +
IF LEFT$(acomp$, 1) = "-" THEN j% = -1
IF LEFT$(bcomp$, 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(acomp$, ".")
k% = INSTR(bcomp$, ".")
IF j% = 0 AND k% THEN
IF acomp$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF bcomp$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' Both decimals.
IF j% THEN
IF acomp$ > bcomp$ THEN
gl% = 1
ELSEIF acomp$ = bcomp$ THEN gl% = 0
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
EXIT DO
END IF
' Both positive or both negative whole numbers.
SELECT CASE LEN(acomp$)
CASE IS < LEN(bcomp$)
gl% = -1
CASE IS = LEN(bcomp$)
IF acomp$ = bcomp$ THEN
gl% = 0
ELSEIF acomp$ > bcomp$ THEN gl% = 1
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
CASE IS > LEN(bcomp$)
gl% = 1
END SELECT
EXIT DO
LOOP
RETURN
END SUB
SUB string_compare (compa$, compb$, gl%)
DO
REM 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 validate_string (stringmathb$)
DO ' Faux loop.
vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": EXIT DO
IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
FOR sm_i& = 1 TO LEN(stringmathb$)
validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
SELECT CASE validatenum$
CASE "+"
IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
CASE "-"
IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
CASE "0" TO "9"
vsn_numberpresent& = -1
CASE "D", "E"
vsn_depresent& = vsn_depresent& + 1
IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
vsn_numberpresent& = 0
MID$(stringmathb$, sm_i&, 1) = "e" ' Standardize
CASE "."
decimalcnt& = decimalcnt& + 1
IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
CASE ELSE
vsn_numberpresent& = 0: EXIT FOR
END SELECT
NEXT
IF decimalcnt& = 0 THEN stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": EXIT DO
vsn_depresent& = INSTR(stringmathb$, "e")
sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": EXIT DO ' No leading zeros allowed in exponent notation.
END IF
jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
IF RIGHT$(stringmathb$, 1) = "." THEN
stringmathb$ = "0.e+0" ' Handles all types of zero entries.
ELSE
stringmathb$ = "invalid number": EXIT DO
END IF
EXIT DO
END IF
stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
EXIT DO
ELSE
FOR sm_i& = 1 TO LEN(stringmathb$)
validatenum$ = MID$(stringmathb$, sm_i&, 1)
SELECT CASE validatenum$
CASE "."
decimalcnt& = decimalcnt& + 1
CASE "0"
vsn_zerospresent& = -1
CASE "1" TO "9"
vsn_numberpresent& = -1
CASE "$"
CASE ELSE
stringmathb$ = "invalid number": EXIT DO
END SELECT
NEXT
IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
stringmathb$ = "invalid number": EXIT DO
END IF
REM IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
REM IF INSTR(stringmathb$, ",") THEN
REM GOSUB comma_validation
REM IF stringmathb$ = "invalid number" THEN exit do
REM GOSUB comma_removal
REM END IF
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
stringmathb$ = MID$(stringmathb$, 2)
LOOP
stringmathb$ = sm_sign$ + stringmathb$
IF INSTR(stringmathb$, ".") THEN
DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
END IF
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
IF vsn_numberpresent& = 0 THEN
IF vsn_zerospresent& THEN
stringmathb$ = "0"
ELSE
stringmathb$ = "invalid number"
END IF
END IF
END IF
EXIT DO
LOOP
END SUB
Pete
If eggs are brain food, Biden takes his scrambled.
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
Here's a way which seems like it'd be mighty speed to me -- and it doesn't take any multiplication after a 1 run look-up table!
Make an array from 0 to 9. (DIM foo(9) AS STRING)
Take your divisor and multiply it by 0 to 9. Store the results.
For example, my divisor is 100.
foo(1) = 100
foo(2) = 200
...
foo(9) = 900)
With your lookup table, you now just grab chunks of your string and compare.
Write a SELECT CASE to find your value
SELECT CASE num2check$
CASE < foo(1): dividend = 0
CASE < foo(2): dividend = 1
CASE < foo(3): dividend = 2
....
CASE ELSE: dividend = 9
END SELECT
*******
In practice, let's use 123456789/ 3 as an easy example:
f1 = 3
f2 = 6
f3 = 9
... you get the array....
start with the first digit: 1... smaller than f1, result is 0. 1 - 0 = 1 carryover
bring down the 2. Value is now 12. is smaller than f5, result is 4. 12 - 12 = 0 carryover
bring down the 3. Carryover was 0, value is 3. Less than f2, result is 1. 3 - 3 = 0
bring down the 4. Carryover was 0, value is 4. Less than f2, result is 1. 4 - 3 = 1 carryover
bring down the 5. Carryover was 1, value is 15. Less than f6, result is 5....
... and on.
Instead of doing that multiplication math over and over, do it once and store it in an array. I imagine you'll save a boatload of time processing, if you do so.
Posts: 336
Threads: 24
Joined: Apr 2022
Reputation:
19
08-20-2022, 01:24 PM
(This post was last modified: 08-20-2022, 01:33 PM by Jack.)
Posts: 1,616
Threads: 157
Joined: Apr 2022
Reputation:
77
WOW! this is great. I fixed two bugs in my new string math routine after rigorous testing by incorporating it into my square root calculator. Then I substituted the debugged code to the square root calculator and the speed improvement was blinding!
So I did a test on the square root of 2 to 5,000 places. It only took 45 seconds on my slow clunky laptop. If you like to try that out, change the limit&& variable to 5000, run the program, and input 2 at the number prompt.
Anyway, here's the square root program with the my new faster bulk number processing string math system.
Code: (Select All) WIDTH 160, 42
_SCREENMOVE 0, 0
DO
limit&& = 128
'betatest% = -1
IF betatest% THEN limit&& = 16
DO
INPUT "Number: "; x$: PRINT
IF x$ = "" THEN SYSTEM
IF LEFT$(x$, 1) = "-" THEN
PRINT "Negatives not allowed. Redo..": _DELAY 2: PRINT
ELSE
validate_string x$
IF INSTR(x$, "invalid") = 0 THEN EXIT DO
PRINT "Sorry, "; x$: _DELAY 1: PRINT
END IF
LOOP
x# = VAL(x$) ' Needed for QB64 SQR() comparison only.
oldy$ = ""
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
stringmatha$ = z$: stringmathb$ = k$
string_math z$, "-", k$, runningtotal$, terminating_decimal%, limit&&
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
string_math sqrt$, "*", "2", y$, terminating_decimal%, limit&&
y$ = y$ + LTRIM$(STR$(j&&))
ELSE
y$ = LTRIM$(STR$(j&&))
END IF
string_math y$, "*", LTRIM$(STR$(j&&)), runningtotal$, terminating_decimal%, limit&&
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
string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
IF STRING$(LEN(z$), "0") = z$ AND runningtotal$ = "0" AND i&& >= LEN(decx$) THEN EXIT DO
IF dp&& = 0 THEN ' Limited to && size unless converted to string.
IF i&& >= LEN(decx$) THEN
dp&& = INT(LEN(decx$) / 2 + .5)
IF dp&& = 0 THEN dp&& = -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%))
string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
k$ = runningtotal$
IF betatest% THEN PRINT "Remainder "; z$; " minus "; k$; " = ";
EXIT FOR
END IF
oldy$ = y$
NEXT
IF betatest% THEN
string_math stringmatha$, "-", stringmathb$, runningtotal$, terminating_decimal%, limit&&
PRINT runningtotal$; " sqrt = "; sqrt$
END IF
i&& = i&& + 2
IF LEN(z$) >= limit&& THEN EXIT DO
x$ = x$ + "00"
LOOP
PRINT
IF dp&& THEN
sqrt$ = MID$(sqrt$, 0, dp&& + 1) + "." + MID$(sqrt$, dp&& + 1)
END IF
_CLIPBOARD$ = sqrt$
PRINT "QB64 SQR:"; SQR(x#)
PRINT "Pete SQR: "; sqrt$: _DELAY 1: CLEAR
PRINT
LOOP
SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, terminating_decimal%, limit&&)
DIM AS _INTEGER64 a, b, c, aa, bb, cc, s, ss
a1$ = stringmatha$: b1$ = stringmathb$
SELECT CASE operator$
CASE "+", "-"
GOTO string_add_subtract_new
CASE "*"
GOTO string_multiply_new
CASE "/"
GOTO string_divide
CASE ELSE
PRINT "Error, no operator selected. operator$ = "; operator$
END SELECT
string_divide:
terminating_decimal% = 0: divsign% = 0: divremainder& = 0: divremainder$ = "": divplace& = 0: divplace2& = 0: quotient$ = "": divcarry& = 0
operationdivision% = -1
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: operationdivision% = 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$
m_product$ = "": GOSUB string_multiply_new
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(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
NEXT
quotient$ = quotient$ + LTRIM$(STR$(div_i%))
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply_new
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract_new
divremainder$ = stringmatha$
operator$ = "/"
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
operationdivision% = 0
stringmathb$ = quotient$: quotient$ = ""
IF stringmathb$ = "overflow" THEN divsign% = 0: operationdivision% = 0: EXIT SUB
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
operationdivision% = 0
EXIT SUB
'------------------------------------------------------------------------
string_add_subtract_new:
s = 18
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
s = 18: z$ = ""
DO
i&& = i&& + s
x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
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$(LEN(x1$) - 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
EXIT SUB
'------------------------------------------------------------------------
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
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
IF betatest% THEN PRINT "x1$ = "; x1$;: LOCATE , 20: PRINT "x2$ = "; x2$;: LOCATE , 35: PRINT VAL(x1$) * VAL(x2$) + c;: LOCATE , 55: PRINT "c = "; c;: LOCATE , 75: PRINT "val = "; a,
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 betatest% THEN LOCATE , 100: PRINT a;: LOCATE , 120: PRINT 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")
IF betatest% THEN PRINT "aa$ "; aa$; " + bb$ "; z$;: COLOR 14, 0: PRINT STRING$(jj&& - 1, "0"); " = ";: COLOR 7, 0: SLEEP
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$
IF betatest% THEN COLOR 2, 0: PRINT holdaa$: COLOR 7, 0
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$
EXIT SUB
replace_decimal:
IF addsubplace& THEN
addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
addsubplace& = addsubplace& - 1
LOOP
IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
END IF
RETURN
string_comp:
DO
' Remove trailing zeros after a decimal point.
IF INSTR(acomp$, ".") THEN
DO UNTIL RIGHT$(acomp$, 1) <> "0" AND RIGHT$(acomp$, 1) <> "." AND RIGHT$(acomp$, 1) <> "-"
acomp$ = MID$(acomp$, 1, LEN(acomp$) - 1)
LOOP
END IF
IF INSTR(bcomp$, ".") THEN
DO UNTIL RIGHT$(bcomp$, 1) <> "0" AND RIGHT$(bcomp$, 1) <> "." AND RIGHT$(bcomp$, 1) <> "-"
bcomp$ = MID$(bcomp$, 1, LEN(bcomp$) - 1)
LOOP
END IF
IF MID$(acomp$, 1, 2) = "-0" OR acomp$ = "" OR acomp$ = "-" THEN acomp$ = "0"
IF MID$(bcomp$, 1, 2) = "-0" OR bcomp$ = "" OR bcomp$ = "-" THEN bcomp$ = "0"
' A - and +
IF LEFT$(acomp$, 1) = "-" THEN j% = -1
IF LEFT$(bcomp$, 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(acomp$, ".")
k% = INSTR(bcomp$, ".")
IF j% = 0 AND k% THEN
IF acomp$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF bcomp$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' Both decimals.
IF j% THEN
IF acomp$ > bcomp$ THEN
gl% = 1
ELSEIF acomp$ = bcomp$ THEN gl% = 0
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
EXIT DO
END IF
' Both positive or both negative whole numbers.
SELECT CASE LEN(acomp$)
CASE IS < LEN(bcomp$)
gl% = -1
CASE IS = LEN(bcomp$)
IF acomp$ = bcomp$ THEN
gl% = 0
ELSEIF acomp$ > bcomp$ THEN gl% = 1
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
CASE IS > LEN(bcomp$)
gl% = 1
END SELECT
EXIT DO
LOOP
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: PRINT "1*": EXIT DO
IF j% = 0 AND k% THEN gl% = 1: PRINT "2*": 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: PRINT "4*" ELSE gl% = 1: PRINT "5*"
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF compb$ = "0" THEN gl% = 1: PRINT "6*" ELSE gl% = -1: PRINT "7*"
EXIT DO
END IF
' Both decimals.
IF j% THEN
IF compa$ > compb$ THEN
gl% = 1: PRINT "8*"
ELSEIF compa$ = compb$ THEN gl% = 0: PRINT "9*"
ELSEIF compa$ < compb$ THEN gl% = -1: PRINT "10*"
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 validate_string (stringmathb$)
DO ' Faux loop.
vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": EXIT DO
IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
FOR sm_i& = 1 TO LEN(stringmathb$)
validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
SELECT CASE validatenum$
CASE "+"
IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
CASE "-"
IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
CASE "0" TO "9"
vsn_numberpresent& = -1
CASE "D", "E"
vsn_depresent& = vsn_depresent& + 1
IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
vsn_numberpresent& = 0
MID$(stringmathb$, sm_i&, 1) = "e" ' Standardize
CASE "."
decimalcnt& = decimalcnt& + 1
IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
CASE ELSE
vsn_numberpresent& = 0: EXIT FOR
END SELECT
NEXT
IF decimalcnt& = 0 THEN stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": EXIT DO
vsn_depresent& = INSTR(stringmathb$, "e")
sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": EXIT DO ' No leading zeros allowed in exponent notation.
END IF
jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
IF RIGHT$(stringmathb$, 1) = "." THEN
stringmathb$ = "0.e+0" ' Handles all types of zero entries.
ELSE
stringmathb$ = "invalid number": EXIT DO
END IF
EXIT DO
END IF
stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
EXIT DO
ELSE
FOR sm_i& = 1 TO LEN(stringmathb$)
validatenum$ = MID$(stringmathb$, sm_i&, 1)
SELECT CASE validatenum$
CASE "."
decimalcnt& = decimalcnt& + 1
CASE "0"
vsn_zerospresent& = -1
CASE "1" TO "9"
vsn_numberpresent& = -1
CASE "$"
CASE ELSE
stringmathb$ = "invalid number": EXIT DO
END SELECT
NEXT
IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
stringmathb$ = "invalid number": EXIT DO
END IF
REM IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
REM IF INSTR(stringmathb$, ",") THEN
REM GOSUB comma_validation
REM IF stringmathb$ = "invalid number" THEN exit do
REM GOSUB comma_removal
REM END IF
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
stringmathb$ = MID$(stringmathb$, 2)
LOOP
stringmathb$ = sm_sign$ + stringmathb$
IF INSTR(stringmathb$, ".") THEN
DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
END IF
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
IF vsn_numberpresent& = 0 THEN
IF vsn_zerospresent& THEN
stringmathb$ = "0"
ELSE
stringmathb$ = "invalid number"
END IF
END IF
END IF
EXIT DO
LOOP
END SUB
Pete
|
