e to 100 decimal places

[B+]

Just worked up some String math functions in QB64 and wanted to see how they work in JB.

So why not test with e to 100 decimal places?

' e estimating with mr$() String math functions  b+ 2020-08-19 trans from QB64
' All the weird stuff you see in here is QB64 difference with JB like Trimming Str$ conversions.
' JB doesn't need add$(), subtr$(), nor mult$() for positive integers,
' still does need mr$() function for handling signs and decimals.

' e = 1 + 1/1 + 1/(2*1) + 1/(3*2*1) +...  1/n! Euler's Formula

' REF: https://www.mathsisfun.com/numbers/e-eulers-number.html
e100$ = "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274"
'print len(e100$) 'yeah 102 = 2. + 100 decimal places

' note: to watch the action without having to use the horizontal scroll bar,
' Setup > Preferences > Main Window Columns to 125 or more

' note: All new terms are positive so e estimate grows to the right in decimal places.
' When it exceeds the target 100 digit estimate of e the difference will become negative.
' This will be our signal we've hit out target.

' I added a fail safe so that the terms won't excced 100 whether we hit the target or not.
'
eEst$ = "1" : termFac$ = "1"
while left$(diff$, 1) <> "-" and term < 100 ' the diff of target minus estimate remains positive
   term = term + 1
   print "Term: ";term
   termFac$ = mr$(termFac$, "*", str$(term)) 'calc factorial
   print "Term Factorial: ";termFac$
   termExp$ = mr$("1", "/", termFac$) ' calc the inverse, oh heck I could have use nInverse$() oh well.
   print "Term Expression: "; termExp$
   eEst$ = mr$(eEst$, "+", termExp$)
   print "  e 100 Target: ";e100$
   print "    e Estimate: ";left$(eEst$, 103)
   diff$ = mr$(e100$, "-", eEst$)
   if left$(diff$, 1) <> "-" then
   print " Diff e Target:  "; left$(diff$, 102)
   else
   print " Diff e Target: "; left$(diff$, 103)
   end if
   print
   if term < 10 then
   input "Press enter to continue..."; w$
   end if
   print
wend
Print "101 decimal places: ";left$(eEst$, 103)
print "eEstimate >= e 100 digit target."

FUNCTION mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
   op$ = TRIM$(op$) 'save fixing each time
   ca$ = TRIM$(a$): cb$ = _TRIM$(b$) 'make copies in case we change
   'strip signs and decimals
   IF LEFT$(ca$, 1) = "-" THEN
       aSgn$ = "-": ca$ = MID$(ca$, 2)
   ELSE
       aSgn$ = "": ca$ = ca$
   END IF
   dp = INSTR(ca$, ".")
   IF dp > 0 THEN
       adp = LEN(ca$) - dp
       ca$ = MID$(ca$, 1, dp - 1) + MID$(ca$, dp + 1)
   ELSE
       adp = 0
   END IF
   IF LEFT$(cb$, 1) = "-" THEN
       bSgn$ = "-": cb$ = MID$(cb$, 2)
   ELSE
       bSgn$ = "": cb$ = cb$
   END IF
   dp = INSTR(cb$, ".")
   IF dp > 0 THEN
       bdp = LEN(cb$) - dp
       cb$ = MID$(cb$, 1, dp - 1) + MID$(cb$, dp + 1)
   ELSE
       bdp = 0
   END IF

   IF op$ = "+" OR op$ = "-" OR op$ = "/" THEN 'add or subtr  even up strings on right of decimal
       'even up the right sides of decimals if any
       IF adp > bdp THEN dp = adp ELSE dp = bdp
       IF adp < dp THEN ca$ = ca$ + STRING$(dp - adp, "0")
       IF bdp < dp THEN cb$ = cb$ + STRING$(dp - bdp, "0")
   ELSE
       IF op$ = "*" THEN dp = adp + bdp
   END IF
   IF op$ = "*" OR op$ = "/" THEN
       IF aSgn$ = bSgn$ THEN SGN$ = "" ELSE SGN$ = "-"
   END IF
   'now according to signs and op$ call add$ or subtr$
   IF op$ = "+" THEN
       IF aSgn$ = bSgn$ THEN 'really add
           postOp$ = aSgn$ + add$(ca$, cb$)
       ELSE 'have a case of subtraction
           IF aSgn$ = "-" THEN postOp$ = subtr$(cb$, ca$) ELSE postOp$ = subtr$(ca$, cb$)
       END IF
   END IF
   IF op$ = "-" THEN
       IF bSgn$ = "-" THEN 'really add but switch b sign
           bSgn$ = ""
           IF aSgn$ = "-" THEN
               postOp$ = subtr$(cb$, ca$)
           ELSE 'aSgn = ""
               postOp$ = add$(ca$, cb$)
           END IF
       ELSE 'bSgn$ =""
           IF aSgn$ = "-" THEN
               bSgn$ = "-"
               postOp$ = aSgn$ + add$(ca$, cb$)
           ELSE
               postOp$ = subtr$(ca$, cb$)
           END IF
       END IF
   END IF
   IF op$ = "*" THEN
       postOp$ = SGN$ + mult$(ca$, cb$)
   END IF
   IF op$ = "/" THEN
       postOp$ = SGN$ + divide$(ca$, cb$)
   END IF ' which op
   'put dp back
   IF op$ <> "/" THEN
       lpop = LEN(postOp$) ' put decimal back
       postOp$ = MID$(postOp$, 1, lpop - dp) + "." + MID$(postOp$, lpop - dp + 1)
   END IF
   mr$ = trim0$(postOp$)
END FUNCTION

FUNCTION divide$ (n$, d$)
   'DIM di$, ndi$, nD AS INTEGER
   IF trim0$(n$) = "0" THEN divide$ = "0": EXIT FUNCTION
   IF trim0$(d$) = "0" THEN divide$ = "div 0": EXIT FUNCTION
   IF trim0$(d$) = "1" THEN divide$ = trim0$(n$): EXIT FUNCTION '8/17 add trim0$
   di$ = MID$(nInverse$(d$, 200), 2) 'chop off decimal point after
   nD = LEN(di$)
   ndi$ = mult$(n$, di$)
   ndi$ = MID$(ndi$, 1, LEN(ndi$) - nD) + "." + RIGHT$(STRING$(nD, "0") + RIGHT$(ndi$, nD), nD)
   divide$ = trim0$(ndi$)
END FUNCTION

FUNCTION nInverse$ (n$, DP) 'assume decimal at very start of the string of digits returned, no rounding
   DIM m$(9)   ', si$, r$, outstr$, d$
   'DIM i AS INTEGER
   FOR i = 1 TO 9
       si$ = TRIM$(STR$(i))
       m$(i) = mult$(si$, n$)
   NEXT
   outstr$ = ""
   IF n$ = "0" THEN nInverse$ = "Div 0": EXIT FUNCTION
   IF n$ = "1" THEN nInverse$ = "1": EXIT FUNCTION
   outstr$ = "." 'everything else n > 1 is decimal 8/17
   r$ = "10"
   while 1
       WHILE LEFT$(subtr$(r$, n$), 1) = "-" '   r - n < 0
           outstr$ = outstr$ + "0" '            add 0 to the  output string
           IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION 'check if we've reached DP length
           r$ = r$ + "0"
       WEND
       FOR i = 9 TO 1 STEP -1
           IF LTE(m$(i), r$) THEN d$ = TRIM$(STR$(i)): EXIT FOR
       NEXT
       outstr$ = outstr$ + d$
       IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION
       r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
       IF r$ = "0" THEN nInverse$ = outstr$: EXIT FUNCTION 'found a perfect divisor
       r$ = r$ + "0" 'add another place
   wend
END FUNCTION

FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
   'DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, dp AS INTEGER
   'DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
   'DIM f18$, f1$, t$, build$, accum$

   IF trim0$(a$) = "0" THEN mult$ = "0": EXIT FUNCTION
   IF trim0$(b$) = "0" THEN mult$ = "0": EXIT FUNCTION
   IF trim0$(a$) = "1" THEN mult$ = trim0$(b$): EXIT FUNCTION
   IF trim0$(b$) = "1" THEN mult$ = trim0$(a$): EXIT FUNCTION
   'find the longer number and make it a mult of 18 to take 18 digits at a time from it
   la = LEN(a$): lb = LEN(b$)
   IF la > lb THEN
       m = INT(la / 18) + 1
       f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
       f1$ = b$
   ELSE
       m = INT(lb / 18) + 1
       f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
       f1$ = a$
   END IF
   FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
       build$ = "" 'line builder
       co = 0
       'now taking 18 digits at a time Thanks Steve McNeill
       FOR g = 1 TO m
           v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
           sd = VAL(MID$(f1$, dp, 1))
           t$ = RIGHT$(STRING$(19, "0") + TRIM$(STR$(v18 * sd + co)), 19)
           co = VAL(MID$(t$, 1, 1))
           build$ = MID$(t$, 2) + build$
       NEXT g
       IF co THEN build$ = TRIM$(STR$(co)) + build$
       IF dp = LEN(f1$) THEN
           accum$ = build$
       ELSE
           accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
       END IF
   NEXT dp
   mult$ = accum$
END FUNCTION

FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
   'DIM m AS INTEGER, g AS INTEGER, p AS INTEGER
   'DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
   'DIM ts$, tm$, sign$, LG$, sm$, t$, result$

   ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
   IF trim0$(ts$) = trim0$(tm$) THEN subtr$ = "0": EXIT FUNCTION 'OK proceed with function knowing they are not equal
   tenE18 = 1000000000000000000 'yes!!! no dang E's
   IF LTE(ts$, tm$) THEN ' which is bigger? minus is bigger
       sign$ = "-"
       m = INT(LEN(tm$) / 18) + 1
       LG$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
       sm$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
   ELSE 'sum is bigger
       sign$ = ""
       m = INT(LEN(ts$) / 18) + 1
       LG$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
       sm$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
   END IF
   'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
   FOR g = 1 TO m
       VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
       vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
       IF vs > VB THEN
           t$ = RIGHT$(STRING$(18, "0") + TRIM$(STR$(tenE18 - vs + VB)), 18)
           p = (m - g) * 18
           WHILE p > 0 AND MID$(LG$, p, 1) = "0"
               'MID$(LG$, p, 1) = "9"
               LG$ = Replace$(LG$, p, "9")
               p = p - 1
           WEND
           'IF p > 0 THEN MID$(LG$, p, 1) = TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
           IF p > 0 THEN LG$ = Replace$(LG$, p, STR$(VAL(MID$(LG$, p, 1)) - 1))
       ELSE
           t$ = RIGHT$(STRING$(18, "0") + TRIM$(STR$(VB - vs)), 18)
       END IF
       result$ = t$ + result$
   NEXT
   subtr$ = sign$ + result$
END FUNCTION

FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
   'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
   'DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER
   'DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
   'DIM fa$, fb$, t$, new$, result$
   la = LEN(a$): lb = LEN(b$)
   IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
   fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
   fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)

   'now taking 18 digits at a time Thanks Steve McNeill
   FOR g = 1 TO m
       sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
       sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
       t$ = RIGHT$(STRING$(36, "0") + TRIM$(STR$(sa + sb + co)), 36)
       co = VAL(MID$(t$, 1, 18))
       new$ = MID$(t$, 19)
       result$ = new$ + result$
   NEXT
   IF co THEN result$ = STR$(co) + result$
   add$ = result$
END FUNCTION

' String Math Helpers -----------------------------------------------

'this function needs TrimLead0$(s$)
FUNCTION LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
   'DIM ca$, cb$, la AS INTEGER, lb AS INTEGER, i AS INTEGER
   ca$ = TrimLead0$(a$): cb$ = TrimLead0$(b$)
   la = LEN(ca$): lb = LEN(cb$)
   IF ca$ = cb$ THEN
       LTE = -1
   ELSE
       IF la < lb THEN ' a is smaller
           LTE = -1
       ELSE
           IF la > lb THEN ' a is bigger
               LTE = 0
           ELSE
                   FOR i = 1 TO LEN(ca$)
                       IF VAL(MID$(ca$, i, 1)) > VAL(MID$(cb$, i, 1)) THEN
                           LTE = 0: EXIT FUNCTION
                       ELSE
                           IF VAL(MID$(ca$, i, 1)) < VAL(MID$(cb$, i, 1)) THEN
                               LTE = -1: EXIT FUNCTION
                           end if
                       END IF
                   NEXT
           END IF
       end if
   end if
END FUNCTION

' ------------------------------------- use these for final display

FUNCTION TrimLead0$ (s$) 'for treating strings as number (pos integers)
   'DIM copys$, i AS INTEGER, find AS INTEGER
   copys$ = TRIM$(s$) 'might as well remove spaces too
   i = 1: find = 0
   WHILE i < LEN(copys$) AND MID$(copys$, i, 1) = "0"
       i = i + 1: find = 1
   WEND
   IF find = 1 THEN copys$ = MID$(copys$, i)
   IF copys$ = "" THEN TrimLead0$ = "0" ELSE TrimLead0$ = copys$
END FUNCTION

FUNCTION TrimTail0$ (s$)
   'DIM copys$, dp AS INTEGER, i AS INTEGER, find AS INTEGER
   copys$ = TRIM$(s$) 'might as well remove spaces too
   TrimTail0$ = copys$
   dp = INSTR(copys$, ".")
   IF dp > 0 THEN
       i = LEN(copys$): find = 0
       WHILE i > dp AND MID$(copys$, i, 1) = "0"
           i = i - 1: find = 1
       WEND
       IF find = 1 THEN
           IF i = dp THEN
               TrimTail0$ = MID$(copys$, 1, dp - 1)
           ELSE
               TrimTail0$ = MID$(copys$, 1, i)
           END IF
       END IF
   END IF
END FUNCTION

FUNCTION trim0$ (s$)
   'DIM cs$, si$
   cs$ = s$
   si$ = LEFT$(cs$, 1)
   IF si$ = "-" THEN cs$ = MID$(cs$, 2)
   cs$ = TrimLead0$(cs$)
   cs$ = TrimTail0$(cs$)
   IF RIGHT$(cs$, 1) = "." THEN cs$ = MID$(cs$, 1, LEN(cs$) - 1)
   IF si$ = "-" THEN trim0$ = si$ + cs$ ELSE trim0$ = cs$
END FUNCTION

Function STRING$(n, char$) 'QB64 function JB doesn't have
   for i = 1 to n
       STRING$ = STRING$ + char$
   next
End Function

Function Replace$(s$, place, char$) ' this replaces the SUB version of MID$
   Replace$ = Mid$(s$, 1, place - 1) + char$ + Mid$(s$, place + 1)
end function




Last 2 term calculations Output:

Term: 69
Term Factorial: 171122452428141311372468338881272839092270544893520369393648040923257279754140647424000000000000000
Term Expression: .0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000058437685166996162718792864418450717344173768835453889352846862995115768448262713836925785552082312547
e 100 Target: 2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274
e Estimate: 2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642734
Diff e Target: .00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005


Term: 70
Term Factorial: 11978571669969891796072783721689098736458938142546425857555362864628009582789845319680000000000000000
Term Expression: .0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000834824073814230895982755205977867390631053840506484133612098042787368120689467340527511222172604464
e 100 Target: 2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274
e Estimate: 2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742
Diff e Target: -.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002


101 decimal places: 2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742
eEstimate >= e 100 digit target.

So now, what are we going to do with all these digits? ;-))

[B+]

I found this at LB, it works a tiny bit faster ;-))


'ref :https://libertybasiccom.proboards.com/thread/1233/rc-calculating-value
' tsh posted this at LB forum puts my 100 digit calculation to shame!
' study this technique!!! 2020-08-19

'spigot algorithm
print "Exact (off the net)"
print "e=2.7182818284590452353602874713526624977572470936999..."
print "Calculated"
print "e=2.";
N=102

dim a(N+1)
a(0)=2
for i = 1 to N+1
   a(i)=1
next

for k = 1 to N-1
   for i = 1 to N+1
       a(i)=a(i)*10
   next

   for i = N+1 to 1 step -1
       d=int(a(i)/(i+1))
       r = a(i) mod (i+1)
       a(i)=r
       a(i-1)=a(i-1)+d

   next
   print d;

next



Nice one tsh73!