07-28-2022, 10:43 AM
OK Pete
output using the default input (just press return when prompted for input)
Code: (Select All)
$NoPrefix
$Console:Only
Dest Console
'BIGNUM.BAS v0.n
'Sep-Dec 1996 by Marc Kummel aka Treebeard.
'Contact mkummel@rain.org, http://www.rain.org/~mkummel/
'
' ** site no longer available, use the link below
' https://web.archive.org/web/20200220020034/http://www.rain.org/~mkummel/tbvault.html
' Conditions:
'-------------
'This program and source code are yours to use and modify as you will, but
'they are offered as freeware with no warranty whatsoever. Give me credit,
'but do not distribute any changes under my name, or attribute such changes
'to me in any way. You're on your own!
Const zero = "0", one = "1"
Const dp = ".", neg = "-", asc0 = 48
Const negative = -1, positive = 1 'returned by bComp()
Const maxlongdig = 8 'max digits in long var&
Const true = -1
'useful shared stuff
Dim Shared As Long digits
Dim Shared As String errors
Const null = ""
digits = 24 'digits for division etc
's = |s|
'
'========================================================================
Dim As String n, m, r
Dim As Long i, j
t = Timer
Input "enter n ", n
If n = "" Then
n = "3.1415926535897932384626433832795"
Print "n = "; n
End If
Input "enter m ", m
If m = "" Then
m = "-2.7182818284590452353602874713527"
Print "m = "; m
End If
Print
bAdd n, m, r
Print "n + m = "; r
bSub n, m, r
Print "n - m = "; r
bMul n, m, r
Print "n * m = "; r
bDiv n, m, r
Print "n / m = "; r
'========================================================================
Sub bAbs (s As String)
If Left$(s, 1) = neg Then s = Mid$(s, 2)
End Sub
'return true if s is negative
'
Function bIsNeg& (s As String)
bIsNeg = (Left$(s, 1) = neg)
End Function
'return sign of number (-1 or +1)
'
Function bSign& (s As String)
If bIsNeg(s) Then bSign = negative Else bSign = positive
End Function
'return the largest of two integers
'
Function bMaxInt& (n1 As Long, n2 As Long)
If n1 >= n2 Then bMaxInt = n1 Else bMaxInt = n2
End Function
'Compare two numbers using fast string compares. This can screw up since it
'uses string length, eg it reports "8"<"8." so watch out. The practice in
'these routines is no leading or trailing 0s and no final "." See bClean().
'
'Return 1 if s1 > s2
' 0 if s1 = s2
' -1 if s1 < s2
'
Function bComp& (s1 As String, s2 As String)
'dim as string dp
Dim As Long sign1, sign2, dp1, dp2, arg, s1flag, s2flag
'kludge to fix 0<.1
If Left$(s1, 1) = dp Then s1 = zero + s1: s1flag = true
If Left$(s2, 1) = dp Then s2 = zero + s2: s2flag = true
sign1 = (Left$(s1, 1) = neg)
sign2 = (Left$(s2, 1) = neg)
dp1 = InStr(s1, dp): If dp1 = 0 Then dp1 = Len(s1) + 1
dp2 = InStr(s2, dp): If dp2 = 0 Then dp2 = Len(s2) + 1
If sign1 <> sign2 Then
If sign1 Then arg = -1 Else arg = 1
ElseIf s1 = s2 Then
arg = 0
ElseIf (dp1 < dp2) Or ((dp1 = dp2) And (s1 < s2)) Then
arg = -1
Else
arg = 1
End If
If sign1 And sign2 Then arg = -arg
If s1flag Then s1 = Mid$(s1, 2)
If s2flag Then s2 = Mid$(s2, 2)
bComp = arg
End Function
'return true if s1 > s2
'
Function bIsMore& (s1 As String, s2 As String)
bIsMore = (bComp(s1, s2) = 1)
End Function
'Strip leading 0s and final "." (but leave something)
'
Sub bStripZero (s As String)
Dim As Long n
n = 1
Do While Mid$(s, n, 1) = zero
n = n + 1
Loop
If n > 1 Then s = Mid$(s, n)
If Right$(s, 1) = dp Then s = Left$(s, Len(s) - 1)
If Len(s) = 0 Then s = zero
End Sub
'Strip trailing 0s to "." (but leave something)
'
Sub bStripTail (s As String)
Dim As Long n
n = Len(s)
Do While Mid$(s, n, 1) = zero
n = n - 1
If n <= 1 Then Exit Do
Loop
If n Then If Mid$(s, n, 1) = dp Then n = n - 1
s = Left$(s, n)
If Len(s) = 0 Then s = zero
End Sub
'Strip s$ to whole number and base 10 integer logarithm and sign. Decimal
'point is implied after the first digit, and slog% counts places left or
'right. bLogPut() reverses the process, and bLogDp() gives info on the
'decimals. Tricky, but it works and simplifies dividing and multipling.
'eg s$ -> s$ , slog%
' 660 -> 66 , 2 (6.6 * 10^ 2) (or 660,2 if zeroflag%=false)
' 6.6 -> 66 , 0 (6.6 * 10^ 0)
' .066 -> 66 , -2 (6.6 * 10^-2)
'bDiv(), bMul(), and bSqr() use this to trim unnecessary zeros and to locate
'decimal point. These set zeroflag% to trim trailing zeros, but bDivIntMod()
'must set it false in order to figure remainder of division. A kludge.
'
Sub bLogGet (s As String, slog As Long, sign As Long, zeroflag As Long)
Dim As Long n, dpt
If Left$(s, 1) = neg Then s = Mid$(s, 2): sign = negative Else sign = positive
bStripZero s
dpt = InStr(s, dp)
Select Case dpt
Case 0
slog = Len(s) - 1
Case 1
n = dpt + 1
Do While Mid$(s, n, 1) = zero
n = n + 1
Loop
s = Mid$(s, n)
slog = dpt - n
Case Else
s = Left$(s, dpt - 1) + Mid$(s, dpt + 1)
slog = dpt - 2
End Select
'remove trailing 0's if zeroflag
If zeroflag Then bStripTail s
End Sub
'Strip a number to "standard form" with no leading or trailing 0s and no
'final "." All routines should return all arguments in this form.
'
Sub bClean (s As String)
Dim As Long sign
If Left$(s, 1) = neg Then s = Mid$(s, 2): sign = true
bStripZero s
If InStr(s, dp) Then bStripTail s
If sign And s <> zero Then s = neg + s
End Sub
'Restore a number from the integer and log figured in bLogGet(). s$ is taken
'as a number with the decimal after first digit, and decimal is moved slog%
'places left or right, adding 0s as required. Called by bDiv() and bMul().
'
Sub bLogPut (s As String, slog As Long, sign As Long)
Dim As Long last
last = Len(s)
If Len(s) = 0 Or s = zero Then
s = zero
ElseIf slog < 0 Then
s = dp + String$(-slog - 1, zero) + s
ElseIf slog > last - 1 Then
s = s + String$(slog - last + 1, zero) + dp
Else
s = Left$(s, slog + 1) + dp + Mid$(s, slog + 2)
End If
bClean s
If sign = negative Then s = neg + s
End Sub
'shift decimal n% digits (minus=left), i.e multiply/divide by 10.
'
Sub bShift (s As String, n As Long)
Dim As Long slog, sign
bLogGet s, slog, sign, 0 'false
bLogPut s, slog + n, sign
End Sub
's = -s
'
Sub bNeg (s As String)
If Left$(s, 1) = neg Then s = Mid$(s, 2) Else s = neg + s
End Sub
'Take whole number and log from bLogGet() and return number of decimal
'places in the expanded number; OR take string and number of decimal points
'desired and return the log. It works both ways.
'
Function bLogDp& (s As String, logdp As Long)
bLogDp = Len(s) - 1 - logdp
End Function
'out = s1 / s2 using fast long-integer algorithm. s2$ must be <= 8 digits.
's1$ and s2$ must be stripped first, no decimals.
'
Sub bDivLong (s1 As String, s2 As String, quotient As String, remain As String)
Dim As Long dividend, remainder, divisor, dig, i
quotient = null
remainder = 0
divisor = Val(s2)
For i = 1 To digits
dividend = remainder * 10 + Val(Mid$(s1, i, 1))
dig = dividend \ divisor
quotient = quotient + Chr$(asc0 + dig)
remainder = dividend - dig * divisor
Next i
If Len(quotient) = 0 Then quotient = zero
remain = LTrim$(Str$(remainder))
End Sub
'out = s1 / s2 using character algorithm, digit by digit, slow but honest.
's1$ and s2$ must be stripped first, no decimals.
'
Sub bDivChar (s1 As String, s2 As String, quotient As String, remainder As String)
Dim As Long last1, last2, ldvd, dig, borrow, i, j, n, lrem
Dim As String dvd
last1 = Len(s1) 'length of the dividend
last2 = Len(s2) 'length of the divisor
quotient = null
remainder = null
For i = 1 To digits
'get next digit of dividend or zero$ if past end
If i <= last1 Then
dvd = remainder + Mid$(s1, i, 1)
Else
dvd = remainder + zero
End If
'if dividend < divisor then digit%=0 else have to calculate it.
'do fast compare using string operations. see bComp%()
bStripZero dvd
ldvd = Len(dvd)
If (ldvd < last2) Or ((ldvd = last2) And (dvd < s2)) Then
'divisor is bigger, so digit is 0, easy!
dig = 0
remainder = dvd
Else
'dividend is bigger, but no more than 9 times bigger.
'subtract divisor until we get remainder less than divisor.
'time hog, average is 5 tries through j% loop. There's a better way.
For dig = 1 To 9
remainder = null
borrow = 0
For j = 0 To ldvd - 1
n = last2 - j
If n < 1 Then n = 0 Else n = Val(Mid$(s2, n, 1))
n = Val(Mid$(dvd, ldvd - j, 1)) - n - borrow
If n >= 0 Then borrow = 0 Else borrow = 1: n = n + 10
remainder = Chr$(asc0 + n) + remainder
Next j
'if remainder < divisor then exit
bStripZero remainder
lrem = Len(remainder)
If (lrem < last2) Or ((lrem = last2) And (remainder < s2)) Then Exit For
dvd = remainder
ldvd = Len(dvd)
Next dig
End If
quotient = quotient + Chr$(asc0 + dig)
Next i
End Sub
'out = s1 / s2
'
Sub bDiv (s1 As String, s2 As String, outs As String)
Dim As String t
Dim As Long slog1, slog2, sign1, sign2, outlog, outsign, olddigits
'strip divisor
t = s2
bLogGet t, slog2, sign2, -1 'true
'divide by zero?
If t = zero Then
outs = errors
'do powers of 10 with shifts
ElseIf t = one Then
outs = s1
sign1 = bSign(outs)
If sign1 = negative Then bAbs outs
bShift outs, -slog2
If sign1 <> sign2 Then bNeg outs
'the hard way
Else
'strip all
s2 = t: t = null
bLogGet s1, slog1, sign1, -1 'true
'figure decimal point and sign of answer
outlog = slog1 + bLogDp(s2, slog2)
If sign1 <> sign2 Then outsign = negative Else outsign = positive
'bump digits past leading zeros and always show whole quotient
olddigits = digits
digits = digits + Len(s2)
If digits < outlog + 1 Then digits = outlog + 1
'do it, ignore remainder
If Len(s2) <= maxlongdig Then bDivLong s1, s2, outs, t Else bDivChar s1, s2, outs, t
'clean up
bLogPut outs, outlog, outsign
bLogPut s1, slog1, sign1
bLogPut s2, slog2, sign2
digits = olddigits
End If
End Sub
'Trim leading spaces, add decimal points, eliminate signs.
'Returns last%=length of string, dpt%=decimal place, sign%=-1 or 1.
'Called only by bAdd() and bSub() which needs a final decimal point.
'
Sub bStripDp (s As String, last As Long, dpt As Long, sign As Long)
If Left$(s, 1) = neg Then s = Mid$(s, 2): sign = negative Else sign = positive
bStripZero s
If InStr(s, dp) = 0 Then s = s + dp
If s = dp Then s = "0."
dpt = InStr(s, dp)
last = Len(s)
End Sub
declare SUB bAdd (s1 as string, s2 as string, outs as string)
'out = s1 - s2
'
Sub bSub (s1 As String, s2 As String, outs As String)
Dim As Long last, last1, last2, sign1, sign2, dpt, dp1, dp2
Dim As Long d1, d2, borrow, swapflag, i, n
'strip the numbers
bStripDp s1, last1, dp1, sign1
bStripDp s2, last2, dp2, sign2
'treat different signs as addition
If sign1 = negative And sign2 = positive Then
bNeg s1
bNeg s2
bAdd s1, s2, outs
bNeg s2
Exit Sub
ElseIf sign1 = positive And sign2 = negative Then
bAdd s1, s2, outs
bNeg s2
Exit Sub
End If
'align the decimal points and digit pointers
last = bMaxInt(last1 - dp1, last2 - dp2)
d1 = last + dp1
d2 = last + dp2
dpt = bMaxInt(dp1, dp2)
last = dpt + last
outs = Space$(last)
borrow = 0
'always subtract smaller from bigger to avoid complements
If bIsMore(s2, s1) Then Swap s2, s1: Swap d2, d1: swapflag = true
'do the subtraction right to left
For i = last To 1 Step -1
If i <> dpt Then
If d1 > 0 Then n = Val(Mid$(s1, d1, 1)) Else n = 0
If d2 > 0 Then n = n - Val(Mid$(s2, d2, 1))
n = n - borrow
If n >= 0 Then borrow = 0 Else borrow = 1: n = n + 10
Mid$(outs, i, 1) = Chr$(asc0 + n)
Else
Mid$(outs, i, 1) = dp
End If
d1 = d1 - 1
d2 = d2 - 1
Next i
'clean up
If sign1 = negative Then s1 = neg + s1: s2 = neg + s2
If swapflag Then Swap s2, s1: sign1 = -sign1
If sign1 = negative Then outs = neg + outs
bClean s1
bClean s2
bClean outs
End Sub
'out = s1 + s2
'
Sub bAdd (s1 As String, s2 As String, outs As String)
Dim As Long last1, last2, sign1, sign2, dp1, dp2
Dim As Long last, i, d1, d2, dpt, carry, n
'strip the numbers
bStripDp s1, last1, dp1, sign1
bStripDp s2, last2, dp2, sign2
'treat different signs as subtraction and exit
If sign1 = negative And sign2 = positive Then
bSub s2, s1, outs
bNeg s1
Exit Sub
ElseIf sign1 = positive And sign2 = negative Then
bSub s1, s2, outs
bNeg s2
Exit Sub
End If
'align the decimal points and digit pointers
last = bMaxInt(last1 - dp1, last2 - dp2)
d1 = last + dp1
d2 = last + dp2
dpt = bMaxInt(dp1, dp2)
last = dpt + last
outs = Space$(last)
carry = 0
'do the addition right to left
For i = last To 1 Step -1
If i <> dpt Then
n = carry
If d1 > 0 Then n = n + Val(Mid$(s1, d1, 1))
If d2 > 0 Then n = n + Val(Mid$(s2, d2, 1))
carry = n \ 10
Mid$(outs, i, 1) = Chr$(asc0 + (n Mod 10))
Else
Mid$(outs, i, 1) = dp
End If
d1 = d1 - 1
d2 = d2 - 1
Next i
If carry Then outs = one + outs
'clean up
If sign1 = negative Then s1 = neg + s1: s2 = neg + s2: outs = neg + outs
bClean s1
bClean s2
bClean outs
End Sub
'out = s1 * s2 using character algorithm, slow but honest. Whole numbers
'only. Inner loop is optimized and hard to understand, but it works.
'
Sub bMulChar (s1 As String, s2 As String, outs As String)
Dim As Long last, last1, last2, i, j, k, sj, ej, product
last1 = Len(s1)
last2 = Len(s2)
last = last1 + last2
outs = Space$(last)
product = 0
For i = 0 To last - 1
k = last1 - i
sj = 1 - k: If sj < 0 Then sj = 0
ej = last1 - k: If ej > last2 - 1 Then ej = last2 - 1
For j = sj To ej
product = product + Val(Mid$(s1, k + j, 1)) * Val(Mid$(s2, last2 - j, 1))
Next j
Mid$(outs, last - i, 1) = Chr$(asc0 + CInt(product Mod 10))
product = product \ 10
Next i
If product Then outs = LTrim$(Str$(product)) + outs
End Sub
'out = s1 * s2 using fast long-integer algorithm. s2$ must be <= 8 digits.
's1$ and s2$ must be stripped first, whole numbers only.
'
Sub bMulLong (s1 As String, s2 As String, outs As String)
Dim As Long last1, s2L, i, product
last1 = Len(s1)
s2L = Val(s2)
outs = Space$(last1)
For i = last1 To 1 Step -1
product = product + Val(Mid$(s1, i, 1)) * s2L
Mid$(outs, i, 1) = Chr$(asc0 + CInt(product Mod 10))
product = product \ 10
Next i
If product Then outs = LTrim$(Str$(product)) + outs
End Sub
'out = s1 * s2
'
Sub bMul (s1 As String, s2 As String, outs As String)
Dim As Long slog1, slog2, sign1, sign2, outdp, outsign
Dim As Long outlog, swapflag
Dim As String t
'strip multiplier
t = s2
bLogGet t, slog2, sign2, true
'times 0
If t = zero Then
outs = zero
'do powers of 10 with shifts
ElseIf t = one Then
outs = s1
sign1 = bSign(outs)
If sign1 = negative Then bAbs outs
bShift outs, slog2
If sign1 <> sign2 Then bNeg outs
'the hard way
Else
'strip all
s2 = t: t = null
bLogGet s1, slog1, sign1, true
'figure decimal point and sign of answer
outdp = bLogDp(s1, slog1) + bLogDp(s2, slog2)
If sign1 <> sign2 Then outsign = negative Else outsign = positive
'always multiply by the shorter number
If Len(s2) > Len(s1) Then Swap s1, s2: swapflag = true
'do it
If Len(s2) <= maxlongdig Then bMulLong s1, s2, outs Else bMulChar s1, s2, outs
'clean up
outlog = bLogDp(outs, outdp)
bLogPut outs, outlog, outsign
If swapflag Then Swap s1, s2
bLogPut s1, slog1, sign1
bLogPut s2, slog2, sign2
End If
End SubCode: (Select All)
enter n
n = 3.1415926535897932384626433832795
enter m
m = -2.7182818284590452353602874713527
n + m = .4233108251307480031023559119268
n - m = 5.8598744820488384738229308546322
n * m = -8.53973422267356706546355086954668447174445893592492906242717965
n / m = -1.155727349790921717910093