Yuck String Math or What's wrong with FOO?

[jack]

hello Pete
just tried printing the fractions you mentioned in your favorite language, FreeBasic, and the results are rounded as you mentioned
then I looked at the hexadecimal representation of the numbers and it makes sense that the numbers are rounded the way they are
for example, try printing 2/3 in single precision, you will get 0.6666667
the hex representation for 2/3 is 3F2AAAAB single precision and 3FE5555555555555 double precision
you can try it yourself with the online IEEE-754 Calculator at https://babbage.cs.qc.cuny.edu/IEEE-754/
you can enter fractions in the input box and it will be evaluated, for example 18/7 or 2/3
btw, the online calculator uses javascript to do the calculations, you can save the web page to your hard drive and use it offline.

[Pete]

My favorite language, F'Basic. :D

I need to check a few sources, like the ones you posted, and I also need to decide if I want just digits, or notation like take D-8, etc.

Well here is what I have so far, It can be used as a calculator for +-*/ of positive and negative whole numbers and decimals. It has not been well tested and I would still like to clean up some variable names.

Code: QB64: [Select]

1. DO
2.     LINE INPUT "Number: "; b$
3.     CALL stringmath(a$, operator$, b$, runningtotal$)
4.     IF runningtotal$ <> "" THEN
5.         PRINT "Pete's String Total: "; runningtotal$
6.         '''PRINT "QB64 Numeric Total:  "; LTRIM$(STR$(VAL(d2dividend$) / VAL(d1divisor$)))
7.     END IF
8.     PRINT "Operator: +-/*: ";
9.     DO
10.         operator$ = INKEY$
11.         IF LEN(operator$) THEN
12.             IF operator$ = CHR$(27) THEN SYSTEM
13.             IF INSTR("-+/*=8", operator$) THEN EXIT DO
14.         END IF
15.     LOOP
16.     IF operator$ = "=" THEN operator$ = "+"
17.     IF operator$ = "8" THEN operator$ = "*"
18.     PRINT operator$
19. LOOP
20.  
21. SUB stringmath (a$, operator$, b$, runningtotal$)
22. IF a$ = "" THEN a$ = b$: EXIT SUB
23. IF runningtotal$ <> "" THEN a$ = runningtotal$
24. SELECT CASE operator$
25.     CASE "/"
26.         operationdivision% = -1
27.         d2dividend$ = a$
28.         d1divisor$ = b$
29.         IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": END
30.         IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
31.         IF LEFT$(d2dividend$, 1) = "-" THEN
32.             IF divsign% THEN
33.                 divsign% = 0
34.             ELSE
35.                 divsign% = -1
36.             END IF
37.             d2dividend$ = MID$(d2dividend$, 2)
38.         END IF
39.         IF INSTR(d1divisor$, ".") <> 0 THEN
40.             DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
41.                 d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
42.             LOOP
43.             divplace% = LEN(d1divisor$) - INSTR(d1divisor$, ".")
44.             d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
45.             DO UNTIL LEFT$(d1divisor$, 1) <> "0"
46.                 d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
47.             LOOP
48.         END IF
49.  
50.         IF INSTR(d2dividend$, ".") <> 0 THEN
51.             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.
52.             divplace2% = INSTR(d2dividend$, ".")
53.             DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
54.                 d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
55.             LOOP
56.             d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
57.         ELSE
58.             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.
59.             divplace% = 0
60.         END IF
61.         DO
62.             DO
63.                 divremainder% = divremainder% + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder%, 1)
64.                 IF MID$(d2dividend$, divremainder%, 1) = "" THEN
65.                     IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(q$) > LEN(d2dividend$) THEN divflag% = -1: EXIT DO
66.                     divcarry = divcarry + 1
67.                     IF divcarry = 1 THEN divplace3% = divremainder% - 1 ' larger whole number divisor smaller whol number dividend.
68.                     IF divcarry > 20 + LEN(d1divisor$) THEN divflag% = -2: EXIT DO
69.                     divremainder$ = divremainder$ + "0" ' No more digits to bring down.
70.                 END IF
71.                 IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
72.                 q$ = q$ + "0"
73.             LOOP
74.             IF divflag% THEN divflag% = 0: EXIT DO
75.             FOR idiv% = 9 TO 1 STEP -1
76.                 a$ = LTRIM$(STR$(idiv%)): b$ = d1divisor$
77.                 product$ = "": GOSUB stringmultiply
78.                 tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
79.                 DO
80.                     IF LEN(tempcutd$) = 1 THEN EXIT DO
81.                     IF LEFT$(tempcutd$, 1) = "0" THEN
82.                         tempcutd$ = MID$(tempcutd$, 2)
83.                     ELSE
84.                         EXIT DO
85.                     END IF
86.                 LOOP
87.                 IF LEN(tempcutd$) > LEN(product$) OR LEN(tempcutd$) = LEN(product$) AND product$ <= tempcutd$ THEN EXIT FOR
88.             NEXT
89.             q$ = q$ + LTRIM$(STR$(idiv%))
90.             a$ = LTRIM$(STR$(idiv%)): b$ = d1divisor$
91.             product$ = "": GOSUB stringmultiply
92.             operator$ = "-": a$ = divremainder$: b$ = product$: GOSUB stringcalc: divremainder$ = a$: operator$ = "/"
93.         LOOP
94.         ' Prepare results.
95.         IF divplace% = 0 AND divplace2% = 0 THEN divplace% = divplace3%
96.         IF divplace2% THEN divplace% = divplace% + divplace2% - 1
97.         IF q$ = "" THEN divplace% = 0 ' dividend is zero.
98.         IF divplace% OR divplace2% THEN
99.             tempq$ = MID$(q$, INSTR(q$, ".") + 1)
100.             IF LEN(tempq$) >= 3 THEN
101.                 IF RIGHT$(tempq$, 3) <> STRING$(3, RIGHT$(tempq$, 1)) THEN
102.                     IF RIGHT$(q$, 1) < "5" THEN
103.                         q$ = MID$(q$, 1, LEN(q$) - 1)
104.                     ELSE
105.                         a$ = MID$(q$, 1, LEN(q$))
106.                         b$ = STRING$(LEN(a$) - 1, "0") + LTRIM$(STR$(10 - VAL(RIGHT$(q$, 1))))
107.                         operator$ = "+": GOSUB stringcalc:: operator$ = "/"
108.                         q$ = a$
109.                     END IF
110.                 END IF
111.             END IF
112.             IF divplace% < LEN(q$) OR divplace2% THEN
113.                 q$ = MID$(q$, 1, divplace%) + "." + MID$(q$, divplace% + 1)
114.             END IF
115.             DO UNTIL RIGHT$(q$, 1) <> "0"
116.                 q$ = MID$(q$, 1, LEN(q$) - 1) ' Strip off trailing zeros
117.             LOOP
118.             IF RIGHT$(q$, 1) = "." THEN q$ = MID$(q$, 1, LEN(q$) - 1) ' Strip off abandoned decimal.
119.         END IF
120.         DO UNTIL LEFT$(q$, 1) <> "0"
121.             q$ = MID$(q$, 2) ' Strip off leading zeros
122.         LOOP
123.         IF q$ = "" THEN q$ = "0": divsign% = 0
124.         IF divsign% THEN q$ = "-" + q$
125.         runningtotal$ = q$
126.         operationdivision% = 0
127.         EXIT SUB
128.  
129.     CASE "*"
130.         stringmultiply:
131.         multsumcnt% = 0: multcarry% = 0: multplace% = 0: x1$ = ""
132.         factor1$ = a$: factor2$ = b$
133.         IF LEN(b$) > LEN(a$) THEN SWAP factor1$, factor2$
134.         IF LEFT$(factor1$, 1) = "-" THEN factor1$ = MID$(factor1$, 2): multsign% = -1
135.         IF LEFT$(factor2$, 1) = "-" THEN factor2$ = MID$(factor2$, 2): IF multsign% THEN multsign% = 0 ELSE multsign% = -1
136.         IF INSTR(factor1$, ".") <> 0 THEN multplace% = LEN(factor1$) - INSTR(factor1$, "."): factor1$ = MID$(factor1$, 1, INSTR(factor1$, ".") - 1) + MID$(factor1$, INSTR(factor1$, ".") + 1)
137.         IF INSTR(factor2$, ".") <> 0 THEN multplace% = multplace% + LEN(factor2$) - INSTR(factor2$, "."): factor2$ = MID$(factor2$, 1, INSTR(factor2$, ".") - 1) + MID$(factor2$, INSTR(factor2$, ".") + 1)
138.  
139.         FOR multii% = LEN(factor2$) TO 1 STEP -1
140.             n2$ = MID$(factor2$, multii%, 1)
141.             x1$ = ""
142.             FOR multjj% = LEN(factor1$) TO 1 STEP -1
143.                 n1$ = MID$(factor1$, multjj%, 1)
144.                 multkk% = VAL(n1$) * VAL(n2$) + multcarry%
145.                 IF multkk% > 9 THEN
146.                     multcarry% = VAL(LEFT$(LTRIM$(STR$(multkk%)), 1))
147.                     multkk% = VAL(RIGHT$(LTRIM$(STR$(multkk%)), 1))
148.                 ELSE
149.                     multcarry% = 0
150.                 END IF
151.                 x1$ = LTRIM$(STR$(multkk%)) + x1$
152.             NEXT
153.             IF multcarry% THEN x1$ = LTRIM$(STR$(multcarry%)) + x1$: multcarry% = 0
154.             GOSUB multsums
155.         NEXT
156.         IF multplace% AND product$ <> "0" THEN
157.             product$ = MID$(product$, 1, LEN(product$) - multplace%) + "." + MID$(product$, LEN(product$) - multplace% + 1)
158.         END IF
159.         DO UNTIL LEFT$(product$, 1) <> "0" ' Remove leading zeros.
160.             product$ = MID$(product$, 2)
161.         LOOP
162.         IF product$ = "" THEN product$ = "0": multsign% = 0
163.         IF multsign% THEN product$ = "-" + product$
164.         IF RIGHT$(product$, 1) = "." THEN product$ = MID$(product$, 1, LEN(product$) - 1) ' Remove decimal from end of an integer total.
165.         ' Product$ is the multiplication product variable to return.
166.         IF operator$ = "/" THEN RETURN
167.         runningtotal$ = product$
168.         EXIT SUB
169.  
170.         multsums:
171.         IF product$ <> "" THEN
172.             multsumcnt% = multsumcnt% + 1
173.             x1$ = x1$ + STRING$(multsumcnt%, "0")
174.             multhh% = 0
175.             DO
176.                 IF multhh% < LEN(product$) THEN ms1$ = MID$(product$, LEN(product$) - multhh%, 1) ELSE ms1$ = ""
177.                 IF multhh% < LEN(x1$) THEN ms2$ = MID$(x1$, LEN(x1$) - multhh%, 1) ELSE ms2$ = ""
178.                 IF ms1$ = "" AND ms2$ = "" THEN EXIT DO
179.                 x1 = VAL(ms1$) + VAL(ms2$) + multcarry%
180.                 IF x1 > 9 THEN x1 = x1 - 10: multcarry% = 1 ELSE multcarry% = 0
181.                 xproduct$ = LTRIM$(STR$(x1)) + xproduct$
182.                 multhh% = multhh% + 1
183.             LOOP
184.             IF multcarry% THEN product$ = "1" + xproduct$: multcarry% = 0 ELSE product$ = xproduct$
185.             IF multplace% THEN
186.                 DO UNTIL RIGHT$(product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
187.                     product$ = MID$(product$, 1, LEN(product$) - 1)
188.                     multplace% = multplace% - 1
189.                 LOOP
190.             END IF
191.             xproduct$ = ""
192.         ELSE
193.             product$ = x1$: x1$ = ""
194.         END IF
195.         RETURN
196.  
197.     CASE "+", "-"
198.         stringcalc:
199.         IF INSTR(a$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
200.             sumplace% = LEN(a$) - INSTR(a$, ".")
201.             a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1) ' Strip out decimal
202.         END IF
203.         IF INSTR(b$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
204.             numplace% = LEN(b$) - INSTR(b$, ".")
205.             b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1) ' Strip out decimal
206.         END IF
207.         IF sumplace% > numplace% THEN addsubplace% = sumplace% ELSE addsubplace% = numplace%
208.         IF sumplace% > addsubplace% THEN
209.             a$ = a$ + STRING$(sumplace% - addsubplace%, "0")
210.         ELSEIF addsubplace% > sumplace% THEN
211.             a$ = a$ + STRING$(addsubplace% - sumplace%, "0")
212.         END IF
213.         IF numplace% > addsubplace% THEN
214.             b$ = b$ + STRING$(numplace% - addsubplace%, "0")
215.         ELSEIF addsubplace% > numplace% THEN
216.             b$ = b$ + STRING$(addsubplace% - numplace%, "0")
217.         END IF ' END Decimal evaluations........................
218.  
219.         IF LEFT$(a$, 1) = "-" THEN sign1$ = "-" ELSE sign1$ = "+"
220.         IF LEFT$(b$, 1) = "-" THEN sign2$ = "-" ELSE sign2$ = "+"
221.  
222.         addsubsign% = 0
223.         SELECT CASE sign1$ + operator$ + sign2$
224.             CASE "+++", "+--"
225.                 operator$ = "+"
226.                 IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2)
227.             CASE "++-", "+-+"
228.                 operator$ = "-"
229.                 IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2)
230.                 IF VAL(b$) > VAL(a$) THEN SWAP a$, b$: addsubsign% = -1
231.             CASE "---", "-++"
232.                 operator$ = "-"
233.                 IF LEFT$(a$, 1) = "-" THEN a$ = MID$(a$, 2)
234.                 IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2)
235.                 IF VAL(b$) > VAL(a$) THEN SWAP a$, b$ ELSE addsubsign% = -1
236.             CASE "--+", "-+-"
237.                 operator$ = "+"
238.                 IF LEFT$(a$, 1) = "-" THEN a$ = MID$(a$, 2)
239.                 IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2)
240.                 addsubsign% = -1
241.         END SELECT
242.  
243.         IF LEN(a$) > LEN(b$) THEN
244.             b$ = STRING$(LEN(a$) - LEN(b$), "0") + b$
245.         ELSEIF LEN(a$) < LEN(b$) THEN
246.             a$ = STRING$(LEN(b$) - LEN(a$), "0") + a$
247.         END IF
248.         x1$ = ""
249.  
250.         SELECT CASE operator$
251.             CASE "+", "="
252.                 FOR addsubii% = LEN(a$) TO 1 STEP -1
253.                     x1 = VAL(MID$(a$, addsubii%, 1)) + VAL(MID$(b$, addsubii%, 1)) + addsubcarry%
254.                     IF x1 > 9 THEN x1 = x1 - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
255.                     x1$ = LTRIM$(STR$(x1)) + x1$
256.                 NEXT
257.                 IF addsubcarry% THEN x1$ = "1" + x1$: addsubcarry% = 0
258.                 GOSUB replacedecimal
259.             CASE "-"
260.                 FOR addsubii% = LEN(a$) TO 1 STEP -1
261.                     x1 = VAL(MID$(a$, addsubii%, 1)) - VAL(MID$(b$, addsubii%, 1)) + addsubcarry%
262.                     IF x1 < 0 THEN x1 = x1 + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
263.                     x1$ = LTRIM$(STR$(x1)) + x1$
264.                 NEXT
265.                 IF x1$ <> "" AND x1$ <> STRING$(LEN(x1$), "0") THEN GOSUB replacedecimal
266.                 DO UNTIL LEFT$(x1$, 1) <> "0" ' Remove leading zeros.
267.                     x1$ = MID$(x1$, 2)
268.                 LOOP
269.                 IF x1$ = "" THEN
270.                     x1$ = "0": addsubsign% = 0
271.                 ELSE
272.                     IF addsubcarry% THEN x1$ = "-" + x1$: addsubcarry% = 0
273.                 END IF
274.         END SELECT
275.  
276.         IF addsubsign% THEN
277.             IF LEFT$(x1$, 1) = "-" THEN x1$ = MID$(x1$, 2) ELSE x1$ = "-" + x1$
278.         END IF
279.         a$ = x1$
280.         IF operationdivision% THEN RETURN
281.         runningtotal$ = a$
282.         EXIT SUB
283.  
284.         replacedecimal:
285.         IF addsubplace% THEN
286.             x1$ = STRING$(addsubplace% - LEN(x1$), "0") + x1$
287.             DO UNTIL RIGHT$(x1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
288.                 x1$ = MID$(x1$, 1, LEN(x1$) - 1)
289.                 addsubplace% = addsubplace% - 1
290.             LOOP
291.             IF addsubplace% > 0 THEN ' Do not replace decimal if total has become an integer amount.
292.                 x1$ = MID$(x1$, 1, LEN(x1$) - addsubplace%) + "." + MID$(x1$, LEN(x1$) - addsubplace% + 1)
293.             END IF
294.         END IF
295.         RETURN
296. END SELECT
297. END SUB

Pete

[jack]

found some links that may be of interest, bigfloat in javascript, MIT license https://github.com/charto/bigfloat and predicates in C, license in the public domain https://github.com/danshapero/predicates

[Pete]

Those are some HUGE number places. I haven't decided how to account for some displays. I mean an advantage to string math is it can go on forever, but at some point you need a better way to display the results than just a million characters OFF the screen. For now, I have it carry out 20 places past the decimal, but that can be user regulated with a variable in the future. It doesn't use D or E notation to report leading, trailing zeros yet. I may or may not add that option. In this edition, I put in an input validator.

One bug found in trailing zeros part of division. Hope to have it fixed soon and reposted.

Pete

[Pete]

Fixed on bug. I still have some rounding work to do. I'm a bit ticked that some repeating decimals like .66666 form 2 / 3 don't get rounded, while others like .5555555555555555 get rounded to .5555555555555556. Really? Anyway, I'm not quite sure what I want to do about accuracy, meaning number of digits to display. Right now, it is unlimited for integer values, and user limited by the variable divaccuracy%, which is currently set to 30 places.

Anyway, still not well tested so try it and report any bugs, but of course there is no warranty of use; so use it at your own foolish risk for anything other than just beta testing.

Oh, speaking of testing, I do have it show the numeric math for comparison, but I quickly learned because the string math is more accurate, several computations would lead to a wider discrepancy of results. To eliminate that, for each computation the numeric value is set to the string value after both are displayed.

Pete

Code: QB64: [Select]

1. divaccuracy% = 40
2. DO
3.     DO
4.         LINE INPUT "Number: "; stringmathb$
5.         origb$ = stringmathb$
6.         CALL stringmath(stringmatha$, operator$, stringmathb$, runningtotal$, divaccuracy%)
7.         IF stringmathb$ <> "invalid number" THEN EXIT DO
8.     LOOP
9.     IF runningtotal$ <> "" THEN
10.         SELECT CASE origoperator$
11.             CASE "+"
12.                 runningtotal# = VAL(origa$) + VAL(origb$)
13.             CASE "-"
14.                 runningtotal# = VAL(origa$) - VAL(origb$)
15.             CASE "*"
16.                 runningtotal# = VAL(origa$) * VAL(origb$)
17.             CASE "/"
18.                 runningtotal# = VAL(origa$) / VAL(origb$)
19.         END SELECT
20.         origa$ = LTRIM$(STR$(runningtotal#))
21.         COLOR 8, 0: PRINT "Numeric Total: "; origa$: COLOR 7, 0
22.         PRINT "String Total:  "; runningtotal$
23.         origa$ = runningtotal$ ' Allign variable total for next computation.
24.     ELSE
25.         origa$ = stringmatha$
26.     END IF
27.     COLOR 2, 0: PRINT "Operator: +-/*: ";: COLOR 7, 0
28.     DO
29.         operator$ = INKEY$
30.         IF LEN(operator$) THEN
31.             IF operator$ = CHR$(27) THEN SYSTEM
32.             IF INSTR("-+/*=8", operator$) THEN EXIT DO
33.         END IF
34.     LOOP
35.     IF operator$ = "=" THEN operator$ = "+"
36.     IF operator$ = "8" THEN operator$ = "*"
37.     PRINT operator$
38.     origoperator$ = operator$
39. LOOP
40.  
41. SUB stringmath (stringmatha$, operator$, stringmathb$, runningtotal$, divaccuracy%)
42. IF stringmatha$ = "" THEN
43.     stringmatha$ = stringmathb$
44.     GOSUB validatestringnumber
45.     IF stringmathb$ = "invalid number" THEN stringmatha$ = ""
46.     EXIT SUB
47. ELSE
48.     GOSUB validatestringnumber
49.     IF stringmathb$ = "invalid number" THEN EXIT SUB
50. END IF
51. IF runningtotal$ <> "" THEN stringmatha$ = runningtotal$
52.  
53. SELECT CASE operator$
54.     CASE "+", "-"
55.         stringcalc:
56.         IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
57.             sumplace% = LEN(stringmatha$) - INSTR(stringmatha$, ".")
58.             stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
59.         END IF
60.         IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
61.             numplace% = LEN(stringmathb$) - INSTR(stringmathb$, ".")
62.             stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
63.         END IF
64.         IF sumplace% > numplace% THEN addsubplace% = sumplace% ELSE addsubplace% = numplace%
65.         IF sumplace% > addsubplace% THEN
66.             stringmatha$ = stringmatha$ + STRING$(sumplace% - addsubplace%, "0")
67.         ELSEIF addsubplace% > sumplace% THEN
68.             stringmatha$ = stringmatha$ + STRING$(addsubplace% - sumplace%, "0")
69.         END IF
70.         IF numplace% > addsubplace% THEN
71.             stringmathb$ = stringmathb$ + STRING$(numplace% - addsubplace%, "0")
72.         ELSEIF addsubplace% > numplace% THEN
73.             stringmathb$ = stringmathb$ + STRING$(addsubplace% - numplace%, "0")
74.         END IF ' END Decimal evaluations........................
75.  
76.         IF LEFT$(stringmatha$, 1) = "-" THEN sign1$ = "-" ELSE sign1$ = "+"
77.         IF LEFT$(stringmathb$, 1) = "-" THEN sign2$ = "-" ELSE sign2$ = "+"
78.  
79.         addsubsign% = 0
80.         SELECT CASE sign1$ + operator$ + sign2$
81.             CASE "+++", "+--"
82.                 operator$ = "+"
83.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
84.             CASE "++-", "+-+"
85.                 operator$ = "-"
86.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
87.                 IF VAL(stringmathb$) > VAL(stringmatha$) THEN
88.                     SWAP stringmatha$, stringmathb$
89.                     addsubsign% = -1
90.                     SWAP origa$, origb$
91.                 END IF
92.             CASE "---", "-++"
93.                 operator$ = "-"
94.                 IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
95.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
96.                 IF VAL(stringmathb$) > VAL(stringmatha$) THEN
97.                     SWAP stringmatha$, stringmathb$
98.                     SWAP origa$, origb$
99.                 ELSE
100.                     addsubsign% = -1
101.                 END IF
102.             CASE "--+", "-+-"
103.                 operator$ = "+"
104.                 IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
105.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
106.                 addsubsign% = -1
107.         END SELECT
108.  
109.         IF LEN(stringmatha$) > LEN(stringmathb$) THEN
110.             stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
111.         ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
112.             stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
113.         END IF
114.         addsubx1$ = ""
115.  
116.         SELECT CASE operator$
117.             CASE "+", "="
118.                 FOR addsubii% = LEN(stringmatha$) TO 1 STEP -1
119.                     addsubx1% = VAL(MID$(stringmatha$, addsubii%, 1)) + VAL(MID$(stringmathb$, addsubii%, 1)) + addsubcarry%
120.                     IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
121.                     addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
122.                 NEXT
123.                 IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
124.                 GOSUB replacedecimal
125.             CASE "-"
126.                 FOR addsubii% = LEN(stringmatha$) TO 1 STEP -1
127.                     addsubx1% = VAL(MID$(stringmatha$, addsubii%, 1)) - VAL(MID$(stringmathb$, addsubii%, 1)) + addsubcarry%
128.                     IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
129.                     addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
130.                 NEXT
131.                 IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replacedecimal
132.                 DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
133.                     addsubx1$ = MID$(addsubx1$, 2)
134.                 LOOP
135.                 IF addsubx1$ = "" THEN
136.                     addsubx1$ = "0": addsubsign% = 0
137.                 ELSE
138.                     IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
139.                 END IF
140.         END SELECT
141.  
142.         IF addsubsign% THEN
143.             IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
144.         END IF
145.         stringmatha$ = addsubx1$
146.         IF operationdivision% THEN RETURN
147.         runningtotal$ = stringmatha$
148.         EXIT SUB
149.  
150.         replacedecimal:
151.         IF addsubplace% THEN
152.             addsubx1$ = STRING$(addsubplace% - LEN(addsubx1$), "0") + addsubx1$
153.             DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
154.                 addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
155.                 addsubplace% = addsubplace% - 1
156.             LOOP
157.             IF addsubplace% > 0 THEN ' Do not replace decimal if total has become an integer amount.
158.                 addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace%) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace% + 1)
159.             END IF
160.         END IF
161.         RETURN
162.  
163.     CASE "*"
164.         stringmultiply:
165.         multsumcnt% = 0: multcarry% = 0: multplace% = 0: multiconcat$ = ""
166.         factor1$ = stringmatha$: factor2$ = stringmathb$
167.         IF LEN(stringmathb$) > LEN(stringmatha$) THEN
168.             SWAP factor1$, factor2$
169.         END IF
170.         IF LEFT$(factor1$, 1) = "-" THEN factor1$ = MID$(factor1$, 2): multsign% = -1
171.         IF LEFT$(factor2$, 1) = "-" THEN factor2$ = MID$(factor2$, 2): IF multsign% THEN multsign% = 0 ELSE multsign% = -1
172.         IF INSTR(factor1$, ".") <> 0 THEN multplace% = LEN(factor1$) - INSTR(factor1$, "."): factor1$ = MID$(factor1$, 1, INSTR(factor1$, ".") - 1) + MID$(factor1$, INSTR(factor1$, ".") + 1)
173.         IF INSTR(factor2$, ".") <> 0 THEN multplace% = multplace% + LEN(factor2$) - INSTR(factor2$, "."): factor2$ = MID$(factor2$, 1, INSTR(factor2$, ".") - 1) + MID$(factor2$, INSTR(factor2$, ".") + 1)
174.  
175.         FOR multii% = LEN(factor2$) TO 1 STEP -1
176.             multii$ = MID$(factor2$, multii%, 1)
177.             multiiconcat$ = ""
178.             FOR multjj% = LEN(factor1$) TO 1 STEP -1
179.                 multkk% = VAL(MID$(factor1$, multjj%, 1)) * VAL(multii$) + multcarry%
180.                 IF multkk% > 9 THEN
181.                     multcarry% = VAL(LEFT$(LTRIM$(STR$(multkk%)), 1))
182.                     multkk% = VAL(RIGHT$(LTRIM$(STR$(multkk%)), 1))
183.                 ELSE
184.                     multcarry% = 0
185.                 END IF
186.                 multiiconcat$ = LTRIM$(STR$(multkk%)) + multiiconcat$
187.             NEXT
188.             IF multcarry% THEN multiiconcat$ = LTRIM$(STR$(multcarry%)) + multiiconcat$: multcarry% = 0
189.             GOSUB multsums
190.         NEXT
191.         IF multplace% AND product$ <> "0" THEN
192.             product$ = MID$(product$, 1, LEN(product$) - multplace%) + "." + MID$(product$, LEN(product$) - multplace% + 1)
193.         END IF
194.         DO UNTIL LEFT$(product$, 1) <> "0" ' Remove leading zeros.
195.             product$ = MID$(product$, 2)
196.         LOOP
197.         IF product$ = "" THEN product$ = "0": multsign% = 0
198.         IF multsign% THEN product$ = "-" + product$
199.         IF RIGHT$(product$, 1) = "." THEN product$ = MID$(product$, 1, LEN(product$) - 1) ' Remove decimal from the end of an integer total.
200.         IF operator$ = "/" THEN RETURN
201.         runningtotal$ = product$
202.         EXIT SUB
203.  
204.         multsums:
205.         IF product$ <> "" THEN
206.             multsumcnt% = multsumcnt% + 1
207.             multiiconcat$ = multiiconcat$ + STRING$(multsumcnt%, "0")
208.             multhh% = 0
209.             DO
210.                 IF multhh% < LEN(product$) THEN ms1$ = MID$(product$, LEN(product$) - multhh%, 1) ELSE ms1$ = ""
211.                 IF multhh% < LEN(multiiconcat$) THEN ms2$ = MID$(multiiconcat$, LEN(multiiconcat$) - multhh%, 1) ELSE ms2$ = ""
212.                 IF ms1$ = "" AND ms2$ = "" THEN EXIT DO
213.                 addsubx1% = VAL(ms1$) + VAL(ms2$) + multcarry%
214.                 IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: multcarry% = 1 ELSE multcarry% = 0
215.                 xproduct$ = LTRIM$(STR$(addsubx1%)) + xproduct$
216.                 multhh% = multhh% + 1
217.             LOOP
218.             IF multcarry% THEN product$ = "1" + xproduct$: multcarry% = 0 ELSE product$ = xproduct$
219.             IF multplace% THEN
220.                 DO UNTIL RIGHT$(product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
221.                     product$ = MID$(product$, 1, LEN(product$) - 1)
222.                     multplace% = multplace% - 1
223.                 LOOP
224.             END IF
225.             xproduct$ = ""
226.         ELSE
227.             product$ = multiiconcat$: multiiconcat$ = ""
228.         END IF
229.         RETURN
230.  
231.     CASE "/"
232.         operationdivision% = -1: quotient$ = ""
233.         d2dividend$ = stringmatha$
234.         d1divisor$ = stringmathb$
235.         IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": END
236.         IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
237.         IF LEFT$(d2dividend$, 1) = "-" THEN
238.             IF divsign% THEN
239.                 divsign% = 0
240.             ELSE
241.                 divsign% = -1
242.             END IF
243.             d2dividend$ = MID$(d2dividend$, 2)
244.         END IF
245.         IF INSTR(d1divisor$, ".") <> 0 THEN
246.             DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
247.                 d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
248.             LOOP
249.             divplace% = LEN(d1divisor$) - INSTR(d1divisor$, ".")
250.             d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
251.             DO UNTIL LEFT$(d1divisor$, 1) <> "0"
252.                 d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
253.             LOOP
254.         END IF
255.  
256.         IF INSTR(d2dividend$, ".") <> 0 THEN
257.             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.
258.             divplace2% = INSTR(d2dividend$, ".")
259.             DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
260.                 d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
261.             LOOP
262.             d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
263.         ELSE
264.             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.
265.             divplace% = 0
266.         END IF
267.         DO
268.             DO
269.                 ii = ii + 1
270.                 divremainder% = divremainder% + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder%, 1)
271.                 IF MID$(d2dividend$, divremainder%, 1) = "" THEN
272.                     IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN divflag% = -1: EXIT DO
273.                     divcarry% = divcarry% + 1
274.                     IF divcarry% = 1 THEN divplace3% = divremainder% - 1
275.                     IF divcarry% > divaccuracy% THEN divflag% = -2: EXIT DO
276.                     divremainder$ = divremainder$ + "0" ' No more digits to bring down.
277.                 END IF
278.                 IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
279.                 quotient$ = quotient$ + "0"
280.             LOOP
281.             IF divflag% THEN divflag% = 0: EXIT DO
282.             FOR idiv% = 9 TO 1 STEP -1
283.                 stringmatha$ = LTRIM$(STR$(idiv%)): stringmathb$ = d1divisor$
284.                 product$ = "": GOSUB stringmultiply
285.                 tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
286.                 DO
287.                     IF LEN(tempcutd$) = 1 THEN EXIT DO
288.                     IF LEFT$(tempcutd$, 1) = "0" THEN
289.                         tempcutd$ = MID$(tempcutd$, 2)
290.                     ELSE
291.                         EXIT DO
292.                     END IF
293.                 LOOP
294.                 IF LEN(tempcutd$) > LEN(product$) OR LEN(tempcutd$) = LEN(product$) AND product$ <= tempcutd$ THEN EXIT FOR
295.             NEXT
296.             quotient$ = quotient$ + LTRIM$(STR$(idiv%))
297.             stringmatha$ = LTRIM$(STR$(idiv%)): stringmathb$ = d1divisor$
298.             product$ = "": GOSUB stringmultiply
299.             operator$ = "-": stringmatha$ = divremainder$: stringmathb$ = product$: GOSUB stringcalc: divremainder$ = stringmatha$: operator$ = "/"
300.         LOOP
301.         IF divplace% = 0 AND divplace2% = 0 THEN divplace% = divplace3%
302.         IF divplace2% THEN divplace% = divplace% + divplace2% - 1
303.         IF quotient$ = "" THEN divplace% = 0 ' dividend is zero.
304.         IF divplace% OR divplace2% THEN
305.             tempq$ = MID$(quotient$, INSTR(quotient$, ".") + 1)
306.             IF LEN(tempq$) >= 3 THEN
307.                 IF STRING$(LEN(divremainder$), "0") = divremainder$ AND divcarry% THEN
308.                 ELSE
309.                     IF RIGHT$(tempq$, 3) <> STRING$(3, RIGHT$(tempq$, 1)) THEN
310.                         IF RIGHT$(quotient$, 1) < "5" THEN
311.                             quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1)
312.                         ELSE
313.                             stringmatha$ = MID$(quotient$, 1, LEN(quotient$))
314.                             stringmathb$ = STRING$(LEN(stringmatha$) - 1, "0") + LTRIM$(STR$(10 - VAL(RIGHT$(quotient$, 1))))
315.                             operator$ = "+": GOSUB stringcalc:: operator$ = "/"
316.                             quotient$ = stringmatha$
317.                         END IF
318.                     END IF
319.                 END IF
320.             END IF
321.             quotient$ = MID$(quotient$, 1, divplace%) + "." + MID$(quotient$, divplace% + 1, divaccuracy% + 1) ' One extra digit for rounding.
322.             DO UNTIL RIGHT$(quotient$, 1) <> "0"
323.                 quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
324.             LOOP
325.             IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
326.         END IF
327.         DO UNTIL LEFT$(quotient$, 1) <> "0"
328.             quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
329.         LOOP
330.         IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
331.         IF divsign% THEN quotient$ = "-" + quotient$
332.         runningtotal$ = quotient$
333.         operationdivision% = 0
334.         EXIT SUB
335. END SELECT
336.  
337. validatestringnumber:
338. valnum% = 0: negcnt% = 0: poscnt% = 0: nonzerospresent% = 0: zerospresent% = 0
339. IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
340. FOR vii% = 1 TO LEN(stringmathb$)
341.     validatenum$ = MID$(stringmathb$, vii%, 1)
342.     SELECT CASE validatenum$
343.         CASE "."
344.             decimalcnt% = decimalcnt% + 1
345.         CASE "+"
346.             poscnt% = vii%
347.         CASE "-"
348.             negcnt% = vii%
349.         CASE "0"
350.             zerospresent% = -1
351.         CASE "1" TO "9"
352.             nonzerospresent% = -1
353.         CASE ELSE
354.             stringmathb$ = "invalid number": RETURN
355.     END SELECT
356. NEXT
357. IF decimalcnt% > 1 OR negcnt% > 1 OR poscnt% > 1 THEN
358.     stringmathb$ = "invalid number": RETURN
359. END IF
360. IF nonzerospresent% = 0 THEN
361.     IF zerospresent% THEN
362.         stringmathb$ = "0"
363.     ELSE
364.         stringmathb$ = "invalid number"
365.     END IF
366. END IF
367. RETURN
368. END SUB

[codeguy]

Arbitrary precision factorial for QB64 posted at RosettaCode. Coded by yours truly

Code: QB64: [Select]

1.  
2. REDIM fac#(0)
3. Factorial fac#(), 655, 10, power#
4. PRINT power#
5. SUB Factorial (fac#(), n&, numdigits%, power#)
6. power# = 0
7. fac#(0) = 1
8. remain# = 0
9. stx& = 0
10. slog# = 0
11. NumDiv# = 10 ^ numdigits%
12. FOR fac# = 1 TO n&
13.     slog# = slog# + LOG(fac#) / LOG(10)
14.     FOR x& = 0 TO stx&
15.         fac#(x&) = fac#(x&) * fac# + remain#
16.         tx# = fac#(x&) MOD NumDiv#
17.         remain# = (fac#(x&) - tx#) / NumDiv#
18.         fac#(x&) = tx#
19.     NEXT
20.     IF remain# > 0 THEN
21.         stx& = UBOUND(fac#) + 1
22.         REDIM _PRESERVE fac#(stx&)
23.         fac#(stx&) = remain#
24.         remain# = 0
25.     END IF
26. NEXT
27.  
28. scanz& = LBOUND(fac#)
29. DO
30.     IF scanz& < UBOUND(fac#) THEN
31.         IF fac#(scanz&) THEN
32.             EXIT DO
33.         ELSE
34.             scanz& = scanz& + 1
35.         END IF
36.     ELSE
37.         EXIT DO
38.     END IF
39. LOOP
40.  
41. FOR x& = UBOUND(fac#) TO scanz& STEP -1
42.     m$ = LTRIM$(RTRIM$(STR$(fac#(x&))))
43.     IF x& < UBOUND(fac#) THEN
44.         WHILE LEN(m$) < numdigits%
45.             m$ = "0" + m$
46.         WEND
47.     END IF
48.     PRINT m$; " ";
49.     power# = power# + LEN(m$)
50. NEXT
51. power# = power# + (scanz& * numdigits%) - 1
52. PRINT slog#
53. END SUB
54.  

[Pete]

Well, here's something that isn't Greek to me...

Adding a way to calculate / convert to scientific notation. The variable limit% can be adjusted to the max. number of digits to be displayed. This routine is for positive numbers only. I didn't need to evaluate for negatives, because the routine I'm putting this in does that.

Code: QB64: [Select]

1. limit% = 5
2. LINE INPUT "Number: "; n$
3. IF LEFT$(n$, 1) = "-" THEN n$ = MID$(n$, 2): n2sign$ = "-"
4. ii% = INSTR(n$, ".") - 2: IF ii% = -2 THEN ii% = LEN(n$) - 1 ' No decimal.
5. n2$ = MID$(n$, 1, INSTR(n$, ".") - 1) + MID$(n$, INSTR(n$, ".") + 1)
6. IF LEFT$(n2$, 1) = "0" AND LEN(n2$) > 1 OR ii% = -1 THEN
7.     DO UNTIL LEFT$(n2$, 1) <> "0" ' Remove leading zeros to consider rounding.
8.         n2$ = MID$(n2$, 2)
9.         ii% = ii% - 1
10.     LOOP
11.     esign$ = "-"
12. ELSE
13.     esign$ = "+"
14. END IF
15. n2$ = MID$(n2$, 1, limit% + 1)
16. n% = LEN(n2$)
17. IF n% > limit% THEN
18.     IF RIGHT$(n2$, 1) > "4" THEN
19.         ' Substitute string math addition routine for line below.
20.         n2$ = LTRIM$(STR$(VAL(n2$) + 10 - VAL(RIGHT$(n2$, 1))))
21.     END IF
22. END IF
23. DO UNTIL RIGHT$(n2$, 1) <> "0" ' Remove trailing zeros.
24.     n2$ = MID$(n2$, 1, LEN(n2$) - 1)
25. LOOP
26. IF n2$ = "" THEN n2$ = "0": esign$ = "+": ii% = 1
27. n$ = n2sign$ + LEFT$(n2$, 1) + "." + MID$(n2$, 2, limit% - 1) + "e" + esign$ + LTRIM$(STR$(ABS(ii%)))
28. PRINT n$
29. RUN
30.  

Pete

[Pete]

Well, since the function posted in the Wiki by Clippy can't handle exponents over 308, I decided to make my own, but to get it working faster, I did fudge it a bit on the exponents, which are limited by passing with the VAL statement to an _INTEGER64 variable. Going much beyond that would take some pretty funky counting routine, but it could be done. So it looks like string math can go to memory capacity in decimals, but if converting back and forth in scientific notation will be limited.

Code: QB64: [Select]

1. ' Good up to exponents of 9,223,372,036,854,775,807 (Limited by _integer64 in VAL statement).
2. LINE INPUT "Number in scientific notation: "; n$
3. IF LEFT$(n$, 1) = "-" THEN n2sign$ = "-"
4. IF VAL(LEFT$(n$, 1)) = 0 AND LEFT$(n$, 1) <> "0" THEN n2$ = MID$(n$, 2, 1) + UCASE$(MID$(n$, 4)) ELSE n2$ = MID$(n$, 1, 1) + UCASE$(MID$(n$, 3)) ' Strip of + or - sign and remove decimal.
5. FOR ii% = LEN(n2$) TO 1 STEP -1
6.     ii$ = MID$(n2$, ii%, 1)
7.     iiconcat$ = ii$ + iiconcat$
8.     IF ii$ = "E" OR ii$ = "D" THEN n2$ = MID$(n2$, 1, ii% - 1): EXIT FOR
9. NEXT
10. IF VAL(MID$(iiconcat$, 2)) < LEN(n2$) - 1 THEN n2point$ = "."
11. n2zeros$ = STRING$(VAL(MID$(iiconcat$, 3)) - LEN(n2$) + 1, "0")
12. jj&& = VAL(MID$(iiconcat$, 2)) + 1
13. IF jj&& < 0 THEN
14.     lzeros$ = STRING$(ABS(jj&&), "0")
15.     jj&& = 0
16. ELSE
17.     IF jj&& > LEN(n2$) AND n2$ <> "0" THEN
18.         tzeros$ = STRING$(jj&& - LEN(n2$), "0")
19.         jj&& = LEN(n2$)
20.     END IF
21. END IF
22. PRINT n2sign$ + MID$(n2$, 1, jj&&) + n2point$ + lzeros$ + MID$(n2$, jj&& + 1) + tzeros$
23. RUN
24.  

Pete

[Pete]

So I put together a routine to validate numeric and scientific notation input, and then convert back ad forth. If there's a bug, the conversions won't match. I should be able to put together a unit checker, soon. The limit% variable limits the display to 15 digits for scientific notation. I'll work on changing some of the smaller variable names in due time.

Code: QB64: [Select]

1. limit% = 15
2. LINE INPUT "Number: "; n$
3. GOSUB validatestringnumber
4. PRINT "Validation Results: "; n$
5. PRINT "Limited to"; limit%; "digits..."
6. IF INSTR(UCASE$(n$), "D") OR INSTR(UCASE$(n$), "E") THEN
7.     GOSUB scientifictonumeric
8.     PRINT "Numeric Representation: "; n$
9.     GOSUB numerictoscientific
10.     PRINT "Scientific Notation: "; n$
11. ELSE
12.     GOSUB numerictoscientific
13.     PRINT "Scientific Notation: "; n$
14.     GOSUB scientifictonumeric
15.     PRINT "Numeric Representation: "; n$
16. END IF
17. RUN
18.  
19. numerictoscientific:
20. IF LEFT$(n$, 1) = "-" THEN n$ = MID$(n$, 2): n2sign$ = "-"
21. ii% = INSTR(n$, ".") - 2: IF ii% = -2 THEN ii% = LEN(n$) - 1 ' No decimal.
22. n2$ = MID$(n$, 1, INSTR(n$, ".") - 1) + MID$(n$, INSTR(n$, ".") + 1)
23. IF LEFT$(n2$, 1) = "0" AND LEN(n2$) > 1 OR ii% = -1 THEN
24.     DO UNTIL LEFT$(n2$, 1) <> "0" ' Remove leading zeros to consider rounding.
25.         n2$ = MID$(n2$, 2)
26.         ii% = ii% - 1
27.     LOOP
28.     esign$ = "-"
29. ELSE
30.     esign$ = "+"
31. END IF
32. n2$ = MID$(n2$, 1, limit% + 1)
33. n% = LEN(n2$)
34. IF n% > limit% THEN
35.     IF RIGHT$(n2$, 1) > "4" THEN
36.         ' Substitute string math addition routine for line below. Only good to limit% = 15 or less without string math routine.
37.         n2$ = LTRIM$(STR$(VAL(n2$) + 10 - VAL(RIGHT$(n2$, 1))))
38.     END IF
39. END IF
40. DO UNTIL RIGHT$(n2$, 1) <> "0" ' Remove trailing zeros.
41.     n2$ = MID$(n2$, 1, LEN(n2$) - 1)
42. LOOP
43. IF n2$ = "" THEN n2$ = "0": esign$ = "+": ii% = 0
44. n$ = n2sign$ + LEFT$(n2$, 1) + "." + MID$(n2$, 2, limit% - 1) + "e" + esign$ + LTRIM$(STR$(ABS(ii%)))
45. n2sign$ = "": esign$ = "": ii% = 0
46. RETURN
47.  
48. scientifictonumeric:
49. ' Good to exponents of 9,223,372,036,854,775,807 (Limited by _integer64 in VAL statement).
50. IF LEFT$(n$, 1) = "-" THEN n2sign$ = "-"
51. IF VAL(LEFT$(n$, 1)) = 0 AND LEFT$(n$, 1) <> "0" THEN n2$ = MID$(n$, 2, 1) + UCASE$(MID$(n$, 4)) ELSE n2$ = MID$(n$, 1, 1) + UCASE$(MID$(n$, 3)) ' Strip of + or - sign and remove decimal.
52. FOR ii% = LEN(n2$) TO 1 STEP -1
53.     ii$ = MID$(n2$, ii%, 1)
54.     iiconcat$ = ii$ + iiconcat$
55.     IF ii$ = "E" OR ii$ = "D" THEN n2$ = MID$(n2$, 1, ii% - 1): EXIT FOR
56. NEXT
57. IF VAL(MID$(iiconcat$, 2)) < LEN(n2$) - 1 THEN n2point$ = "."
58. n2zeros$ = STRING$(VAL(MID$(iiconcat$, 3)) - LEN(n2$) + 1, "0")
59. jj&& = VAL(MID$(iiconcat$, 2)) + 1
60. IF jj&& < 0 THEN
61.     lzeros$ = STRING$(ABS(jj&&), "0")
62.     jj&& = 0
63. ELSE
64.     IF jj&& > LEN(n2$) AND n2$ <> "0" THEN
65.         tzeros$ = STRING$(jj&& - LEN(n2$), "0")
66.         jj&& = LEN(n2$)
67.     END IF
68. END IF
69. IF LEN(n2$ + lzeros$ + tzeros$) > limit% THEN ' Rounding routine.
70.     IF RIGHT$(n2$, 1) > "4" THEN
71.         ' Substitute string math addition routine for line below. Only good to limit% = 15 or less without string math routine.
72.         n2$ = LTRIM$(STR$(VAL(n2$) + 10 - VAL(RIGHT$(n2$, 1))))
73.     END IF
74. END IF
75. n$ = MID$(n2$, 1, jj&&) + n2point$ + lzeros$ + MID$(n2$, jj&& + 1) + tzeros$ ' Required with or without rounding routine lines.
76. n$ = n2sign$ + MID$(n$, 1, limit% + LEN(n2point$)) ' For rounding purposes.
77. IF lzeros$ <> "" THEN ' Decimal fraction. Only needed when rouning routine is used.
78.     DO UNTIL RIGHT$(n$, 1) <> "0"
79.         n$ = MID$(n$, 1, LEN(n$) - 1)
80.     LOOP
81.     IF RIGHT$(n$, 1) = "." THEN n$ = MID$(n$, 1, LEN(n$) - 1)
82.     IF n$ = "" THEN n$ = "0"
83. END IF
84. RETURN
85.  
86. validatestringnumber:
87. IF INSTR(UCASE$(n$), "D") OR INSTR(UCASE$(n$), "E") THEN ' Evaluate for Scientific Notation.
88.     ' Modify n$ to a standard.
89.     jjd% = INSTR(UCASE$(n$), "D")
90.     jje% = INSTR(UCASE$(n$), "E")
91.     IF jjd% THEN jjed% = jjd% ELSE jjed% = jje% ' Get position of notation.
92.     IF INSTR(n$, ".") = 0 THEN ' Add a decimal if not present to original number.
93.         n$ = MID$(n$, 1, 1) + "." + MID$(n$, 2)
94.         jjed% = 3
95.     END IF
96.     n2$ = MID$(n$, jjed%): n$ = MID$(n$, 1, jjed% - 1) ' n$ is +- single digit whole number, decimal point and decimal number. n2$ is notation, sign and exponent.
97.     DO UNTIL RIGHT$(n$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
98.         n$ = MID$(n$, 1, LEN(n$) - 1)
99.         jjed% = jjed% - 1
100.     LOOP
101.     IF VAL(MID$(n$, 1, INSTR(n$, ".") - 1)) = 0 THEN
102.         IF RIGHT$(n$, 1) = "." THEN
103.             n$ = "0.e+0" ' Handles all types of zero entries.
104.         ELSE
105.             n$ = "invalid number"
106.         END IF
107.         RETURN
108.     END IF
109.     n$ = n$ + n2$
110.     IF MID$(n$, jjed% + 1, 1) <> "-" THEN
111.         IF MID$(n$, jjed% + 1, 1) <> "+" THEN
112.             n$ = MID$(n$, 1, jjed%) + "+" + MID$(n$, jjed% + 1) ' Add a + sign.
113.         END IF
114.     END IF
115.     n2$ = MID$(n$, 1, jjed% - 1) ' Vailidate the number portion.
116.     IF LEFT$(n2$, 1) = "-" THEN n2$ = MID$(n2$, 2) ' Strip off any leading - sign.
117.     IF LEFT$(n2$, 1) = "+" THEN n2$ = MID$(n2$, 2): n$ = MID$(n$, 2) ' Strip off any leading + sign.
118.     IF MID$(n2$, 2, 1) <> "." THEN n$ = "invalid number": RETURN
119.     FOR ii% = 1 TO LEN(n2$)
120.         IF MID$(n2$, ii%, 1) <> "." THEN
121.             IF VAL(MID$(n2$, ii%, 1)) = 0 AND MID$(n2$, ii%, 1) <> "0" THEN n$ = "invalid number": RETURN
122.         END IF
123.     NEXT
124.     IF n2$ = "" THEN n$ = "invalid number": RETURN
125.     n2$ = MID$(n$, jjed% + 2) ' Validate exponent. Allows -0 exponent as in: 0.e-0
126.     IF n2$ = "" THEN n$ = "invalid number": RETURN ' Example: 1.3d
127.     IF MID$(n2$, 1, 1) = "0" AND LEN(n2$) > 1 THEN n$ = "invalid number": RETURN ' Example 1.3d+01
128.     FOR ii% = 1 TO LEN(n2$)
129.         IF VAL(MID$(n2$, ii%, 1)) = 0 AND MID$(n2$, ii%, 1) <> "0" THEN n$ = "invalid number": RETURN
130.     NEXT
131.     RETURN
132. ELSE
133.     ' Evaluate standard number.
134.     valnum% = 0: negcnt% = 0: poscnt% = 0: nonzerospresent% = 0: zerospresent% = 0
135.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
136.     FOR vii% = 1 TO LEN(stringmathb$)
137.         validatenum$ = MID$(stringmathb$, vii%, 1)
138.         SELECT CASE validatenum$
139.             CASE "."
140.                 decimalcnt% = decimalcnt% + 1
141.             CASE "+"
142.                 poscnt% = vii%
143.             CASE "-"
144.                 negcnt% = vii%
145.             CASE "0"
146.                 zerospresent% = -1
147.             CASE "1" TO "9"
148.                 nonzerospresent% = -1
149.             CASE ELSE
150.                 stringmathb$ = "invalid number": RETURN
151.         END SELECT
152.     NEXT
153.     IF decimalcnt% > 1 OR negcnt% > 1 OR poscnt% > 1 THEN
154.         stringmathb$ = "invalid number": RETURN
155.     END IF
156.     IF nonzerospresent% = 0 THEN
157.         IF zerospresent% THEN
158.             stringmathb$ = "0"
159.         ELSE
160.             stringmathb$ = "invalid number"
161.         END IF
162.     END IF
163. END IF
164. RETURN
165.  

Pete

[codeguy]

Bad news: old hp laptop died. Good news: replaced with i7. Haven't contributed in a while but I hope others have stolen my code. Yes, it's not flashy, but I I'm glad if anyone has been able to use it.

[Jack002]

In reference to your 18/7 discussion:
1/7 is the repeating decimal 0.142857142857142857
Its a repeating pattern that goes on forever... type 142857, then do it again and again. Not unlike 1/3 is 0.33333333333

This thread is fascinating to me. These long string numbers can make some interesting patterns
Try 1/97 for as many possible digits you can. There are some neat patterns in some decimal fraction equivalants

[bplus]

In reference to your 18/7 discussion:
1/7 is the repeating decimal 0.142857142857142857
Its a repeating pattern that goes on forever... type 142857, then do it again and again. Not unlike 1/3 is 0.33333333333

This thread is fascinating to me. These long string numbers can make some interesting patterns
Try 1/97 for as many possible digits you can. There are some neat patterns in some decimal fraction equivalants

If you convert the decimal to base 2, use a white rectangle for 1 and a black rectangle for 0 (or vice versa), so that you get a sort of bar code for the base 2 number.

Then stack all the bar codes from 1/n to (n-1)/n, I am pretty sure you will be astounded how fraction patterns that can be reduced to lower terms have same pattern as in the lower n stack for instance 3/15 = 1/5 and both have the same bar code pattern.
  [ You are not allowed to view this attachment ]  

Also notice how the stack is symmetric about n/2, black is mirror image of white, and how the pattern changes with each increase of 1 in numerator.

[Jack002]

Very interesting. I can see the  1/n relationship to (n-1)/n. They are opposites, so XOR of each other. I doubt patterns seen in numbers like 1/7 will look too interesting in base 2.

I've never seen a program do things like this. Very cool

[bplus]

Here is some old code that captures the exact part that repeats:

Code: QB64: [Select]

1. _TITLE "Decimal Expansion of Division without Dividing  by bplus 2017-12-03"
2. ' dove tailing Adrians and my recent dividing programs
3.  
4. RANDOMIZE TIMER
5. DEFLNG A-Z
6. WHILE 1
7.     PRINT: PRINT "Enter 2 integers < 3200, numerator / denominator, 0's quit, don't forget / "
8.     INPUT nd$
9.     slash = INSTR(nd$, "/")
10.     IF slash THEN
11.         dvsr = VAL(MID$(nd$, slash + 1))
12.         IF dvsr = 0 THEN PRINT "Divisor is 0, bye.": END
13.         numerator = VAL(MID$(nd$, 1, slash - 1))
14.         IF numerator = 0 THEN PRINT "Numerator is 0, bye.": END
15.     ELSE
16.         PRINT "No slash found, bye.": END
17.     END IF
18.     PRINT numerator; " / "; dvsr; " = "; divide$(numerator, dvsr)
19. WEND
20.  
21. FUNCTION divide$ (n, d)
22.     'n = original product or numerator (preserve value of n)
23.     'd = divisor  (also preserve value)
24.     c = n 'copy of n to be reduced until <= d, c will be the remainder part of division
25.     a = 0 'a is for answer or accumulate, the integer part of the division result
26.  
27.     'find lowest power of 10 such that: d * 10^p > n
28.     p = 0 'power of 10
29.     WHILE d * (10 ^ p) < n
30.         p = p + 1
31.     WEND
32.     WHILE c >= d
33.         IF c = d THEN a = a + 1: c = 0: EXIT WHILE
34.         p = p - 1
35.         IF p >= 0 THEN
36.             m = 0
37.             WHILE d * m * 10 ^ p < c
38.                 m = m + 1
39.             WEND
40.             m = m - 1
41.             c = c - d * m * 10 ^ p
42.             a = a + m * 10 ^ p
43.         END IF
44.     WEND
45.  
46.     'Now for the decimal expansion isolating the repeating part if one
47.     IF c <> 0 THEN
48.         DIM b(d)
49.         b$ = "."
50.         WHILE c <> 0
51.  
52.             'emergency bug out!
53.             loopct = loopct + 1 'loop count should not exceed 1000 for numbers I am testing
54.             IF loopct > 1000 THEN PRINT "Error: loop too long, bugging out! ": GOTO skip
55.  
56.             'track repeats  b() tracks been here once, b2() tracks been here twice
57.             IF b(c) = 1 THEN 'been here!
58.                 IF rFlag = 1 THEN 'been here twice!
59.                     IF b2(c) = 1 THEN EXIT WHILE 'strike 3, we're out of here
60.                     b2(c) = 1
61.                 ELSE
62.                     rFlag = 1
63.                     DIM b2(d)
64.                     b$ = b$ + " repeat "
65.                     b2(c) = 1
66.                 END IF
67.             ELSE
68.                 b(c) = 1
69.             END IF
70.  
71.             'c was last remainder, mult by 10 and see if some m * d > can reduce it
72.             tc = 10 * c
73.             flag = 0
74.             FOR m = 0 TO 9
75.                 IF ((tc - m * d) >= 0) AND ((tc - (m + 1) * d) < 0) THEN
76.                     flag = 1: b$ = b$ + LTRIM$(STR$(m))
77.                     EXIT FOR
78.                 END IF
79.             NEXT
80.             IF flag = 0 THEN b$ = b$ + "0": m = 0
81.             c = tc - d * m
82.         WEND
83.     END IF
84.  
85.     'OK either d divided n eventually or there is a repeated pattern recorded in b$
86.     skip: '< needed for debugging
87.     r$ = STR$(a)
88.     IF b$ <> "" THEN r$ = r$ + b$
89.     divide$ = r$
90. END FUNCTION
91.  
92.  

The longest patterns usually come from biggest prime number denominators.

1 digit repeating pattern series 1/15, 1/30, 1/60, 1/120, 1/240,... alternate 3... and 6...
also with 1/3, 1/6, 1/12, 1/24, ...

[Jack002]

Very cool, bplus. I like the large prime number recips. 1/97 was there as I remember. This is great. Thanks.