just for fun I adapted Treebeard's String-Math arithmetic routines +, -, * and / to QB64 https://web.archive.org/web/202002200200...vault.html
Updated to include Sqr, Log, Exp and trig functions
Updated to include Sqr, Log, Exp and trig functions
Code: (Select All)
$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 neg$ = "-"
Const negative = -1
Const positive = 1
Const asc0 = 48
Const dp$ = "."
Const zero$ = "0"
Const one$ = "1"
Const two$ = "2"
Const three$ = "3"
Const four$ = "4"
Const five$ = "5"
Const False = 0
Const True = -1
Const basechr = "@"
Const basesep$ = ","
Const maxlongdig = 8
Const emem = 32
Const memget = 0
Const memput = 1
Const defaultdigits = 30
Const maxmem = 35
Const maxstack = 10
Const minconst = 30
Const maxconst = 35
Const pimem = 30
Const pi2mem = 31
Const phimem = 33
Const ln10mem = 34
Const ln2mem = 35
Const memclr = 2
'useful shared stuff, initialize these in bInit()
Dim Shared errormsg$, abortmsg$, Error$, bmem$(maxmem), out$
Dim Shared zmem$(maxstack), cname$(maxconst)
Dim Shared bncpath$, prmcntfile$
Dim Shared digits%, zstack%
'Prime count table data
Dim maxprmcnt%
Dim prmcnt&
'======================================
Dim n As String
Dim m As String
Dim c As String
digits% = 35
bInit
n = "7." + String$(digits% - 1, "7")
m = "9." + String$(digits% - 1, "9")
c = ""
bAdd (n), (m), c
Print "n + m = "; c
bSub (n), (m), c
Print "n - m = "; c
bMul (n), (m), c
Print "n * m = "; c
bDiv (n), (m), c
Print "n / m = "; c
bSqr "2", c
Print "Sqr(2) = "; c
bLn "2", c
Print "Ln(2) = "; c
bLog "2", "10", c
Print "Log10(2) = "; c
bSin "1", c
Print "Sin(1) = "; c
bCos "1", c
Print "Cos(1) = "; c
bTan "1", c
Print "Tan(1) = "; c
'======================================
' BNCxx.BAS
' BNC math module
' 1997 by Marc Kummel aka Treebeard.
' Contact mkummel@rain.org, http://www.rain.org/~mkummel/
's = |s|
'
Sub bAbs (s$)
If Left$(s$, 1) = neg$ Then s$ = Mid$(s$, 2)
End Sub
'out = s1 + s2
'
Sub bAdd (s1$, s2$, out$)
Dim last1%, dp1%, sign1%, last2%, dp2%, sign2%
Dim last%, d1%, d2%, dpt%, carry%
Dim i%, 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$, out$
bNeg s1$
Exit Sub
ElseIf sign1% = positive And sign2% = negative Then
bSub s1$, s2$, out$
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%
out$ = 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$(out$, i%, 1) = Chr$(asc0 + (n% Mod 10))
Else
Mid$(out$, i%, 1) = dp$
End If
d1% = d1% - 1
d2% = d2% - 1
Next i%
If carry% Then out$ = one$ + out$
'clean up
If sign1% = negative Then s1$ = neg$ + s1$: s2$ = neg$ + s2$: out$ = neg$ + out$
bClean s1$
bClean s2$
bClean out$
End Sub
'out = arccos(s)
'
Sub bArcCos (s$, out$)
Dim t$, t2$
' pi
' Arccos(x) = -- - Arcsin(x)
' 2
bPi t$
t2$ = t$
bDiv t2$, two$, t$
bArcSin s$, out$
If out$ <> Error$ Then bSub t$, (out$), out$
End Sub
'out = arccosh(s)
'
Sub bArcCosh (s$, out$)
'acosh(x) = Log(x + Sqr(x * x - 1))
out$ = zero$
End Sub
'out =arccot(s)
'
Sub bArcCot (s$, out$)
'acot(x) = Atn(x) + pi / 2
out$ = zero$
End Sub
'out =arccoth(s)
'
Sub bArcCoth (s$, out$)
'acoth(x) = Log((x + 1) / (x - 1)) / 2
out$ = zero$
End Sub
'out = arccsc(s)
'
Sub bArcCsc (s$, out$)
'acsc(x) = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * pi / 2
out$ = zero$
End Sub
'out = arccsch(s)
'
Sub bArcCsch (s$, out$)
'acsch(x) = Log((Sgn(x) * Sqr(x * x + 1) + 1) / x)
out$ = zero$
End Sub
'out = arcsec(s)
'
Sub bArcSec (s$, out$)
'asec(x) = Atn(x / Sqr(x * x - 1)) + Sgn(Sgn(x) - 1) * pi / 2
out$ = zero$
End Sub
'out = arcsech(s)
'
Sub bArcSech (s$, out$)
'asech(x) = Log(Sqr((-x * x + 1) + 1) / x)
out$ = zero$
End Sub
'out = arcsin(s)
'
Sub bArcSin (s$, out$)
Dim t$, t2$
' x
' Arcsin(x) = Arctan --------
' û(1-x^2)
t2$ = s$
bMul t2$, s$, t$
bTrimDig t$
t2$ = t$
bSub one$, t2$, t$
If bIsNeg%(t$) Then
out$ = Error$
ElseIf bIsZero%(t$) Then
bPi out$
t2$ = out$
bDiv t2$, two$, out$
Else
t2$ = t$
bSqr t2$, t$
t2$ = t$
bDiv s$, t2$, t$
bTrimDig t$
bArcTan t$, out$
End If
End Sub
'out = arcsinh(s)
'
Sub bArcSinh (s$, out$)
'asinh(x) = Log(x + Sqr(x * x + 1))
out$ = zero$
End Sub
'out = arctan(s)
'
Sub bArcTan (s$, out$)
Dim t$, tfac$, fac$, d$, z$
Dim olddigits%, flag%
olddigits% = digits%
digits% = digits% + 5
t$ = s$: bAbs t$
If bIsMore%(t$, one$) Then GoSub aTan2 Else GoSub aTan1
digits% = olddigits%
bTrimDig out$
Exit Sub
'both routines are slow when |x|=1!
'for -1 < x < 1
' x^3 x^5 x^7
'arctan(x) = x - --- + --- - --- + ...
' 3 5 7
aTan1:
t$ = s$
z$ = t$
bMul z$, t$, tfac$
bTrimDig tfac$
out$ = t$
fac$ = three$
flag% = False
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
bDiv t$, fac$, d$
bTrimDig d$
If bIsZero%(d$) Then Exit Do
If flag% Then
z$ = out$
bAdd z$, d$, out$
Else
z$ = out$
bSub z$, d$, out$
End If
flag% = Not flag%
bInc fac$, 2
Loop
Return
'x < -1 or x > 1
' ã 1 1 1 1
'arctan(x) = (+/-) - - - + ---- - ---- + ---- - ...
' 2 x 3x^3 5x^5 7x^7
aTan2:
t$ = s$
z$ = t$
bMul z$, t$, tfac$
bTrimDig tfac$
out$ = t$
bInv out$
bNeg out$
fac$ = three$
flag% = True
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
bMul t$, fac$, d$
bTrimDig d$
bInv d$
bTrimDig d$
If bIsZero%(d$) Then Exit Do
If flag% Then
z$ = out$
bAdd z$, d$, out$
Else
z$ = out$
bSub z$, d$, out$
End If
flag% = Not flag%
bInc fac$, 2
Loop
digits% = olddigits%
bPi t$
z$ = t$
bDiv z$, two$, t$
If bIsNeg%(s$) Then bNeg t$
z$ = out$
bAdd z$, t$, out$
Return
End Sub
'out = arctanh(s)
'
Sub bArcTanh (s$, out$)
'atanh(x) = Log((1 + x) / (1 - x)) / 2
out$ = zero$
End Sub
'Convert s$ FROM base base1% TO base base2%, including decimals to digits% places.
's$ is modified in place. No errors for illegal digits, eg 161 base 2 is
'treated as (1*2^2)+(6*2^1)+(1*2^0) even though the "6" is wrong. Bases
'to 16 are formed with 1..F, but larger bases are formed with digit groups
'separated by commas, eg 6,6,@100=(6*100^1+6*100^0)=606. Bases ok to 32K!
'Appends "@n" to end of string if base2%<>10, which GetArg() will recognize.
'Slow because of divisions, but the decimals are fun.
'
Sub bBase (s$, base1%, base2%)
Dim b1$, b2$, whole$, dec$, n$, r$, t$, tn$, dig$, z$
Dim negflag%, digmask%, groupflag%, dpt%
Dim i%, j%, last%, nn%
If base1% < 2 Or base2% < 2 Then s$ = Error$: Exit Sub
If base1% = base2% Then Exit Sub
If Left$(s$, 1) = neg$ Then s$ = Mid$(s$, 2): negflag% = True
b1$ = LTrim$(Str$(base1%))
b2$ = LTrim$(Str$(base2%))
digmask% = Len(LTrim$(Str$(base2% - 1)))
'convert FROM base base1%
dpt% = InStr(s$, dp$)
If dpt% = 0 Then dpt% = Len(s$) + 1
'if base 10, then we're done
If base1% = 10 Then
whole$ = Left$(s$, dpt% - 1)
dec$ = Mid$(s$, dpt%)
Else
'else figure whole part
n$ = Left$(s$, dpt% - 1)
GoSub bbConvertString
whole$ = n$
'figure decimal part
n$ = Mid$(s$, dpt% + 1)
If Len(n$) Then
GoSub bbConvertString
bPowerInt b1$, LTrim$(Str$(last%)), t$
bDiv n$, t$, dec$
End If
End If
'convert TO base base2%
'if base 10, then we're done
If base2% = 10 Then
bAdd whole$, dec$, s$
Else
s$ = ""
'figure whole part
Do
z$ = whole$
bDivIntMod z$, b2$, whole$, n$
nn% = Val(n$)
GoSub bbGetDigit
s$ = dig$ + s$
Loop Until whole$ = zero$
'figure decimal part
If Len(dec$) Then
s$ = s$ + dp$
r$ = one$
Do
z$ = r$
bMul z$, b2$, r$
bMul dec$, r$, n$
bInt n$
nn% = Val(n$)
GoSub bbGetDigit
s$ = s$ + dig$
z$ = n$
bDiv z$, r$, n$
z$ = n$
bSub dec$, z$, n$
dec$ = n$
Loop Until dec$ = zero$ Or Len(s$) > digits%
End If
End If
If Len(s$) = 0 Then s$ = zero$
If s$ <> zero$ Then
If base2% <> 10 Then s$ = s$ + " " + basechr$ + b2$
If negflag% Then s$ = neg$ + s$
End If
Exit Sub
'receive whole number n$ in base base1% and return it in base 10
bbConvertString:
tn$ = zero$
last% = Len(n$)
groupflag% = (base1% > 16) Or (InStr(n$, basesep$) > 0)
i% = 1
Do
If i% > last% Then Exit Do
If groupflag% Then
'digits in groups, eg 6,6,b100 = 6*10^1 + 6*10^0
j% = InStr(i%, n$, basesep$)
If j% = 0 Then j% = last%
nn% = Val(Mid$(n$, i%, j%))
i% = j% + 1
Else
'digits 1 by 1, eg 123 or ABC
nn% = Asc(Mid$(n$, i%, 1))
i% = i% + 1
Select Case nn%
Case 48 To 57: nn% = nn% - 48
Case 65 To 90: nn% = nn% - 55
Case Else: nn% = 0
End Select
End If
'skip illegal digits?
'IF nn% >= base1% THEN nn% = 0
t$ = tn$
bMul t$, b1$, tn$
bInc tn$, nn%
Loop
n$ = tn$
Return
'return base base2% digit or group for nn%
bbGetDigit:
If base2% > 16 Then
dig$ = LTrim$(Str$(nn%))
dig$ = String$(digmask% - Len(dig$), zero$) + dig$ + basesep$
ElseIf nn% < 10 Then
dig$ = Chr$(nn% + asc0)
Else
dig$ = Chr$(nn% + 55)
End If
Return
End Sub
'check if s$ is in some other number base and convert it to base 10.
'
Sub bBase10 (s$)
Dim numbase%
bBaseCheck s$, numbase%
If numbase% Then bBase s$, numbase%, 10
End Sub
'return number and base from a string, or 0 if no base (=base 10).
'eg 100b2 returns s$="100" and numbase%=2
'
Sub bBaseCheck (s$, numbase%)
Dim i%, n%
If bIsBase%(s$) Then
'deal with 6bb16 (=6B hex)
For i% = Len(s$) To 1 Step -1
If UCase$(Mid$(s$, i%, 1)) = basechr$ Then n% = i%: Exit For
Next i%
numbase% = Val(Mid$(s$, n% + 1))
s$ = Left$(s$, n% - 1)
Else
numbase% = False
End If
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$)
Dim 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
'clean up a number for display so .6 -> 0.6
'
Sub bCleanShow (s$)
bClean s$
If Left$(s$, 2) = "-." Then
s$ = "-0." + Mid$(s$, 3)
ElseIf Left$(s$, 1) = dp$ Then
s$ = zero$ + s$
End If
End Sub
'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$, s2$)
Dim s1flag%, s2flag%, sign1%, sign2%
Dim dp1%, dp2%, arg%
'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
'out = cos(x)
'
Sub bCos (s$, out$)
Dim t$, tfac$, fac$, z$
Dim nfac&
Dim olddigits%, flag%
' x^2 x^4 x^6
'cos(x) = 1 - --- + --- - --- + ...
' 2! 4! 6!
t$ = s$
bNormRad t$
olddigits% = digits%
digits% = digits% + 5
z$ = t$
bMul t$, z$, tfac$
bTrimDig tfac$
t$ = one$
nfac& = 2
fac$ = two$
out$ = t$
flag% = False
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
z$ = t$
bDiv z$, fac$, t$
bTrimDig t$
If bIsZero%(t$) Then Exit Do
If flag% Then
z$ = out$
bAdd z$, t$, out$
Else
z$ = out$
bSub z$, t$, out$
End If
flag% = Not flag%
fac$ = LTrim$(Str$((nfac& + 1&) * (nfac& + 2&)))
nfac& = nfac& + 2&
Loop
digits% = olddigits%
bTrimDig out$
End Sub
'out = cosh(x)
'
Sub bCosh (s$, out$)
'cosh(x) = (Exp(x) + Exp(-x)) / 2
out$ = zero$
End Sub
'out = cot(s)
'
Sub bCot (s$, out$)
Dim t$, tc$, ts$
'cot=cos/sin
t$ = s$
bNormRad t$
bSin t$, ts$
If bIsZero%(ts$) Then
out$ = Error$
Else
bCos t$, tc$
bDiv tc$, ts$, out$
End If
End Sub
'out = coth(s)
'
Sub bCoth (s$, out$)
'coth(x) = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
out$ = zero$
End Sub
'out = csc(s)
'
Sub bCsc (s$, out$)
'csc(s)=1/sin(s)
bSin s$, out$
If bIsZero%(out$) Then
out$ = Error$
Else
bInv out$
End If
End Sub
'out = csch(s)
'
Sub bCsch (s$, out$)
'csch(x) = 2 / (Exp(x) - Exp(-x))
out$ = zero$
End Sub
'return decimal part of number (or 0)
'
Sub bDec (s$)
Dim n%
n% = InStr(s$, dp$)
If n% Then s$ = Mid$(s$, n%) Else s$ = zero$
End Sub
'degrees to radians, rad=deg*pi/180
'
Sub bDegToRad (s$)
Dim t$, z$
bPi t$
z$ = t$
bDiv z$, "180", t$
z$ = s$
bMod z$, "360", s$
z$ = s$
bMul t$, z$, s$
End Sub
'out = s1 / s2
'
Sub bDiv (s1$, s2$, out$)
Dim t$
Dim slog1%, sign1%, slog2%, sign2%
Dim outlog%, outsign%, olddigits%
'strip divisor
t$ = s2$
bLogGet t$, slog2%, sign2%, True
'divide by zero?
If t$ = zero$ Then
out$ = Error$
'do powers of 10 with shifts
ElseIf t$ = one$ Then
out$ = s1$
sign1% = bSign%(out$)
If sign1% = negative Then bAbs out$
bShift out$, -slog2%
If sign1% <> sign2% Then bNeg out$
'the hard way
Else
'strip all
s2$ = t$: t$ = ""
bLogGet s1$, slog1%, sign1%, 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$, out$, t$ Else bDivChar s1$, s2$, out$, t$
'clean up
bLogPut out$, outlog%, outsign%
bLogPut s1$, slog1%, sign1%
bLogPut s2$, slog2%, sign2%
digits% = olddigits%
End If
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$, s2$, quotient$, remainder$)
Dim last1%, last2%, ldvd%, lrem%, dig%, borrow%
Dim i%, j%, n%
Dim dvd$
last1% = Len(s1$) 'length of the dividend
last2% = Len(s2$) 'length of the divisor
quotient$ = ""
remainder$ = ""
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$ = ""
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 = integer part of s1 / s2
'
Sub bDivInt (s1$, s2$, out$)
Dim t$
bDivIntMod s1$, s2$, out$, t$
End Sub
's1 / s2 = integer and remainder (s1 = s2 * q + r)
'bDivInt() and bDivMod() call this.
'
Sub bDivIntMod (s1$, s2$, quotient$, remainder$)
Dim slog1%, sign1%, slog2%, sign2%
Dim olddigits%, outlog%, outsign%
olddigits% = digits%
'strip the numbers, set flag false to NOT trim zeros, slower but needed
bLogGet s2$, slog2%, sign2%, False
If s2$ = zero$ Then quotient$ = Error$: remainder$ = Error$: Exit Sub
bLogGet s1$, slog1%, sign1%, False
'figure decimal point and sign of answer
outlog% = slog1% + bLogDp%(s2$, slog2%)
If sign1% <> sign2% Then outsign% = negative Else outsign% = positive
'a trick: figure the decimal and only find that many digits
digits% = outlog% + 1
'send the work out
If Len(s2$) <= maxlongdig Then bDivLong s1$, s2$, quotient$, remainder$ Else bDivChar s1$, s2$, quotient$, remainder$
'clean up
bLogPut s1$, slog1%, sign1%
bLogPut s2$, slog2%, sign2%
bClean quotient$
bClean remainder$
If sign1% <> sign2% Then bNeg quotient$
digits% = olddigits%
End Sub
'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$, s2$, quotient$, remainder$)
Dim rmdr&, dividend&, divisor&
Dim dig%, i%
quotient$ = ""
rmdr& = 0
divisor& = Val(s2$)
For i% = 1 To digits%
dividend& = rmdr& * 10& + Val(Mid$(s1$, i%, 1))
dig% = dividend& \ divisor&
quotient$ = quotient$ + Chr$(asc0 + dig%)
rmdr& = dividend& - dig% * divisor&
Next i%
If Len(quotient$) = 0 Then quotient$ = zero$
remainder$ = LTrim$(Str$(rmdr&))
End Sub
'Return an ellipsis... repeat just the decimal or whole string if no decimal.
'Stop at digits% length. Handy for big test numbers.
'
Sub bDot (s$, out$)
Dim t$
Dim n%
n% = InStr(s$, dp$)
If n% Then t$ = Mid$(s$, n% + 1) Else t$ = s$
out$ = s$
Do
out$ = out$ + t$
Loop Until Len(out$) >= digits%
out$ = Left$(out$, digits%)
End Sub
'out = e^s
'
Sub bExp (s$, out$)
Dim t$, fac$, z$
Dim olddigits%, eflag%
olddigits% = digits%
'if e^1, see if we already have it.
If bIsEqual%(s$, one$) Then
bMemory t$, emem, memget
If digits% <= Len(t$) - 1 Then out$ = t$: bTrimDig out$: Exit Sub
eflag% = True
End If
digits% = digits% + 5
'e^x = 1 + x + x^2/2! + x^3/3! + ...
out$ = one$
t$ = one$
fac$ = one$
Do
z$ = t$
bMul z$, s$, t$
bTrimDig t$
z$ = t$
bDiv z$, fac$, t$
bTrimDig t$
If bIsZero%(t$) Then Exit Do
z$ = out$
bAdd z$, t$, out$
bInc fac$, 1
Loop
digits% = olddigits%
bTrimDig out$
If eflag% Then bMemory out$, emem, memput
End Sub
'out = s!
'
Sub bFactorial (s$, out$)
Dim t$, mul$, z$
Dim num&, product&
Dim last%, i%
bInt s$
bAbs s$
If bIsZero%(s$) Then out$ = one$: Exit Sub '0!=1 really!
If Len(s$) <= maxlongdig Then GoSub bfLong Else GoSub bfChar
Exit Sub
bfChar:
'start the easy way to 99999999! then finish. This could take weeks!
t$ = s$
s$ = String$(maxlongdig, "9")
GoSub bfLong
bSwapString s$, t$
If out$ = abortmsg$ Then Return
Do Until t$ = s$
bInc t$, 1
z$ = out$
bMul z$, t$, out$
Loop
Return
bfLong:
'this is the long-integer multiply slightly customized
out$ = one$
For num& = 2& To CLng(Val(s$))
mul$ = out$
last% = Len(mul$)
out$ = Space$(last%)
product& = 0
For i% = last% To 1 Step -1
product& = product& + Val(Mid$(mul$, i%, 1)) * num&
Mid$(out$, i%, 1) = Chr$(asc0 + CInt(product& Mod 10&))
product& = product& \ 10&
Next i%
If product& Then out$ = LTrim$(Str$(product&)) + out$
Next num&
Return
End Sub
'out = GCD(s1,s2)
'figure Greatest Common Divisor using Euclid's Algorithm
'Byte, Jan 86, p. 397
'
Sub bGCD (s1$, s2$, out$)
Dim div$, dvd$, t$
'work with copies
div$ = s1$
dvd$ = s2$
If bIsMore%(div$, dvd$) Then bSwapString div$, dvd$
Do Until bIsZero%(div$)
bMod dvd$, div$, t$
dvd$ = div$
div$ = t$
Loop
out$ = dvd$
End Sub
's += num%
'Fast increment s$ by num% for internal use, but not quite primetime.
's$ must be positive (but decimals are ok). It's ok to use negative num%
'for decrements but if result goes negative it returns "0" with no warning.
'num% must be an integer +-32k.
'
Sub bInc (s$, num%)
Dim dig%, n%, borrow%
If num% = 0 Then Exit Sub
dig% = InStr(s$, dp$)
If dig% Then dig% = dig% - 1 Else dig% = Len(s$)
n% = num%
If n% > 0 Then 'increment (n>0)
Do While n%
If dig% < 1 Then
s$ = LTrim$(Str$(n%)) + s$
n% = 0
Else
n% = n% + Val(Mid$(s$, dig%, 1))
Mid$(s$, dig%, 1) = Chr$(asc0 + (n% Mod 10))
n% = n% \ 10
dig% = dig% - 1
End If
Loop
Else 'decrement (n<0)
n% = -n%
Do While n%
If dig% < 1 Then s$ = zero$: Exit Do
borrow% = 0
n% = Val(Mid$(s$, dig%, 1)) - n%
Do While n% < 0
n% = n% + 10: borrow% = borrow% + 1
Loop
Mid$(s$, dig%, 1) = Chr$(asc0 + n%)
n% = borrow%
dig% = dig% - 1
Loop
End If
bStripZero s$
End Sub
'Initialize b_routines, set globals, etc
'
Sub bInit ()
Dim i%
'a few defaults
'digits% = defaultdigits
errormsg$ = "error"
abortmsg$ = "abort"
'clear memory
zstack% = 0
For i% = 0 To maxmem
bmem$(i%) = zero$
Next i%
For i% = 1 To maxstack
zmem$(i%) = zero$
Next i%
'useful constants
cname$(pimem) = "pi": bmem$(pimem) = "3.14159265358979323846264338327"
cname$(pi2mem) = "2pi": bmem$(pi2mem) = "6.28318530717958647692528676654"
cname$(emem) = "e": bmem$(emem) = "2.71828182845904523536028747135"
cname$(phimem) = "phi": bmem$(phimem) = "1.61803398874989484820458683436"
cname$(ln10mem) = "ln(10)": bmem$(ln10mem) = "2.30258509299404568401799145468"
cname$(ln2mem) = "ln(2)": bmem$(ln2mem) = ".693147180559945309417232121458"
bncpath$ = "" 'path for files (or current dir if null)
prmcntfile$ = "BNPRMCNT.DAT" 'prime count table
' LoadPrimeTable
End Sub
's = int(s)
'truncate towards 0 like Basic FIX: bInt(-3.3) returns -3.
'
Sub bInt (s$)
Dim n%
n% = InStr(s$, dp$)
If n% Then
If n% = 1 Then s$ = zero$ Else s$ = Left$(s$, n% - 1)
If s$ = neg$ Or Left$(s$, 2) = "-." Then s$ = zero$
End If
End Sub
'return s1\s2 if s2 is divisor of s1, else return 0.
'
Sub bIntDiv (s1$, s2$, out$)
Dim t$
bDivIntMod s1$, s2$, out$, t$
If t$ <> zero$ Then out$ = zero$
End Sub
's = 1/s
'
Sub bInv (s$)
Dim z$
z$ = s$
bDiv one$, z$, s$
End Sub
'return false or the position of the "B" if s$ is in another number base,
'eg 123b5 and abcb16 return 4.
'
Function bIsBase% (s$)
bIsBase% = InStr(UCase$(s$), basechr$)
End Function
'return true if s1 divides s2
'
Function bIsDiv% (s1$, s2$)
Dim t$
bMod s2$, s1$, t$
bIsDiv% = (t$ = zero$)
End Function
'return true if s1 = s2
'
Function bIsEqual% (s1$, s2$)
bIsEqual% = (s1$ = s2$)
End Function
'return true if s$ is even, no decimals!
'
Function bIsEven% (s$)
bIsEven% = (Val(Right$(s$, 1)) Mod 2 = 0)
End Function
'return true if s in an integer (no decimal point).
'
Function bIsInteger% (s$)
bIsInteger% = (InStr(s$, dp$) = 0)
End Function
'return true if s1 < s2
'
Function bIsLess% (s1$, s2$)
bIsLess% = (bComp%(s1$, s2$) = -1)
End Function
'return true if s1 > s2
'
Function bIsMore% (s1$, s2$)
bIsMore% = (bComp%(s1$, s2$) = 1)
End Function
'return true if s is negative
'
Function bIsNeg% (s$)
bIsNeg% = (Left$(s$, 1) = neg$)
End Function
Function bIsNotZero% (s$)
Dim flag%, i%
flag% = False
For i% = 1 To Len(s$)
If InStr("0-. ", Mid$(s$, i%, 1)) = False Then flag% = True: Exit For
Next i%
bIsNotZero% = flag%
End Function
'return true if odd
'
Function bIsOdd% (s$)
bIsOdd% = (Val(Right$(s$, 1)) Mod 2 <> 0)
End Function
'return true if s is prime
'
Function bIsPrime% (s$)
bIsPrime% = (bPrmDiv$(s$, False) = s$)
End Function
's is pseudoprime to base b if (b,s)=1 and b^(s-1)=1 (mod s). Integers only!
'
Function bIsPseudoPrime% (s$, bas$)
Dim t$, smin$
Dim flag%
flag% = False
If bIsRelPrime%(s$, bas$) Then
smin$ = s$: bInc smin$, -1
bModPower bas$, smin$, s$, t$
flag% = (t$ = one$)
End If
bIsPseudoPrime% = flag%
End Function
'return true if s1 and s2 are relatively prime, ie share no factor
'
Function bIsRelPrime% (s1$, s2$)
Dim gcd$
bGCD s1$, s2$, gcd$
bIsRelPrime% = bIsEqual%(gcd$, one$)
End Function
'Return true if s$ is zero$ or null, s$ needn't be clean.
'
Function bIsZero% (s$)
Dim flag%, i%
flag% = True
For i% = 1 To Len(s$)
If InStr("0-. ", Mid$(s$, i%, 1)) = False Then flag% = False: Exit For
Next i%
bIsZero% = flag%
End Function
'out = LCM(s1,s2)
'figure Least Common Multiple using Euclid's Algorithm for GCD.
'LCM (a,b) = (a*b) / GCD(a,b)
'Byte, Jan 86, p. 397
'
Sub bLcm (s1$, s2$, out$)
Dim product$, gcd$
bMul s1$, s2$, product$
bGCD s1$, s2$, gcd$
bDivInt product$, gcd$, out$
End Sub
'out = ln(s), natural logarithm
'
Sub bLn (s$, out$)
Dim t$, d$, tfac$, fac$, z$, w$
Dim ln10flag%, ln2flag%, olddigits%, flag%
If Not bIsMore%(s$, zero$) Then out$ = Error$: Exit Sub
If bIsEqual%(s$, "10") Then
bMemory t$, ln10mem, memget
If digits% <= Len(t$) - 1 Then out$ = t$: bTrimDig out$: Exit Sub
ln10flag% = True
ElseIf bIsEqual%(s$, "2") Then
bMemory t$, ln2mem, memget
If digits% <= Len(t$) - 1 Then out$ = t$: bTrimDig out$: Exit Sub
ln2flag% = True
End If
olddigits% = digits%
digits% = digits% + 5
If bIsLess%(s$, "1.6") Then GoSub LnSeries2 Else GoSub LnSeries1
digits% = olddigits%
bTrimDig out$
If ln10flag% Then
bMemory out$, ln10mem, memput
ElseIf ln2flag% Then
bMemory out$, ln2mem, memput
End If
Exit Sub
' x-1 1 x-1 1 x-1
'ln(x) = 2 * [ --- + - (---)^3 + - (---)^5 + ... ] {x > 0}
' x+1 3 x+1 5 x+1
'faster for x > 1.6
LnSeries1:
t$ = s$: bInc t$, -1
d$ = s$: bInc d$, 1
bDiv t$, d$, out$
t$ = out$
z$ = t$
w$ = t$
bMul z$, w$, tfac$
bTrimDig tfac$
fac$ = three$
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
bDiv t$, fac$, d$
bTrimDig d$
If bIsZero%(d$) Then Exit Do
z$ = out$
bAdd z$, d$, out$
bInc fac$, 2
Loop
z$ = out$
bMul z$, two$, out$
Return
' 1 1
'ln(x) = (x-1) - - (x-1)^2 + - (x-1)^3 - ... {2 >= x > 0}
' 2 3
'faster for x < 1.6
LnSeries2:
bSub s$, one$, t$
tfac$ = t$
out$ = t$
fac$ = two$
flag% = False
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
bDiv t$, fac$, d$
bTrimDig d$
If bIsZero%(d$) Then Exit Do
If flag% Then
z$ = out$
bAdd z$, d$, out$
Else
z$ = out$
bSub z$, d$, out$
End If
flag% = Not flag%
bInc fac$, 1
Loop
Return
End Sub
'out = log(s1) base s2, or ln(s1) if s2=0
'
Sub bLog (s1$, s2$, out$)
Dim t$, z$
'log(s) base(n) = ln(s) / ln(n)
If bIsEqual%(s2$, "-1") Then
bExp s1$, out$
ElseIf bIsNeg%(s2$) Then
out$ = Error$
Else
bLn s1$, out$
If Not bIsZero%(s2$) Then
bLn s2$, t$
z$ = out$
bDiv z$, t$, out$
End If
End If
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$, logdp%)
bLogDp% = Len(s$) - 1 - logdp%
End Function
'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.
'
Sub bLogGet (s$, slog%, sign%, zeroflag%)
Dim dpt%, n%
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
'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$, slog%, sign%)
Dim 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
'return the largest of two integers
'
Function bMaxInt% (n1%, n2%)
If n1% >= n2% Then bMaxInt% = n1% Else bMaxInt% = n2%
End Function
'Put or Get a number string in a cell. Only 64k in PDS, much less in QB,
'beep for overflow.
'
Sub bMemory (s$, memcell%, memop%)
Dim i%
'in range?
If memcell% < 0 Or memcell% > maxmem Then Exit Sub
Select Case memop%
Case memget: s$ = bmem$(memcell%)
Case memput
'check for enough memory?
bmem$(memcell%) = s$
Case memclr: For i% = 0 To 9: bmem$(i%) = "": Next i%
End Select
End Sub
'Perform Miller test for a number and base, return true if s may be prime.
' Schneier, Applied Cryptography, p.260
' Robbins, Beginning Number Theory, p.262
'
Function bMillerTest% (s$, bas$)
Dim t$, z$, rmd$, w$, y$
Dim j%, flag%
Static lasts$, smin$, m$, k%
If bIsEven%(s$) Then bMillerTest% = False: Exit Function
'figure {k,m} so s = 2^k * m + 1. Save results for next call.
If s$ <> lasts$ Then
smin$ = s$
bInc smin$, -1
m$ = smin$
k% = 0
Do
t$ = m$
bDivIntMod t$, two$, m$, rmd$
If rmd$ = zero$ Then k% = k% + 1 Else m$ = t$: Exit Do
Loop
End If
bModPower bas$, m$, s$, z$
If z$ = one$ Or z$ = smin$ Then
flag% = True
Else
flag% = False
For j% = 1 To k% - 1
w$ = z$
y$ = z$
bMul w$, y$, z$
w$ = z$
bMod w$, s$, z$
If z$ = smin$ Then flag% = True: Exit For
Next j%
End If
bMillerTest% = flag%
End Function
'out = s1 mod s2
'remainder after division, works for non-integers, but doesn't mean much.
'
Sub bMod (s1$, s2$, out$)
Dim t$
bDivIntMod s1$, s2$, t$, out$
End Sub
'out = s1^-1 (mod s2)
'Find inverse mod a number with Extended Euclid Algorithm.
'Given a and n, find x such that a*x = 1 (mod n).
'Answer exists only if a and n are relatively prime, else return 0.
'
Sub bModInv (s1$, s2$, out$)
Dim g0$, g1$, g2$, v0$, v1$, v2$, y$, t$, z$
If Not bIsRelPrime%(s1$, s2$) Then out$ = zero$: Exit Sub
g0$ = s2$: g1$ = s1$
v0$ = zero$: v1$ = one$
Do Until bIsZero%(g1$)
bDivInt g0$, g1$, y$
bMul y$, g1$, t$
bSub g0$, t$, g2$
bMul y$, v1$, t$
bSub v0$, t$, v2$
g0$ = g1$: g1$ = g2$
v0$ = v1$: v1$ = v2$
Loop
out$ = v0$
If bIsNeg%(out$) Then
z$ = out$
bAdd z$, s2$, out$
End If
End Sub
'out = (s1 ^ s2) mod s3
'
Sub bModPower (s1$, s2$, s3$, out$)
'Use variation of "Russian Peasant Method" to figure m=(c^d) mod n.
'Byte, Jan 83, p.206.
'test value: (71611947 ^ 63196467) mod 94815109 = 776582
'm=1
'do
' if d is odd then m=(m*c) mod n
' c=(c*c) mod n
' d=int(d/2)
'loop while d>0
'm is the answer
Dim c$, d$, z$, w$
Static n$ 'remember modulus for next call
'positive numbers only, modulus must be >1! Find mod inverse if s2=-1.
out$ = errormsg$
If Len(s3$) Then n$ = s3$
If bIsNeg%(s1$) Or bIsNeg%(n$) Then Exit Sub
If bIsNeg%(s2$) Then
If bIsEqual%(s2$, "-1") Then bModInv s1$, n$, out$
Exit Sub
End If
c$ = s1$
d$ = s2$
out$ = one$
Do
If bIsOdd%(d$) Then
z$ = out$
bMul z$, c$, out$
z$ = out$
bMod z$, n$, out$
End If
z$ = c$
w$ = c$
bMul z$, w$, c$
z$ = c$
bMod z$, n$, c$
z$ = d$
bDivInt z$, two$, d$
Loop Until bIsZero%(d$)
End Sub
'out = s1 * s2
'
Sub bMul (s1$, s2$, out$)
Dim t$
Dim slog1%, sign1%, slog2%, sign2%, outdp%, outsign%, outlog%, swapflag%
'strip multiplier
t$ = s2$
bLogGet t$, slog2%, sign2%, True
'times 0
If t$ = zero$ Then
out$ = zero$
'do powers of 10 with shifts
ElseIf t$ = one$ Then
out$ = s1$
sign1% = bSign%(out$)
If sign1% = negative Then bAbs out$
bShift out$, slog2%
If sign1% <> sign2% Then bNeg out$
'the hard way
Else
'strip all
s2$ = t$: t$ = ""
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 bSwapString s1$, s2$: swapflag% = True
'do it
If Len(s2$) <= maxlongdig Then bMulLong s1$, s2$, out$ Else bMulChar s1$, s2$, out$
'clean up
outlog% = bLogDp%(out$, outdp%)
bLogPut out$, outlog%, outsign%
If swapflag% Then bSwapString s1$, s2$
bLogPut s1$, slog1%, sign1%
bLogPut s2$, slog2%, sign2%
End If
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$, s2$, out$)
Dim last1%, last2%, last%
Dim i%, j%, k%, sj%, ej%
Dim product&
last1% = Len(s1$)
last2% = Len(s2$)
last% = last1% + last2%
out$ = 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$(out$, last% - i%, 1) = Chr$(asc0 + CInt(product& Mod 10&))
product& = product& \ 10&
Next i%
If product& Then out$ = LTrim$(Str$(product&)) + out$
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$, s2$, out$)
Dim last1%, i%
Dim s2val&, product&
last1% = Len(s1$)
s2val& = Val(s2$)
out$ = Space$(last1%)
For i% = last1% To 1 Step -1
product& = product& + Val(Mid$(s1$, i%, 1)) * s2val&
Mid$(out$, i%, 1) = Chr$(asc0 + CInt(product& Mod 10&))
product& = product& \ 10&
Next i%
If product& Then out$ = LTrim$(Str$(product&)) + out$
End Sub
'out = nCr, s1 things taken s2 at a time, order doesn't matter
'
Sub bnCr (s1$, s2$, out$)
' n! nPr
'nCr = -------- = ---
' r!(n-r)! r!
'nCr = nCn-r, so pick the smaller
Dim r$, t$, z$
bSub s1$, s2$, r$
If bIsMore%(r$, s2$) Then r$ = s2$
bnPr s1$, r$, t$
If t$ = errormsg$ Then Exit Sub
z$ = r$
bFactorial z$, r$
bDivInt t$, r$, out$
End Sub
's = -s
'
Sub bNeg (s$)
If Left$(s$, 1) = neg$ Then s$ = Mid$(s$, 2) Else s$ = neg$ + s$
End Sub
'Normalize s1 to range of +-{s2}
'
Sub bNorm (s1$, s2$)
Dim t$
Dim dpt%
t$ = s1$
bAbs t$
If Not bIsLess%(t$, s2$) Then
bDiv s1$, s2$, t$
dpt% = InStr(t$, dp$)
If dpt% = 0 Then
s1$ = zero$
Else
bMul s2$, Mid$(t$, dpt%), s1$
bTrimDig s1$
If bIsNeg%(t$) Then bNeg s1$
End If
End If
End Sub
'Normalize an angle in radians to +-2pi
'
Sub bNormRad (s$)
Dim pi2$
bPi2 pi2$
bNorm s$, pi2$
End Sub
'out = nPr, s1 things taken s2 at a time, order matters
'
Sub bnPr (s1$, s2$, out$)
' n!
'nPr = ------ = (n)*(n-1)*...*(n-r+1)
' (n-r)!
Dim t$, z$
bAbs s1$
bAbs s2$
If bIsMore%(s2$, s1$) Then out$ = errormsg$: Exit Sub
If bIsZero%(s2$) Then out$ = one$: Exit Sub
bSub s1$, s2$, out$
bInc out$, 1
t$ = out$
Do Until t$ = s1$
bInc t$, 1
z$ = out$
bMul t$, z$, out$
Loop
End Sub
'out = phi (Golden Ratio)
'
Sub bPhi (out$)
Dim t$
Dim olddigits%
olddigits% = digits%
'see if it's already in memory
bMemory t$, phimem, memget
If digits% <= Len(t$) - 1 Then
out$ = t$
bTrimDig out$
Exit Sub
End If
'else calculate it. Need to write this.
out$ = t$
End Sub
'pi with Machin's formula: pi= 16 arctan(1/5) - 4 arctan(1/239)
'
Sub bPi (out$)
Dim d$, k$, t$, tfac$, atan$, atan5$, atan239$, z$
Dim olddigits%, flag%
olddigits% = digits%
'see if it's already in memory
bMemory t$, pimem, memget
If digits% <= Len(t$) - 1 Then out$ = t$: bTrimDig out$: Exit Sub
'figure a bit more and truncate to get last place right
digits% = digits% + 5
t$ = five$: GoSub bpArctan: atan5$ = atan$
t$ = "239": GoSub bpArctan: atan239$ = atan$
bMul four$, atan5$, t$
bSub t$, atan239$, out$
digits% = olddigits%
bTrimDig out$
bMemory out$, pimem, memput
Exit Sub
'Machin's series 1 1 1
' 4*arctan(1/n) = { - - ----- + ----- - ... }
' n 3*n^3 5*n^5
bpArctan:
z$ = t$
bMul z$, t$, tfac$
z$ = t$
bMul z$, four$, t$
atan$ = zero$
k$ = one$
flag% = True
Do
z$ = t$
bDiv z$, tfac$, t$
bDiv t$, k$, d$
bTrimDig d$
If bIsZero%(d$) Then Exit Do
If flag% Then
z$ = atan$
bAdd z$, d$, atan$
Else
z$ = atan$
bSub z$, d$, atan$
End If
flag% = Not flag%
bInc k$, 2
Loop
Return
End Sub
'return s=2*pi, from memory if possible
'
Sub bPi2 (s$)
Dim z$
bMemory s$, pi2mem, memget
If digits% <= Len(s$) - 1 Then
bTrimDig s$
Else
bPi s$
z$ = s$
bMul z$, two$, s$
bMemory s$, pi2mem, memput
End If
End Sub
'out = s1 ^ s2, for real s2
'
Sub bPower (s1$, s2$, out$)
Dim z$
Dim invflag%
If bIsInteger%(s2$) Then
bPowerInt s1$, s2$, out$
Else
If bIsNeg%(s2$) Then bNeg s2$: invflag% = True
bLn s1$, out$
z$ = out$
bMul z$, s2$, out$
z$ = out$
bExp z$, out$
If invflag% Then bNeg s2$: bInv out$
End If
End Sub
'out = s1 ^ s2, for integer s2 only! (It truncates s2)
'Uses variation of "Russian Peasant Method".
'
Sub bPowerInt (s1$, s2$, out$)
Dim c$, d$, z$, w$
Dim invflag%
bInt s2$
If bIsZero%(s2$) Then out$ = one$: Exit Sub
If bIsNeg%(s2$) Then bNeg s2$: invflag% = True
c$ = s1$
d$ = s2$
out$ = one$
Do
If bIsOdd%(d$) Then
z$ = out$
bMul z$, c$, out$
End If
z$ = c$
w$ = c$
bMul z$, w$, c$
z$ = d$
bDivInt z$, two$, d$
Loop Until bIsZero%(d$)
If invflag% Then
bNeg s2$
z$ = out$
bDiv one$, z$, out$
End If
End Sub
'If pflag% then count primes to s and return count else return s_th prime.
'If dspcol% then show progress on current line starting with that column.
'Will go forever if pflag% and s not prime.
'
Function bPrmCount$ (s$, dspcol%, pflag%)
Dim cnt$, num$
Dim n&
Dim i%, dinc%
'deal with exceptions up front
Select Case s$
Case "0": cnt$ = zero$: num$ = zero$
Case "1": cnt$ = zero$: num$ = two$
Case "2": cnt$ = one$: num$ = three$
Case "3": cnt$ = two$: num$ = five$
Case Else
'if no prime table then start from scratch else cue into table
If maxprmcnt% = 0 Then
i% = 0
'pflag% true: s$ is prime, count to it and return count
ElseIf pflag% Then
If bIsMore%(s$, LTrim$(Str$(prmcnt&(maxprmcnt%)))) Then
i% = maxprmcnt%
Else
n& = Val(s$)
For i% = 1 To maxprmcnt%
If prmcnt&(i%) > n& Then Exit For
Next i%
i% = i% - 1
End If
'pflag% false: s$ is the count, return that prime
Else
If bIsMore%(s$, LTrim$(Str$(maxprmcnt% * 1000&))) Then
i% = maxprmcnt%
Else
i% = Val(s$) \ 1000
End If
End If
'get start values
If i% = 0 Then
num$ = five$: cnt$ = three$
Else
num$ = LTrim$(Str$(prmcnt&(i%)))
cnt$ = LTrim$(Str$(i% * 1000&))
End If
If Val(num$) Mod 6 = 1 Then dinc% = 4 Else dinc% = 2
'finally to work
Do
If bIsPrime%(num$) Then
'IF dspcol% AND (RIGHT$(cnt$, 2) = "00") THEN PRINT "."; : IF POS(0) = 75 THEN LOCATE , dspcol%: PRINT TAB(80); : LOCATE , dspcol%
If pflag% Then
If num$ = s$ Then Exit Do
Else
If cnt$ = s$ Then Exit Do
End If
bInc cnt$, 1
End If
bInc num$, dinc%
dinc% = 6 - dinc%
Loop
End Select
If pflag% Then bPrmCount$ = cnt$ Else bPrmCount$ = num$
End Function
'Return smallest prime divisor or s$ if prime, no size limit, but slows
'down when s$>8 digits. This is strictly brute force and slow. Press <esc>
'to abort and it returns 0. If dspflag% then print (most) factors in
'lblTryNum of Factor frame, an inelegant kludge used by Factor(). A speed
'hit, but fun to watch.
'
Function bPrmDiv$ (s$, dspflag%)
Dim num$, sfac$, maxfac$, t$
Dim lfac&, lnum&, lmaxfac&, ldfac&
Dim i%, cnt%, flag%, dfac%
num$ = s$
bInt num$
bAbs num$
If Len(num$) <= maxlongdig Then GoSub bpdLong Else GoSub bpdChar
Exit Function
bpdChar:
'try some classic divisibility tests for small factors.
'Cf Gardner, Unexpected Hanging, p.160.
'by 2?
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = two$
' frmBncFactor.lblTryNum.Refresh
'End If
If Val(Right$(num$, 1)) Mod 2 = 0 Then bPrmDiv$ = two$: Return
'by 3?
'IF dspflag% THEN LOCATE , dspflag%: PRINT three$;
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = three$
' frmBncFactor.lblTryNum.Refresh
'End If
lfac& = 0
For i% = 1 To Len(num$)
lfac& = lfac& + Asc(Mid$(num$, i%, 1)) - asc0
Next i%
If lfac& Mod 3 = 0 Then bPrmDiv$ = three$: Return
'by 5?
'IF dspcol% THEN LOCATE , dspcol%: PRINT five$;
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = five$
' frmBncFactor.lblTryNum.Refresh
'End If
If Val(Right$(num$, 1)) Mod 5 = 0 Then bPrmDiv$ = five$: Return
'by 7, 11, or 13?
'IF dspcol% THEN LOCATE , dspcol%: PRINT "7+";
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = "7+"
' frmBncFactor.lblTryNum.Refresh
'End If
lfac& = 0
i% = Len(num$) + 1
cnt% = 3
flag% = True
Do
i% = i% - 3: If i% < 1 Then cnt% = i% + 2: i% = 1
If flag% Then
lfac& = lfac& + Val(Mid$(num$, i%, cnt%))
Else
lfac& = lfac& - Val(Mid$(num$, i%, cnt%))
End If
flag% = Not flag%
Loop While i% > 1
If lfac& Mod 7 = 0 Then bPrmDiv$ = "7": Return
If lfac& Mod 11 = 0 Then bPrmDiv$ = "11": Return
If lfac& Mod 13 = 0 Then bPrmDiv$ = "13": Return
'main loop, increment factor by 2 or 4.
sfac$ = "17"
dfac% = 2
bSqrInt num$, maxfac$
Do
'IF dspcol% THEN LOCATE , dspcol%: PRINT sfac$;
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = sfac$
' frmBncFactor.lblTryNum.Refresh
'End If
bMod num$, sfac$, t$
If bIsZero%(t$) Then Exit Do
bInc sfac$, dfac%
dfac% = 6 - dfac%
If bIsMore%(sfac$, maxfac$) Then sfac$ = num$: Exit Do
'If INKEY$ = esc$ Then sfac$ = zero$: Exit Do
Loop
bPrmDiv$ = sfac$
Return
bpdLong:
lnum& = Val(num$)
If lnum& <= 1 Then
lfac& = 1&
ElseIf lnum& Mod 2& = 0& Then
lfac& = 2&
ElseIf lnum& Mod 3& = 0& Then
lfac& = 3&
Else
lmaxfac& = Int(Sqr(lnum&))
lfac& = 5&
ldfac& = 2&
Do
'IF dspcol% THEN LOCATE , dspcol%: PRINT lfac&;
' If dspflag% Then
' frmBncFactor.lblTryNum.Caption = LTrim$(Str$(lfac&))
' frmBncFactor.lblTryNum.Refresh
'End If
If lnum& Mod lfac& = 0& Then Exit Do
lfac& = lfac& + ldfac&
ldfac& = 6& - ldfac&
If lfac& > lmaxfac& Then lfac& = lnum&: Exit Do
Loop
End If
bPrmDiv$ = LTrim$(Str$(lfac&))
Return
End Function
'Do Rabin-Miller Prime test times% times. If true, then probability that
's is composite is < .25^times%. Of course s$ is an odd integer.
'If dspcol% then show progress on current line starting with that column.
'
Function bPrmTest% (s$, times%, dspflag%)
Dim n$
Dim i%, flag%
If bIsEven%(s$) Then bPrmTest% = False: Exit Function
flag% = True
For i% = 2 To times% + 1
'If dspflag% Then Print ".";
n$ = LTrim$(Str$(i%))
If bIsRelPrime%(s$, n$) Then
flag% = bMillerTest%(s$, n$)
Else
flag% = False
End If
If Not flag% Then Exit For
Next i%
bPrmTest% = flag%
End Function
'radians to degrees, deg=rad*180/pi
'
Sub bRadToDeg (s$)
Dim t$, z$
bNormRad s$
bPi t$
z$ = t$
bDiv "180", z$, t$
z$ = s$
bMul t$, z$, s$
bTrimDig s$
End Sub
'Return a random number. Expects an argument of form m.n:
' m.n returns m digits+decimal+n digits
' m returns m digits
' m. m digits with random decimal point
'<null> use last mask
'
Sub bRand (s$, out$)
Static randmask$
Dim t$
Dim n%
t$ = s$
If Len(t$) = 0 Then
If Len(randmask$) = 0 Then randmask$ = "5"
t$ = randmask$
End If
randmask$ = t$
n% = InStr(t$, dp$)
If n% = 0 Then
'R3 -> abc
out$ = bRnd$(Val(t$))
ElseIf n% = 1 Then
'R.3 -> .abc
out$ = dp$ + bRnd$(Val(Mid$(t$, 2)))
ElseIf n% = Len(t$) Then
'R3. -> abc with random dp
out$ = bRnd$(Val(t$) + 1)
Mid$(out$, Int(1 + Rnd * Len(out$)), 1) = dp$
Else
'R3.2 -> abc.ef
out$ = bRnd$(Val(Mid$(t$, 1, n% - 1))) + dp$ + bRnd$(Val(Mid$(t$, n% + 1)))
End If
End Sub
'Return a random number string of places% digits.
'
Function bRnd$ (places%)
Dim t$
Dim i%
If places% = 0 Then
bRnd$ = zero$
Else
t$ = Space$(places%)
Mid$(t$, 1, 1) = Chr$(asc0 + Int(Rnd * 9) + 1)
For i% = 2 To places%
Mid$(t$, i%, 1) = Chr$(asc0 + Int(Rnd * 10))
Next i%
bRnd$ = t$
End If
End Function
'Return a random number < max$, to digits places.
'
Sub bRndNum (max$, out$)
bMul LTrim$(Str$(Rnd)), max$, out$
End Sub
'out = s2 root of s1, (or s1 ^ 1/s2)
'
Sub bRoot (s1$, s2$, out$)
Dim t$, x$, root$, mroot$, r$, newx$, z$
Dim negflag%, invflag%
'easy 0 values
If bIsZero%(s2$) Then out$ = one$: Exit Sub
If bIsZero%(s1$) Then out$ = zero$: Exit Sub
'use logs for non-integer roots
If Not bIsInteger%(s2$) Then
t$ = s2$: bInv t$
bPower s1$, t$, out$
Exit Sub
End If
x$ = s1$
root$ = s2$
If bIsNeg%(x$) Then If bIsEven%(root$) Then out$ = errormsg$: Exit Sub Else bNeg x$: negflag% = True
If bIsNeg%(root$) Then bNeg root$: invflag% = True
If root$ = two$ Then bSqr x$, out$ Else GoSub brRoot
If invflag% Then bInv out$
If negflag% Then bNeg out$
Exit Sub
'Newton-Raphson method for any integer root
brRoot:
mroot$ = root$
bInc mroot$, -1
Do
'newx = [x*(n-1) + s/x^(n-1)] / (n-1)
bMul x$, mroot$, r$
bPowerInt x$, mroot$, t$
bTrimDig t$
z$ = t$
bDiv s1$, z$, t$
bTrimDig t$
z$ = t$
bAdd r$, z$, t$
z$ = t$
bDiv z$, root$, newx$
'a bug, these are never equal
'bTrimDig x$
'bTrimDig newx$
'IF x$ = newx$ THEN EXIT DO
If Left$(x$, digits% - 1) = Left$(newx$, digits% - 1) Then Exit Do
x$ = newx$
bTrimDig x$
Loop
out$ = newx$
Return
End Sub
'Take a string in "scientific notation" and expand it.
'Recognize both 66.6e2 AND 66.6d2 as 6660 to accommadate QB.
' ^ ^
'
Sub bSci (s$)
Dim n%, xp%, sign%
s$ = UCase$(LTrim$(s$))
n% = InStr(s$, "E")
If n% = 0 Then n% = InStr(s$, "D") 'because double# use "D" not "E"
If n% Then
xp% = Val(Mid$(s$, n% + 1))
s$ = Left$(s$, n% - 1)
bLogGet s$, n%, sign%, True
bLogPut s$, n% + xp%, sign%
End If
End Sub
'out = sec(x)
'
Sub bSec (s$, out$)
'sec(x)=1/cos(x)
bCos s$, out$
If bIsZero%(out$) Then
out$ = Error$
Else
bInv out$
End If
End Sub
'out = sech(s)
'
Sub bSech (s$, out$)
'sech(x) = 2 / (Exp(x) + Exp(-x))
out$ = zero$
End Sub
'Set digits% to dig% (or return value if 0).
'
Sub bSetDigits (dig%)
If dig% = False Then dig% = digits% Else digits% = dig%
End Sub
'shift decimal n% digits (minus=left), i.e multiply/divide by 10.
'
Sub bShift (s$, n%)
Dim slog%, sign%
bLogGet s$, slog%, sign%, False
bLogPut s$, slog% + n%, sign%
End Sub
'return sign of number (-1 or +1)
'
Function bSign% (s$)
If bIsNeg%(s$) Then bSign% = negative Else bSign% = positive
End Function
'out = sin(x)
'
Sub bSin (s$, out$)
Dim t$, tfac$, fac$, z$
Dim nfac&
Dim olddigits%, flag%
' x^3 x^5 x^7
'sin(x) = x - --- + --- - --- + ...
' 3! 5! 7!
t$ = s$
bNormRad t$
olddigits% = digits%
digits% = digits% + 5
z$ = t$
bMul t$, z$, tfac$
bTrimDig tfac$
nfac& = 3
fac$ = "6"
out$ = t$
flag% = False
Do
z$ = t$
bMul z$, tfac$, t$
bTrimDig t$
z$ = t$
bDiv z$, fac$, t$
bTrimDig t$
If bIsZero%(t$) Then Exit Do
If flag% Then
z$ = out$
bAdd z$, t$, out$
Else
z$ = out$
bSub z$, t$, out$
End If
flag% = Not flag%
fac$ = LTrim$(Str$((nfac& + 1&) * (nfac& + 2&)))
nfac& = nfac& + 2&
Loop
digits% = olddigits%
bTrimDig out$
End Sub
'out = sinh(x) hyperbolic sine
'
Sub bSinh (s$, out$)
'sinh(x) = (Exp(x) - Exp(-x)) / 2
out$ = zero$
End Sub
'out = SQR(s) using the old hand method
'I learned this in high school, but I still don't understand it. It's fast.
Sub bSqr (s$, out$)
Dim dvd$, div$, dig$, newdiv$, t$, z$
Dim slog%, ssign%, slen%, spt%, olddigits%, n%, m%
If bIsNeg%(s$) Then out$ = errormsg$: Exit Sub
'strip to whole number + group digits by 2 left or right of decimal
bLogGet s$, slog%, ssign%, True
slen% = Len(s$)
If slog% Mod 2 Then spt% = 2 Else spt% = 1
'Force at least enough digits to show integer of root
olddigits% = digits%
n% = 1 + slog% \ 2
If digits% < n% Then digits% = n%
'figure first digit and setup loop
n% = Val(Left$(s$ + "0", spt%))
m% = Int(Sqr(n%))
out$ = LTrim$(Str$(m%))
dvd$ = LTrim$(Str$(n% - m% * m%))
spt% = spt% + 1
Do
'all done?
If (spt% > slen% And bIsZero%(dvd$)) Or Len(out$) >= digits% Then Exit Do
'append next 2 digits (or 0s) to dividend
dvd$ = dvd$ + Left$(Mid$(s$, spt%, 2) + "00", 2)
spt% = spt% + 2
'divisor=twice the root * 10
z$ = out$
bAdd out$, z$, div$
bShift div$, 1
'estimate divisor, and adjust if too big. Unit is next digit of root.
bDivInt dvd$, div$, dig$
Do
bAdd div$, dig$, newdiv$
bMul newdiv$, dig$, t$
If Not bIsMore%(t$, dvd$) Then Exit Do
bInc dig$, -1
Loop
out$ = out$ + dig$
'form new divisor
z$ = dvd$
bSub z$, t$, dvd$
Loop
'clean up
bLogPut s$, slog%, ssign%
If slog% < 0 Then slog% = slog% - 1
bLogPut out$, slog% \ 2, ssign%
digits% = olddigits%
End Sub
'out = INT(SQR(s)), largest integer n such that n^2 <= s
'
Sub bSqrInt (s$, out$)
Dim t$
Dim olddigits%
If bIsNeg%(s$) Then out$ = errormsg$: Exit Sub
t$ = s$
bInt t$
'a trick: let bSqr() figure the decimal and only find that many digits
olddigits% = digits%
digits% = 0
bSqr t$, out$
digits% = olddigits%
End Sub
'Return a number string. str(4.31) returns 4 "31"s, i.e. 31313131.
'Handy for big test numbers.
'
Sub bStr (s$, out$)
Dim t$
Dim n%, i%
n% = InStr(s$, ".")
If n% Then t$ = Mid$(s$, n% + 1) Else t$ = Right$(s$, 1)
out$ = ""
For i% = 1 To Val(s$)
out$ = t$ + out$
Next i%
If Len(out$) = 0 Then out$ = zero$
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$, last%, dpt%, sign%)
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
'Strip trailing 0s to "." (but leave something)
'
Sub bStripTail (s$)
Dim 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 leading 0s and final "." (but leave something)
'
Sub bStripZero (s$)
Dim 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
'out = s1 - s2
'
Sub bSub (s1$, s2$, out$)
Dim last1%, dp1%, sign1%
Dim last2%, dp2%, sign2%
Dim last%, d1%, d2%, dpt%, borrow%, swapflag%
Dim 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$, out$
bNeg s2$
Exit Sub
ElseIf sign1% = positive And sign2% = negative Then
bAdd s1$, s2$, out$
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%
out$ = Space$(last%)
borrow% = 0
'always subtract smaller from bigger to avoid complements
If bIsMore%(s2$, s1$) Then
bSwapString s1$, s2$
bSwapInt d2%, d1%
swapflag% = True
End If
'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$(out$, i%, 1) = Chr$(asc0 + n%)
Else
Mid$(out$, 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
bSwapString s1$, s2$
sign1% = -sign1%
End If
If sign1% = negative Then out$ = neg$ + out$
bClean s1$
bClean s2$
bClean out$
End Sub
Sub bSwapInt (s1%, s2%)
Dim t%
t% = s1%
s1% = s2%
s2% = t%
End Sub
Sub bSwapString (s1$, s2$)
Dim t$
t$ = s1$
s1$ = s2$
s2$ = t$
End Sub
'out = tan(s)
'
Sub bTan (s$, out$)
Dim t$, tc$, ts$
'tan=sin/cos
t$ = s$
bNormRad t$
bCos t$, tc$
If bIsZero%(tc$) Then
out$ = Error$
Else
bSin t$, ts$
bDiv ts$, tc$, out$
End If
End Sub
Sub bTanh (s$, out$)
'tanh(x) = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
out$ = zero$
End Sub
'Truncate s$ to digits% places
'
Sub bTrimDig (s$)
s$ = Left$(s$, digits% + 1)
End Sub
'Try to load table of prime counts, 66th item is the 66000th prime.
'Should be in current dircetory, but check path if not.
'
'Sub LoadPrimeTable ()
' Dim file$, path$, in$
' Dim i%, n%, m%, flag%, filenum%
' file$ = prmcntfile$
' filenum% = FreeFile
' maxprmcnt% = False
'' if table not in current dir, then check path
' If Len(Dir$(file$)) = 0 Then
' path$ = Environ$("PATH")
' flag% = True
' n% = 1
' Do While n% < Len(path$)
' m% = InStr(n%, path$, ";")
' If m% = 0 Then m% = Len(path$) + 1
' file$ = Mid$(path$, n%, m% - n%)
' If Right$(file$, 1) <> "\" Then file$ = file$ + "\"
' file$ = file$ + prmcntfile$
' If Len(Dir$(file$)) Then
' bncpath$ = Mid$(path$, n%, m% - n%) + "\"
' flag% = False
' Exit Do
' End If
' n% = m% + 1
' Loop
' If flag% Then Exit Sub
' End If
'' found it, check for signature and load data
' Open file$ For Input As #filenum%
' Line Input #filenum%, in$
' If UCase$(Left$(in$, 7)) = "'BIGNUM" Then
' Do
' Line Input #filenum%, in$
' Loop While Left$(in$, 1) = "'"
' maxprmcnt% = Val(in$)
' ReDim prmcnt&(1 To maxprmcnt%)
' For i% = 1 To maxprmcnt%
' Input #filenum%, prmcnt&(i%)
' Next i%
' End If
' Close #filenum%
'End Sub
'PUT or GET a number from the stack, or beep
'
Sub WorkStack (s$, memop%)
Dim i%
Select Case memop%
Case memget
If zstack% Then
s$ = zmem$(zstack%)
zstack% = zstack% - 1
Else
s$ = zero$ 'stack underflow
End If
Case memput
If (zstack% < maxstack) Then
zstack% = zstack% + 1
zmem$(zstack%) = s$
Else
'stack overflow
End If
Case memclr
zstack% = False
For i% = 1 To maxstack: zmem$(i%) = zero$: Next i%
End Select
End Sub