« previous next »
Pages: [1]   Go Down

Author Topic: Working on a comma system for string math routine...  (Read 4440 times)

0 Members and 1 Guest are viewing this topic.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Working on a comma system for string math routine...
« on: March 27, 2019, 11:40:11 am »
I think this routine should be able to handle comma entries and if I create a variable, my string math routine should be able to return results with or without commas present, as well as accept and convert entries made with commas.

Please note, only use numbers, one or no decimal point, and commas. I have a completely separate validation routine that handles other types off erroneous entries, which I hope to add this routine to, if it's solid.

Code: QB64: [Select]
  1. LINE INPUT "Number: "; b$
  3.     PRINT
  4.     IF INSTR(b$, ",") THEN PRINT "1) Vaildate commas": x$ = x$ + "1"
  5.     IF INSTR(b$, ",") = 0 THEN PRINT "2) Add commas": x$ = x$ + "2"
  6.     IF INSTR(b$, ",") THEN PRINT "3) Remove commas": x$ = x$ + "3"
  7.     PRINT "4) New number": x$ = x$ + "4"
  8.     PRINT
  9.     DO
  10.         _LIMIT 10
  11.         k$ = INKEY$
  12.         IF k$ = CHR$(27) THEN SYSTEM
  13.         IF LEN(k$) AND INSTR(x$, k$) <> 0 THEN
  14.             SELECT CASE k$
  15.                 CASE "1"
  16.                     GOSUB comma_validation
  17.                     IF b$ = "invalid number" THEN PRINT: RUN
  18.                 CASE "2"
  19.                     GOSUB comma_placement
  20.                 CASE "3"
  21.                     GOSUB comma_removal
  22.                 CASE "4"
  23.                     RUN
  24.             END SELECT
  25.             x$ = ""
  26.             EXIT DO
  27.         END IF
  28.     LOOP
  30.  
  31. ' Add in commas.
  32. comma_placement:
  33. GOSUB comma_prep
  34. FOR i& = LEN(b2$) TO 1 STEP -1
  35.     j% = j% + 1
  36.     IF j% = 4 THEN b$ = "," + b$: j% = 1
  37.     b$ = MID$(b2$, i&, 1) + b$
  39. b$ = b$ + b3$: b3$ = "": b2$ = "": i& = 0
  42.  
  43. ' Validate comma entry.
  44. comma_validation:
  45. GOSUB comma_prep
  46. IF INSTR(b3$, ",") <> 0 OR b2$ = STRING$(LEN(b2$), ",") THEN
  47.     b$ = "invalid number"
  49.     FOR i& = LEN(b2$) TO 1 STEP -1
  50.         j% = j% + 1
  51.         IF j% = 4 THEN
  52.             IF MID$(b2$, i&, 1) <> "," THEN b$ = "invalid number": EXIT FOR
  53.             j% = 0
  54.         END IF
  55.     NEXT
  56.     IF b$ <> "invalid number" THEN
  57.         b$ = b2$ + b3$
  58.     END IF
  60. b3$ = "": b2$ = "": i& = 0
  63.  
  64. comma_removal:
  65. DO UNTIL INSTR(b$, ",") = 0
  66.     b$ = MID$(b$, 1, INSTR(b$, ",") - 1) + MID$(b$, INSTR(b$, ",") + 1)
  70.  
  71. comma_prep:
  72. b2$ = b$: b$ = "": j% = 0
  73. IF INSTR(b2$, ".") THEN
  74.     b3$ = MID$(b2$, INSTR(b2$, "."))
  75.     b2$ = MID$(b2$, 1, INSTR(b2$, ".") - 1)
  78.  

If anyone wants to give it a quick try and see if he can find an inaccurate result, please do so and let me know.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #1 on: March 27, 2019, 01:03:50 pm »
Quote
If anyone wants to give it a quick try and see if he can find an inaccurate result, please do so and let me know.

Pete

I like these dares to try and break code. ;-))

OK tried 000000000000000.0000000 and put commas in right place if first 0 was digit but...
« Last Edit: March 27, 2019, 01:08:37 pm by bplus »
Logged

Offline Dimster

  • Forum Resident
  • Posts: 500
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #2 on: March 27, 2019, 02:37:02 pm »
Worked perfectly for me Pete. And ya, a negative number does throw it off, so I gather a dollar sign etc would as well.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #3 on: March 30, 2019, 01:33:22 pm »
Thanks Mark and Dimster for trying it out. Sorry for the late reply, but I wanted to get to the weekend to spend some more time on adding some other features. If you are up to trying it one more time, this enhanced version should stomp out any invalid entries for numeric or scientific notation input. It also converts between scientific notation, standard numeric notation, and dollars and cents notation.

Please let me know if you can break the code!

Pete

Code: QB64: [Select]
  1. LINE INPUT "Number: "; stringmathb$
  2. GOSUB validate_string_number
  3. PRINT "Validated: "; stringmathb$
  4. IF stringmathb$ = "invalid number" THEN RUN
  6.     PRINT
  7.     IF INSTR(stringmathb$, ",") = 0 THEN PRINT "1) Add Commas": x$ = x$ + "1"
  8.     IF INSTR(stringmathb$, ",") THEN PRINT "2) Remove Commas": x$ = x$ + "2"
  9.     IF INSTR(stringmathb$, "$") = 0 THEN PRINT "3) Convert to Dollars and Cents": x$ = x$ + "3"
  10.     IF INSTR(stringmathb$, "$") THEN PRINT "4) Convert to Numeric": x$ = x$ + "4"
  11.     IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN
  12.         PRINT "5) Convert to Numeric": x$ = x$ + "5"
  13.     ELSE
  14.         PRINT "6) Convert to S.N.": x$ = x$ + "6"
  15.     END IF
  16.     PRINT "7) New number": x$ = x$ + "7"
  17.     PRINT
  18.     DO
  19.         _LIMIT 10
  20.         k$ = INKEY$
  21.         IF k$ = CHR$(27) THEN SYSTEM
  22.         IF LEN(k$) AND INSTR(x$, k$) <> 0 THEN
  23.             SELECT CASE k$
  24.                 CASE "1"
  25.                     GOSUB comma_placement
  26.                 CASE "2"
  27.                     GOSUB comma_removal
  28.                 CASE "3"
  29.                     GOSUB currency_convert
  30.                 CASE "4"
  31.                     GOSUB validate_string_number
  32.                 CASE "5"
  33.                     IF INSTR(stringmathb$, "$") THEN GOSUB validate_string_number
  34.                     GOSUB scientific_to_numeric
  35.                 CASE "6"
  36.                     IF INSTR(stringmathb$, "$") THEN GOSUB validate_string_number
  37.                     GOSUB numeric_to_scientific
  38.                 CASE "7"
  39.                     RUN
  40.             END SELECT
  41.             PRINT stringmathb$
  42.             x$ = ""
  43.             IF stringmathb$ = "invalid number" THEN RUN
  44.             EXIT DO
  45.         END IF
  46.     LOOP
  48.  
  49. validate_string_number:
  50. vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
  51. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
  52. IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": RETURN
  53. IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
  54.     FOR sm_i& = 1 TO LEN(stringmathb$)
  55.         validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
  56.         SELECT CASE validatenum$
  57.             CASE "+"
  58.                 IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  59.             CASE "-"
  60.                 IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  61.             CASE "0" TO "9"
  62.                 vsn_numberpresent& = -1
  63.             CASE "D", "E"
  64.                 vsn_depresent& = vsn_depresent& + 1
  65.                 IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
  66.                 vsn_numberpresent& = 0
  67.                 MID$(stringmathb$, sm_i&, 1) = "e" ' Standardize
  68.             CASE "."
  69.                 decimalcnt& = decimalcnt& + 1
  70.                 IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
  71.             CASE ELSE
  72.                 vsn_numberpresent& = 0: EXIT FOR
  73.         END SELECT
  74.     NEXT
  75.     IF decimalcnt& = 0 THEN stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
  76.     IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": RETURN
  77.     vsn_depresent& = INSTR(stringmathb$, "e")
  78.     sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
  79.     IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
  80.     IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
  81.         IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": RETURN ' No leading zeros allowed in exponent notation.
  82.     END IF
  83.     jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
  84.     valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
  85.     stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
  86.     DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
  87.         stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  88.     LOOP
  89.     IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
  90.         IF RIGHT$(stringmathb$, 1) = "." THEN
  91.             stringmathb$ = "0.e+0" ' Handles all types of zero entries.
  92.         ELSE
  93.             stringmathb$ = "invalid number": RETURN
  94.         END IF
  95.         RETURN
  96.     END IF
  97.     stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
  98.     RETURN
  100.     FOR sm_i& = 1 TO LEN(stringmathb$)
  101.         validatenum$ = MID$(stringmathb$, sm_i&, 1)
  102.         SELECT CASE validatenum$
  103.             CASE "."
  104.                 decimalcnt& = decimalcnt& + 1
  105.             CASE "0"
  106.                 vsn_zerospresent& = -1
  107.             CASE "1" TO "9"
  108.                 vsn_numberpresent& = -1
  109.             CASE "$"
  110.             CASE ELSE
  111.                 stringmathb$ = "invalid number": RETURN
  112.         END SELECT
  113.     NEXT
  114.     IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
  115.         stringmathb$ = "invalid number": RETURN
  116.     END IF
  117.     IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
  118.     IF INSTR(stringmathb$, ",") THEN
  119.         GOSUB comma_validation
  120.         IF stringmathb$ = "invalid number" THEN RETURN
  121.         GOSUB comma_removal
  122.     END IF
  123.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  124.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
  125.         stringmathb$ = MID$(stringmathb$, 2)
  126.     LOOP
  127.     stringmathb$ = sm_sign$ + stringmathb$
  128.     IF INSTR(stringmathb$, ".") THEN
  129.         DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
  130.             stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  131.         LOOP
  132.     END IF
  133.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  134.     IF vsn_numberpresent& = 0 THEN
  135.         IF vsn_zerospresent& THEN
  136.             stringmathb$ = "0"
  137.         ELSE
  138.             stringmathb$ = "invalid number"
  139.         END IF
  140.     END IF
  143.  
  144. ' Add in commas.
  145. comma_placement:
  146. GOSUB comma_prep
  147. FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
  148.     sm_j% = sm_j% + 1
  149.     IF sm_j% = 4 THEN stringmathb$ = "," + stringmathb$: sm_j% = 1
  150.     stringmathb$ = MID$(temp_stringmathb1$, sm_i&, 1) + stringmathb$
  152. stringmathb$ = sm_sign$ + stringmathb$ + temp_stringmathb2$
  153. temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0
  155.  
  156. ' Validate comma entry.
  157. comma_validation:
  158. GOSUB comma_prep
  159. IF INSTR(temp_stringmathb2$, ",") <> 0 OR temp_stringmathb1$ = STRING$(LEN(temp_stringmathb1$), ",") THEN
  160.     stringmathb$ = "invalid number" ' Decimal part has comma or entry is all commas.
  162.     FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
  163.         sm_j% = sm_j% + 1
  164.         IF sm_j% = 4 THEN
  165.             IF MID$(temp_stringmathb1$, sm_i&, 1) <> "," THEN stringmathb$ = "invalid number": EXIT FOR
  166.             sm_j% = 0
  167.         END IF
  168.     NEXT
  169.     IF stringmathb$ <> "invalid number" THEN
  170.         stringmathb$ = sm_sign$ + temp_stringmathb1$ + temp_stringmathb2$
  171.     END IF
  173. temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0: sm_sign$ = "": sm_dollar$ = ""
  175.  
  176. comma_removal:
  177. DO UNTIL INSTR(stringmathb$, ",") = 0
  178.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ",") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ",") + 1)
  181.  
  182. comma_prep:
  183. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-"
  184. temp_stringmathb1$ = stringmathb$: stringmathb$ = ""
  185. IF INSTR(temp_stringmathb1$, ".") THEN
  186.     temp_stringmathb2$ = MID$(temp_stringmathb1$, INSTR(temp_stringmathb1$, ".")) ' Decimal part
  187.     temp_stringmathb1$ = MID$(temp_stringmathb1$, 1, INSTR(temp_stringmathb1$, ".") - 1) ' Non-decimal part
  189. IF LEFT$(temp_stringmathb1$, 1) = "$" THEN temp_stringmathb1$ = MID$(temp_stringmathb1$, 2): sm_dollar$ = "$"
  191.  
  192. currency_validate:
  193. IF LEFT$(stringmathb$, 2) = "$-" OR LEFT$(stringmathb$, 2) = "$+" THEN stringmathb$ = "invalid number": RETURN
  194. IF LEFT$(stringmathb$, 1) = "$" THEN stringmathb$ = MID$(stringmathb$, 2)
  195. IF INSTR(stringmathb$, "$") THEN stringmathb$ = "invalid number": RETURN
  196. sm_dollar$ = "$"
  198.  
  199. currency_convert:
  200. IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN GOSUB scientific_to_numeric
  201. IF INSTR(stringmathb$, ",") = 0 THEN GOSUB comma_placement
  202. IF INSTR(stringmathb$, ".") = 0 THEN stringmathb$ = stringmathb$ + ".00"
  203. IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = stringmathb$ + "00"
  204. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = stringmathb$ + "0"
  205. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = "invalid number": RETURN
  206. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  207. stringmathb$ = sm_sign$ + "$" + stringmathb$
  209.  
  210. numeric_to_scientific:
  211. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): n2sign$ = "-"
  212. IF INSTR(stringmathb$, ".") = 0 THEN exponentvalue&& = LEN(stringmathb$) - 1 ELSE exponentvalue&& = INSTR(stringmathb$, ".") - 2 ' Exponent is one less than number of digits for whole number an two less than the placement of the decimal point for a fraction.
  213. stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1)
  214. IF LEFT$(stringmathb$, 1) = "0" AND LEN(stringmathb$) > 1 OR exponentvalue&& = -1 THEN
  215.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Remove leading zeros to consider rounding.
  216.         stringmathb$ = MID$(stringmathb$, 2)
  217.         exponentvalue&& = exponentvalue&& - 1
  218.     LOOP
  219.     esign$ = "-"
  221.     esign$ = "+"
  223. DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove trailing zeros.
  224.     stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  226. IF stringmathb$ = "" THEN stringmathb$ = "0": esign$ = "+": exponentvalue&& = 0
  227. stringmathb$ = LEFT$(stringmathb$, 1) + "." + MID$(stringmathb$, 2)
  228. IF stringmathb$ = "0." THEN n2sign$ = "": esign$ = "+"
  229. stringmathb$ = stringmathb$ + "e" + esign$ + LTRIM$(STR$(ABS(exponentvalue&&))) ' S.N formed here.
  230. IF stringmathb$ <> "overflow" THEN
  231.     stringmathb$ = n2sign$ + stringmathb$
  233. n2sign$ = "": esign$ = "": exponentvalue&& = 0
  235.  
  236. scientific_to_numeric:
  237. IF INSTR(UCASE$(stringmathb$), "D") THEN MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "D"), 1) = "e"
  238. IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 2) = "0" THEN ' The numeric value is the number without the zero exponent.
  239.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, "e") - 1)
  240.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  241.     RETURN
  243.     IF LEFT$(stringmathb$, 1) = "-" THEN stn_sign$ = "-": stringmathb$ = MID$(stringmathb$, 2)
  244.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Remove decimal point.
  245.     stn_i& = INSTR(stringmathb$, "e") - 1 ' Length of the numric part.
  246.     IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 1, 1) = "-" THEN
  247.         stringmathb$ = "." + STRING$(VAL(MID$(stringmathb$, stn_i& + 3)) - 1, "0") + MID$(stringmathb$, 1, stn_i&) ' Decimal point followed by exponent value in zeros added in front of numeric part.
  248.     ELSE
  249.         IF stn_i& - 1 > VAL(MID$(stringmathb$, stn_i& + 3)) THEN stn_point$ = "." ' - 1 for decimal place. Ex 2.034d+2 is 2034 here where 3 places to the right . could be moved before . disappears. > so no trailing decimal results.
  250.         stringmathb$ = MID$(MID$(stringmathb$, 1, stn_i&), 1, VAL(MID$(stringmathb$, stn_i& + 3)) + 1) + stn_point$ + MID$(MID$(stringmathb$, 1, stn_i&), VAL(MID$(stringmathb$, stn_i& + 3)) + 2, stn_i& - VAL(MID$(stringmathb$, stn_i& + 3)) - 1) + STRING$(VAL(MID$(stringmathb$, stn_i& + 2)) - (stn_i& - 1), "0")
  251.     END IF
  253. IF stringmathb$ = "0" THEN stn_sign$ = ""
  254. stringmathb$ = stn_sign$ + stringmathb$
  255. stn_sign$ = "": stn_point$ = ""
  257.  
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #4 on: March 30, 2019, 05:48:19 pm »
So for sci-num: e (or d) goes right next to digit and only 1 digit must be left of decimal to be valid, correct?
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #5 on: March 30, 2019, 06:14:44 pm »
It tries to convert to a standard, so...

1d5 or 1.d5 or 1.0d5 or 1d+5 or 1.d+5 or 1.0d+5 or even 1.000d5 0r 1.000d+5 would all be automatically converted to: 1.e+5

I use e instead of E, D, or d but you can input any of them, and the routine will (should) adjust it to the standard shown above.

Pete



Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #6 on: March 31, 2019, 07:13:51 am »
yours choked on a megabyte of digits modified thusly: even on 65536. Mine took .00390625s for a 3-digit separation between commas. Yours takes over 150 times as long.
Code: QB64: [Select]
  1. DEFLNG A-Z
  2. m& = 1048576
  3. stringmathb$ = SPACE$(m&)
  4. FOR i& = 0 TO m& - 1
  5.     MID$(stringmathb$, i& + 1, 1) = CHR$(ASC("0") + RND * (ASC("9") - ASC("0")) AND 255)
  7. GOSUB validate_string_number
  8. PRINT "Validated: "; stringmathb$
  9. IF stringmathb$ = "invalid number" THEN RUN
  11.     PRINT
  12.     IF INSTR(stringmathb$, ",") = 0 THEN PRINT "1) Add Commas": x$ = x$ + "1"
  13.     IF INSTR(stringmathb$, ",") THEN PRINT "2) Remove Commas": x$ = x$ + "2"
  14.     IF INSTR(stringmathb$, "$") = 0 THEN PRINT "3) Convert to Dollars and Cents": x$ = x$ + "3"
  15.     IF INSTR(stringmathb$, "$") THEN PRINT "4) Convert to Numeric": x$ = x$ + "4"
  16.     IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN
  17.         PRINT "5) Convert to Numeric": x$ = x$ + "5"
  18.     ELSE
  19.         PRINT "6) Convert to S.N.": x$ = x$ + "6"
  20.     END IF
  21.     PRINT "7) New number": x$ = x$ + "7"
  22.     PRINT
  23.     DO
  24.         _LIMIT 10
  25.         k$ = INKEY$
  26.         IF k$ = CHR$(27) THEN SYSTEM
  27.         IF LEN(k$) AND INSTR(x$, k$) <> 0 THEN
  28.             SELECT CASE k$
  29.                 CASE "1"
  30.                     s! = TIMER(.001)
  31.                     GOSUB comma_placement
  32.                     CLS
  33.                     f! = TIMER(.001)
  34.                     PRINT f! - s!
  35.                     _DELAY 1
  36.                 CASE "2"
  37.                     GOSUB comma_removal
  38.                 CASE "3"
  39.                     GOSUB currency_convert
  40.                 CASE "4"
  41.                     GOSUB validate_string_number
  42.                 CASE "5"
  43.                     IF INSTR(stringmathb$, "$") THEN GOSUB validate_string_number
  44.                     GOSUB scientific_to_numeric
  45.                 CASE "6"
  46.                     IF INSTR(stringmathb$, "$") THEN GOSUB validate_string_number
  47.                     GOSUB numeric_to_scientific
  48.                 CASE "7"
  49.                     RUN
  50.             END SELECT
  51.             PRINT stringmathb$
  52.             x$ = ""
  53.             IF stringmathb$ = "invalid number" THEN RUN
  54.             EXIT DO
  55.         END IF
  56.     LOOP
  58.  
  59. validate_string_number:
  60. vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
  61. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
  62. IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": RETURN
  63. IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
  64.     FOR sm_i& = 1 TO LEN(stringmathb$)
  65.         validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
  66.         SELECT CASE validatenum$
  67.             CASE "+"
  68.                 IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  69.             CASE "-"
  70.                 IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  71.             CASE "0" TO "9"
  72.                 vsn_numberpresent& = -1
  73.             CASE "D", "E"
  74.                 vsn_depresent& = vsn_depresent& + 1
  75.                 IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
  76.                 vsn_numberpresent& = 0
  77.                 MID$(stringmathb$, sm_i&, 1) = "e" ' Standardize
  78.             CASE "."
  79.                 decimalcnt& = decimalcnt& + 1
  80.                 IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
  81.             CASE ELSE
  82.                 vsn_numberpresent& = 0: EXIT FOR
  83.         END SELECT
  84.     NEXT
  85.     IF decimalcnt& = 0 THEN stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
  86.     IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": RETURN
  87.     vsn_depresent& = INSTR(stringmathb$, "e")
  88.     sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
  89.     IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
  90.     IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
  91.         IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": RETURN ' No leading zeros allowed in exponent notation.
  92.     END IF
  93.     jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
  94.     valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
  95.     stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
  96.     DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
  97.         stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  98.     LOOP
  99.     IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
  100.         IF RIGHT$(stringmathb$, 1) = "." THEN
  101.             stringmathb$ = "0.e+0" ' Handles all types of zero entries.
  102.         ELSE
  103.             stringmathb$ = "invalid number": RETURN
  104.         END IF
  105.         RETURN
  106.     END IF
  107.     stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
  108.     RETURN
  110.     FOR sm_i& = 1 TO LEN(stringmathb$)
  111.         validatenum$ = MID$(stringmathb$, sm_i&, 1)
  112.         SELECT CASE validatenum$
  113.             CASE "."
  114.                 decimalcnt& = decimalcnt& + 1
  115.             CASE "0"
  116.                 vsn_zerospresent& = -1
  117.             CASE "1" TO "9"
  118.                 vsn_numberpresent& = -1
  119.             CASE "$"
  120.             CASE ELSE
  121.                 stringmathb$ = "invalid number": RETURN
  122.         END SELECT
  123.     NEXT
  124.     IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
  125.         stringmathb$ = "invalid number": RETURN
  126.     END IF
  127.     IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
  128.     IF INSTR(stringmathb$, ",") THEN
  129.         GOSUB comma_validation
  130.         IF stringmathb$ = "invalid number" THEN RETURN
  131.         GOSUB comma_removal
  132.     END IF
  133.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  134.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
  135.         stringmathb$ = MID$(stringmathb$, 2)
  136.     LOOP
  137.     stringmathb$ = sm_sign$ + stringmathb$
  138.     IF INSTR(stringmathb$, ".") THEN
  139.         DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
  140.             stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  141.         LOOP
  142.     END IF
  143.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  144.     IF vsn_numberpresent& = 0 THEN
  145.         IF vsn_zerospresent& THEN
  146.             stringmathb$ = "0"
  147.         ELSE
  148.             stringmathb$ = "invalid number"
  149.         END IF
  150.     END IF
  153.  
  154. ' Add in commas.
  155. comma_placement:
  156. GOSUB comma_prep
  157. FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
  158.     sm_j% = sm_j% + 1
  159.     IF sm_j% = 4 THEN stringmathb$ = "," + stringmathb$: sm_j% = 1
  160.     stringmathb$ = MID$(temp_stringmathb1$, sm_i&, 1) + stringmathb$
  162. stringmathb$ = sm_sign$ + stringmathb$ + temp_stringmathb2$
  163. temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0
  165.  
  166. ' Validate comma entry.
  167. comma_validation:
  168. GOSUB comma_prep
  169. IF INSTR(temp_stringmathb2$, ",") <> 0 OR temp_stringmathb1$ = STRING$(LEN(temp_stringmathb1$), ",") THEN
  170.     stringmathb$ = "invalid number" ' Decimal part has comma or entry is all commas.
  172.     FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
  173.         sm_j% = sm_j% + 1
  174.         IF sm_j% = 4 THEN
  175.             IF MID$(temp_stringmathb1$, sm_i&, 1) <> "," THEN stringmathb$ = "invalid number": EXIT FOR
  176.             sm_j% = 0
  177.         END IF
  178.     NEXT
  179.     IF stringmathb$ <> "invalid number" THEN
  180.         stringmathb$ = sm_sign$ + temp_stringmathb1$ + temp_stringmathb2$
  181.     END IF
  183. temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0: sm_sign$ = "": sm_dollar$ = ""
  185.  
  186. comma_removal:
  187. DO UNTIL INSTR(stringmathb$, ",") = 0
  188.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ",") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ",") + 1)
  191.  
  192. comma_prep:
  193. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-"
  194. temp_stringmathb1$ = stringmathb$: stringmathb$ = ""
  195. IF INSTR(temp_stringmathb1$, ".") THEN
  196.     temp_stringmathb2$ = MID$(temp_stringmathb1$, INSTR(temp_stringmathb1$, ".")) ' Decimal part
  197.     temp_stringmathb1$ = MID$(temp_stringmathb1$, 1, INSTR(temp_stringmathb1$, ".") - 1) ' Non-decimal part
  199. IF LEFT$(temp_stringmathb1$, 1) = "$" THEN temp_stringmathb1$ = MID$(temp_stringmathb1$, 2): sm_dollar$ = "$"
  201.  
  202. currency_validate:
  203. IF LEFT$(stringmathb$, 2) = "$-" OR LEFT$(stringmathb$, 2) = "$+" THEN stringmathb$ = "invalid number": RETURN
  204. IF LEFT$(stringmathb$, 1) = "$" THEN stringmathb$ = MID$(stringmathb$, 2)
  205. IF INSTR(stringmathb$, "$") THEN stringmathb$ = "invalid number": RETURN
  206. sm_dollar$ = "$"
  208.  
  209. currency_convert:
  210. IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN GOSUB scientific_to_numeric
  211. IF INSTR(stringmathb$, ",") = 0 THEN GOSUB comma_placement
  212. IF INSTR(stringmathb$, ".") = 0 THEN stringmathb$ = stringmathb$ + ".00"
  213. IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = stringmathb$ + "00"
  214. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = stringmathb$ + "0"
  215. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = "invalid number": RETURN
  216. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  217. stringmathb$ = sm_sign$ + "$" + stringmathb$
  219.  
  220. numeric_to_scientific:
  221. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): n2sign$ = "-"
  222. IF INSTR(stringmathb$, ".") = 0 THEN exponentvalue&& = LEN(stringmathb$) - 1 ELSE exponentvalue&& = INSTR(stringmathb$, ".") - 2 ' Exponent is one less than number of digits for whole number an two less than the placement of the decimal point for a fraction.
  223. stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1)
  224. IF LEFT$(stringmathb$, 1) = "0" AND LEN(stringmathb$) > 1 OR exponentvalue&& = -1 THEN
  225.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Remove leading zeros to consider rounding.
  226.         stringmathb$ = MID$(stringmathb$, 2)
  227.         exponentvalue&& = exponentvalue&& - 1
  228.     LOOP
  229.     esign$ = "-"
  231.     esign$ = "+"
  233. DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove trailing zeros.
  234.     stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  236. IF stringmathb$ = "" THEN stringmathb$ = "0": esign$ = "+": exponentvalue&& = 0
  237. stringmathb$ = LEFT$(stringmathb$, 1) + "." + MID$(stringmathb$, 2)
  238. IF stringmathb$ = "0." THEN n2sign$ = "": esign$ = "+"
  239. stringmathb$ = stringmathb$ + "e" + esign$ + LTRIM$(STR$(ABS(exponentvalue&&))) ' S.N formed here.
  240. IF stringmathb$ <> "overflow" THEN
  241.     stringmathb$ = n2sign$ + stringmathb$
  243. n2sign$ = "": esign$ = "": exponentvalue&& = 0
  245.  
  246. scientific_to_numeric:
  247. IF INSTR(UCASE$(stringmathb$), "D") THEN MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "D"), 1) = "e"
  248. IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 2) = "0" THEN ' The numeric value is the number without the zero exponent.
  249.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, "e") - 1)
  250.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  251.     RETURN
  253.     IF LEFT$(stringmathb$, 1) = "-" THEN stn_sign$ = "-": stringmathb$ = MID$(stringmathb$, 2)
  254.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Remove decimal point.
  255.     stn_i& = INSTR(stringmathb$, "e") - 1 ' Length of the numric part.
  256.     IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 1, 1) = "-" THEN
  257.         stringmathb$ = "." + STRING$(VAL(MID$(stringmathb$, stn_i& + 3)) - 1, "0") + MID$(stringmathb$, 1, stn_i&) ' Decimal point followed by exponent value in zeros added in front of numeric part.
  258.     ELSE
  259.         IF stn_i& - 1 > VAL(MID$(stringmathb$, stn_i& + 3)) THEN stn_point$ = "." ' - 1 for decimal place. Ex 2.034d+2 is 2034 here where 3 places to the right . could be moved before . disappears. > so no trailing decimal results.
  260.         stringmathb$ = MID$(MID$(stringmathb$, 1, stn_i&), 1, VAL(MID$(stringmathb$, stn_i& + 3)) + 1) + stn_point$ + MID$(MID$(stringmathb$, 1, stn_i&), VAL(MID$(stringmathb$, stn_i& + 3)) + 2, stn_i& - VAL(MID$(stringmathb$, stn_i& + 3)) - 1) + STRING$(VAL(MID$(stringmathb$, stn_i& + 2)) - (stn_i& - 1), "0")
  261.     END IF
  263. IF stringmathb$ = "0" THEN stn_sign$ = ""
  264. stringmathb$ = stn_sign$ + stringmathb$
  265. stn_sign$ = "": stn_point$ = ""
  267.  
« Last Edit: March 31, 2019, 08:24:22 am by codeguy »
Logged

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #7 on: March 31, 2019, 07:25:22 am »
corrected setting m$ to null.
Please try my code for inserting commas. It is designed to insert commas after variable numbers of characters. it can also be used to save fixed-length strings to CSV (comma-separated values).
Code: QB64: [Select]
  1. g& = 1048576
  2. FOR csep& = 1 TO 3
  3.     FOR I& = g& TO g& + 9
  4.         m$ = SPACE$(g&)
  5.         L& = I&
  6.         s! = TIMER(.001)
  7.         DO UNTIL L& < 1
  8.             MID$(m$, L&, 1) = CHR$((ASC("0") + RND * (ASC("9") - ASC("0"))) AND 255)
  9.             L& = L& - 1
  10.         LOOP
  11.         f! = TIMER(.001)
  12.         start! = TIMER(.001)
  13.         x$ = CommaPad$(m$, csep&)
  14.         finish! = TIMER(.001)
  15.         PRINT x$; " took "; finish! - start!; "seconds LENGTH ="; I&; f! - s!; "to generate."
  16.     NEXT
  18.  
  19. FUNCTION CommaPad$ (f$, every&)
  20.     r& = LEN(f$)
  21.     IF r& > every& THEN
  22.         q& = r& MOD every&
  23.         IF q& > 0 THEN
  24.             n& = (r& - q&) / every& + 1
  25.             b$ = SPACE$(q& + n& * (every& + 1))
  26.             WHILE n& >= 0
  27.                 MID$(b$, q& + n& * ((every& + 1)) + 1) = ","
  28.                 MID$(b$, q& + n& * ((every& + 1)) + 1 + 1, every&) = MID$(f$, q& + n& * every& + 1, every&)
  29.                 n& = n& - 1
  30.             WEND
  31.             MID$(b$, 1, q&) = LEFT$(f$, q&)
  32.             CommaPad$ = LEFT$(b$, LEN(b$) - (every& + 1))
  33.         ELSE
  34.             n& = r& / every&
  35.             b$ = SPACE$(n& * (every& + 1))
  36.             WHILE n& >= 0
  37.                 MID$(b$, n& * ((every& + 1)) + 1) = ","
  38.                 MID$(b$, n& * ((every& + 1)) + 1 + 1, every&) = MID$(f$, n& * every& + 1, every&)
  39.                 n& = n& - 1
  40.             WEND
  41.             CommaPad$ = MID$(b$, 2)
  42.         END IF
  43.         b$ = ""
  44.     ELSE
  45.         CommaPad$ = f$
  46.     END IF
  48.  
« Last Edit: March 31, 2019, 08:50:14 am by codeguy »
Logged

Offline Dimster

  • Forum Resident
  • Posts: 500
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #8 on: March 31, 2019, 12:08:46 pm »
Again Pete, really had a lot of fun with some practical numbers and so far so good. I did have a moment there where I was using some stock prices and had to scratch my head when I got an "invalid number" response. In the stock market you can come up with some prices which are expressed in multiple digits to the right of the decimal. For example, Fidelity US Monthly Income Fund was priced at $18.6037 this past Friday - When I entered this dollar amount as the "number", I did not get the menu but an immediate "Valid Number of 18.6037" - seems it refused to take this as a valid dollar and cents figure. Then, using 18.6037 as a valid number, I did get the menu but again , choosing dollar and cents, it would not accept the number as a valid dollar and cents. This is not a real big deal. The vast majority of commerce and trade only has two digits to the right of the decimal.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #9 on: March 31, 2019, 04:26:04 pm »
Thanks Dimster. I didn't think about including stock prices. A lot of calculators has 2-digit and 4-digit options. That's something I may consider.

@Codeguy: Hey, you're young, you can wait, but I've got to figure out a faster way to add commas. It appears that string replacement is much faster than string concatenation. I'll have to fool with that a bit, but I wanted to get the working components down and tested before I get into optimization and capacity. That LEN() limit is a bummer, but there are ways to save parts in arrays and get around that.

By bombing out, did you mean it wouldn't remove the commas? It took so long, I had to presume it couldn't process that large of a string. Instead of debugging it, as it may be a size limitation and it's bleeping slow, I decided to try a string replacement with INSTR().

Code: QB64: [Select]
  1. m& = 1048576 * 1.25 - 1
  2. stringmathb$ = SPACE$(m&)
  3. FOR i& = 1 TO m&
  4.     j& = j& + 1
  5.     MID$(stringmathb$, i&, 1) = CHR$(ASC("0") + RND * (ASC("9") - ASC("0")) AND 255)
  6.     IF j& MOD 3 = 0 AND i& < m& - 2 THEN i& = i& + 1: MID$(stringmathb$, i&, 1) = ","
  8. PRINT stringmathb$, LEN(stringmathb$), "Press a key to remove commas...": SLEEP
  9.  
  10. b$ = SPACE$(LEN(stringmathb$)): j& = 0
  12.     i& = INSTR(seed& + 1, stringmathb$, ",")
  13.     IF i& = 0 THEN EXIT DO
  14.     MID$(b$, j& + 1, i& - seed& + 1) = MID$(stringmathb$, seed& + 1, i& - seed& - 1)
  15.     j& = j& + i& - seed& - 1
  16.     seed& = i&
  18. stringmathb$ = RTRIM$(b$) + MID$(stringmathb$, seed& + 1): b$ = ""
  19. PRINT stringmathb$, LEN(stringmathb$): END

That's bleeping fast! Thank you for your post, which lead me to surmise QB handles string replacement infinitely faster than string concatenation. That's probably the case for all languages.

OK, I put together a way to add commas, too. This routine will take the 1M+ digits Codeguy provided and add commas, prompt, and remove commas. It's very fast, now!

Code: QB64: [Select]
  1. m& = 1048576
  2. stringmathb$ = SPACE$(m&)
  3. FOR i& = 0 TO m& - 1
  4.     MID$(stringmathb$, i& + 1, 1) = CHR$(ASC("0") + RND * (ASC("9") - ASC("0")) AND 255)
  7.     LINE INPUT "Press Enter to add commas..."; null$
  8.     ' Add commas
  9.     i& = 0: j& = 0: seed& = 0
  10.     seed& = LEN(stringmathb$) MOD 3: IF seed& = 0 THEN seed& = 3
  11.     m1& = LEN(stringmathb$)
  12.     m2& = (LEN(stringmathb$) - 1) \ 3
  13.     c$ = SPACE$(m1& + m2&)
  14.     DO WHILE i& < m1&
  15.         MID$(c$, j& + 1, seed& + 1) = MID$(stringmathb$, i& + 1, seed&) + ","
  16.         i& = i& + seed&: j& = j& + seed& + 1: seed& = 3
  17.     LOOP
  18.     c$ = RTRIM$(c$)
  19.     IF RIGHT$(c$, 1) = "," THEN stringmathb$ = MID$(c$, 1, LEN(c$) - 1) ELSE stringmathb$ = c$
  20.     c$ = ""
  21.     PRINT stringmathb$
  22.     PRINT "Length of string ="; LEN(stringmathb$)
  23.     LINE INPUT "Press Enter to remove commas..."; null$
  24.     ' Remove commas
  25.     i& = 0: j& = 0: seed& = 0
  26.     b$ = SPACE$(LEN(stringmathb$)): j& = 0
  27.     DO
  28.         i& = INSTR(seed& + 1, stringmathb$, ",")
  29.         IF i& = 0 THEN EXIT DO
  30.         MID$(b$, j& + 1, i& - seed& + 1) = MID$(stringmathb$, seed& + 1, i& - seed& - 1)
  31.         j& = j& + i& - seed& - 1
  32.         seed& = i&
  33.     LOOP
  34.     stringmathb$ = RTRIM$(b$) + MID$(stringmathb$, seed& + 1): b$ = ""
  35.     PRINT stringmathb$
  36.     PRINT "Length of string ="; LEN(stringmathb$)
  38.  



Pete
« Last Edit: March 31, 2019, 06:51:28 pm by Pete »
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #10 on: March 31, 2019, 08:19:10 pm »
By bombing out, I mean your comma insertion code ran REALLY slowly as compared to my little comma insertion function. Yes, the string concatenation overhead is terrible, but not unexpected when you discover what goes on under the hood for string concatenation. Mine takes 60s for a 16,777,216 character string (doesn't necessarily have to be numbers) on a mobile core i7. A more modest test of 1 MB takes about 70 milliseconds.
Code: QB64: [Select]
  1. g& = 1048576 * 16
  2. FOR csep& = 1 TO 3
  3.     FOR I& = g& TO g& + 0
  4.         m$ = SPACE$(g&)
  5.         L& = I&
  6.         s! = TIMER(.001)
  7.         DO UNTIL L& < 1
  8.             MID$(m$, L&, 1) = CHR$(ASC("0") + (RND * (ASC("9") - ASC("0"))) AND 255)
  9.             L& = L& - 1
  10.         LOOP
  11.         f! = TIMER(.001)
  12.         start! = TIMER(.001)
  13.         x$ = CommaPad$(m$, csep&)
  14.         finish! = TIMER(.001)
  15.         PRINT x$
  16.         PRINT "took "; finish! - start!; "seconds LENGTH ="; I&; f! - s!; "to generate."
  17.     NEXT
  19.  
  20. FUNCTION CommaPad$ (f$, every&)
  21.     r& = LEN(f$)
  22.     IF r& > every& THEN
  23.         q& = r& MOD every&
  24.         IF q& > 0 THEN
  25.             n& = (r& - q&) / every& + 1
  26.             b$ = SPACE$(q& + n& * (every& + 1))
  27.             WHILE n& >= 0
  28.                 MID$(b$, q& + n& * ((every& + 1)) + 1) = ","
  29.                 MID$(b$, q& + n& * ((every& + 1)) + 1 + 1, every&) = MID$(f$, q& + n& * every& + 1, every&)
  30.                 n& = n& - 1
  31.             WEND
  32.             MID$(b$, 1, q&) = LEFT$(f$, q&)
  33.             CommaPad$ = LEFT$(b$, LEN(b$) - (every& + 1))
  34.         ELSE
  35.             n& = r& / every&
  36.             b$ = SPACE$(n& * (every& + 1))
  37.             WHILE n& >= 0
  38.                 MID$(b$, n& * ((every& + 1)) + 1) = ","
  39.                 MID$(b$, n& * ((every& + 1)) + 1 + 1, every&) = MID$(f$, n& * every& + 1, every&)
  40.                 n& = n& - 1
  41.             WEND
  42.             CommaPad$ = MID$(b$, 2)
  43.         END IF
  44.         b$ = ""
  45.     ELSE
  46.         CommaPad$ = f$
  47.     END IF
  49.  
Logged

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Working on a comma system for string math routine...
« Reply #11 on: April 01, 2019, 03:31:40 am »
Here is another version, quite fast too at 16 Megabyte string size, performs in just a shade under 4s on a single thread on a mobile core i7. about 34ms on 1 one megabyte input.
Code: QB64: [Select]
  1. Long_NumberOfCharacters& = 33 '555434
  2. Str_StrInput$ = SPACE$(Long_NumberOfCharacters&): FillNumber Str_StrInput$, 1, Long_NumberOfCharacters&: PRINT Str_StrInput$
  3. Long_DigitsPerComma = 3
  4. Long_StrLenModNOC = Long_NumberOfCharacters& MOD Long_DigitsPerComma
  5. Long_NumberOfCommas& = (Long_NumberOfCharacters& - Long_StrLenModNOC) / Long_DigitsPerComma
  6. Str_StringPosition& = Long_NumberOfCharacters&
  7. Long_OutputStrPos& = Long_NumberOfCharacters& + Long_NumberOfCommas&
  8. Str_StrInput$ = Str_StrInput$ + SPACE$(Long_NumberOfCommas&)
  9. s! = TIMER(.001)
  11.     Long_OutputStrPos& = Long_OutputStrPos& - Long_DigitsPerComma
  12.     Str_StringPosition& = Str_StringPosition& - Long_DigitsPerComma
  13.     MID$(Str_StrInput$, Long_OutputStrPos& + 1, Long_DigitsPerComma) = MID$(Str_StrInput$, Str_StringPosition& + 1, Long_DigitsPerComma)
  14.     MID$(Str_StrInput$, Long_OutputStrPos&, 1) = ","
  15.     Long_OutputStrPos& = Long_OutputStrPos& - 1
  16. LOOP UNTIL Long_OutputStrPos& < 1
  17. f! = TIMER(.001)
  18. IF LEFT$(Str_StrInput$, 1) = "," THEN
  19.     Str_StrInput$ = MID$(Str_StrInput$, 2)
  21. PRINT Str_StrInput$ + "\"; f! - s!
  22.  
  23. SUB FillNumber (Str_StrInput$, start&, finish&)
  24.     asc0% = ASC("0")
  25.     asc9% = ASC("9")
  26.     FOR cpos& = start& TO finish&
  27.         MID$(Str_StrInput$, cpos&, 1) = CHR$(asc0% + INT(RND * (asc9% - asc0%)))
  28.     NEXT
  30.  

and here is a demo I made decidedly shorter and incorporating a SUB to do the work:
Code: QB64: [Select]
  1. '* Converting a stream of input to comma-delimited output
  2. '* This is a common task when displaying information in more convenient human-readable form
  3.  
  4. '* Test variables, not necessary for the function
  5. Long_NumberOfCharacters& = 100
  6. Str_StrInput$ = SPACE$(Long_NumberOfCharacters&)
  7. FillNumber Str_StrInput$, 1, Long_NumberOfCharacters&: PRINT Str_StrInput$
  8.  
  9. '* these are definitely necessary
  10. Long_DigitsPerComma& = 3
  11. s! = TIMER(.001)
  12. AddCommas Str_StrInput$, Long_DigitsPerComma&
  13. f! = TIMER(.001)
  14. PRINT Str_StrInput$ + "\"; f! - s!
  15.  
  16. SUB FillNumber (Str_StrInput$, start&, finish&)
  17.     asc0% = ASC("0")
  18.     asc9% = ASC("9")
  19.     FOR cpos& = start& TO finish&
  20.         MID$(Str_StrInput$, cpos&, 1) = CHR$(asc0% + INT(RND * (asc9% - asc0%)))
  21.     NEXT
  23.  
  24. SUB AddCommas (Str_StrInput$, Long_DigitsPerComma&)
  25.     Long_NumberOfCharacters& = LEN(Str_StrInput$)
  26.     Long_StrLenModNOC& = Long_NumberOfCharacters& MOD Long_DigitsPerComma&
  27.     Long_NumberOfCommas& = (Long_NumberOfCharacters& - Long_StrLenModNOC&) / Long_DigitsPerComma&
  28.     Str_StringPosition& = Long_NumberOfCharacters&
  29.     Long_OutputStrPos& = Long_NumberOfCharacters& + Long_NumberOfCommas&
  30.     Str_StrInput$ = Str_StrInput$ + SPACE$(Long_NumberOfCommas&)
  31.     DO
  32.         Long_OutputStrPos& = Long_OutputStrPos& - Long_DigitsPerComma&
  33.         Str_StringPosition& = Str_StringPosition& - Long_DigitsPerComma&
  34.         MID$(Str_StrInput$, Long_OutputStrPos& + 1, Long_DigitsPerComma&) = MID$(Str_StrInput$, Str_StringPosition& + 1, Long_DigitsPerComma&)
  35.         MID$(Str_StrInput$, Long_OutputStrPos&, 1) = ","
  36.         Long_OutputStrPos& = Long_OutputStrPos& - 1
  37.     LOOP UNTIL Long_OutputStrPos& < 1
  38.     IF LEFT$(Str_StrInput$, 1) = "," THEN
  39.         Str_StrInput$ = MID$(Str_StrInput$, 2)
  40.     END IF
  42.  
« Last Edit: April 01, 2019, 05:34:55 am by codeguy »
Logged
Pages: [1]   Go Up
« previous next »