Author Topic: MEANALYZ: Math Expressions Analyzer V.1.1  (Read 4998 times)

0 Members and 1 Guest are viewing this topic.

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
MEANALYZ: Math Expressions Analyzer V.1.1
« on: August 12, 2020, 05:43:57 pm »

A Math Expressions Analyzer. You can assign a string to evaluate with a Math expression and it will return the result. Supports variables. Attached you'll find the code to run in QB64. SUB and FUNCTION names are in Spanish, but the attached README.TXT file has detailed instructions how to take advantage of the functionality.

UPDATE: A new version 1.1 was issued on August 26, 2020. Please download it in a message below.

The most basic use is:
Code: QB64: [Select]
  1.   Constructor  ' Must be executed before any other procedure
  2.   setExpresion "5 + 3 * 8" ' Spaces don't matter
  3.   PRINT "The result is: "; AnalizaExpr  ' Shows the results


And that's it! I'll look forward for your comments.

Saludos cordiales,
* MEANALYZ.7z (Filesize: 12.54 KB, Downloads: 153)
« Last Edit: August 26, 2020, 04:36:05 pm by adgarza »
Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #1 on: August 12, 2020, 06:25:30 pm »
Hello @adgarza,

Evaluate is great achievement for coders!

I tried some of my test expressions on yours with mixed results:
Code: QB64: [Select]
  1.     'e$ = "2*-3 - -4+-0.25" ' returns -2.25 good
  2.     'e$ = "1 + 2 * (3 + ((4 * 5) + (6 * 7 * 8)) - 9) / 10" ' returns 71 good
  3.     'e$ = " 1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" ' should return 60 , nope not 654
  4.     e$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2" 'should be  2.718 281 828 458 995 but hangs
  5.  

I don't even know if yours handles nested parenthesis but it got the 2nd test e$ correct. :)

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #2 on: August 13, 2020, 11:46:55 am »
Thank you, bplus.


I will review the code to see what's happening here.


Saludos cordiales,

Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline Aurel

  • Forum Regular
  • Posts: 167
    • View Profile
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #3 on: August 13, 2020, 12:44:16 pm »
   
Quote
'e$ = " 1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" ' should return 60 , nope not 654

yes i get 60 in microA...
anyway nice program !
//////////////////////////////////////////////////////////////////
https://aurelsoft.ucoz.com
https://www.facebook.com/groups/470369984111370
//////////////////////////////////////////////////////////////////

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.1
« Reply #4 on: August 26, 2020, 02:37:16 pm »
Hi, All.


I did the fixes to the code.


Bug1 Fixed: There was a bug in the code with the signs law that issued the wrong result in the third equation tested.
Bug2 Workaround: There seems to be a bug in QB64 environment where, in some cases, a number is forcibly converted into scientific notation by adding a number greater than zero in the far right of the decimals. So if I got the number 0.012, it is converted into 1.2000000000000001D-2. I tried to get rid through numeric rounds of the scientific notation, but the environment turned it back into scientific notation adding another number at the end (3 or 2 or other). This doesn't happen in QB45 nor VB-DOS where I was testing the code. I had a kind of nightmare trying to resolve this in QB64. Then, I had to do a workaround with string manipulation to get rid of this problem.


Feature added: If there are two operations or numbers inside parentheses with no operation sign between them (like (2)(3) or (1+1)(2+1)) the program will add automatically the "*".
Feature added: You can specify, in the COMMAND$, a filename. This needs to be a plain text file so the program will read the operations there and will execute all of them one after one. This way, you will need not to write once and again the formulas.


Thank you for testing the code. I appreciate so much your time to do it.


Code is as follows:
Code: QB64: [Select]
  1.  
  2. ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
  3. ' Math Expressions Analyzer V.1.1                         '
  4. '                                                         '
  5. ' Module to get a string, analyze it mathematically and   '
  6. ' issuing a result from the operation. If you are using   '
  7. ' QuickBASIC with a project, please ensure to include the '
  8. ' FUNCTION declarations at the top of each file on it.    '
  9. ' Failing to do so can bring no results in the analysis.  '
  10. '                                                         '
  11. ' Originally created in Visual Basic 4.0 and translated   '
  12. ' into QBASIC/QB/VB-DOS/QB64 by A. David Garza Marin.     '
  13. ' e-mail: adgarza@yahoo.com                               '
  14. ' PRO-3, Mexico                                           '
  15. ' ******************************************************* '
  16. ' You are free to use and modify this code to adapt it    '
  17. ' to your own needs. But, please, don't remove my credit. '
  18. ' It took many hours for its creation and I think I       '
  19. ' deserve such credit.                                    '
  20. '                                                         '
  21. ' Please, send to me an email to adgarza@yahoo.com to     '
  22. ' report errors or commends about this code.              '
  23. ' ******************************************************* '
  24. ' MODIFICATIONS:                                          '
  25. '                                                         '
  26. ' Date(d/m/y)| Revision                                   '
  27. ' --------+---------------------------------------------- '
  28. ' 01/01/97| Development started.                          '
  29. ' 16/06/97| Added an Error member data that takes control '
  30. '         | of runtime errors in the methods.             '
  31. ' 18/06/97| Error code 8, "Cannot divide by zero" added.  '
  32. ' 14/12/98| Bugs corrected on operations with signed nums.'
  33. ' 15/12/98| CalculaFormula method added. This method gets '
  34. '         | rid of spaces and verifies the sign-law.      '
  35. '         | This addition was done by Alejandro Juarez B. '
  36. ' 15/12/98| Function CalculaFormula made private.         '
  37. '         | (adgarza).                                    '
  38. ' 21/05/99| Translation into QBASIC and QuickBASIC.       '
  39. '         | (adgarza).                                    '
  40. ' 12/08/20| Translation into QB64                         '
  41. ' 13/08/20| Fixed calculation problem with long expression'
  42. '         |  starting with a blank space.                 '
  43. ' 26/08/20| Fixed a logical error where a long result in  '
  44. '         |  an operation would bring an unexpected       '
  45. '         |  scientific notation that crashed the program.'
  46. '         | Fixed a logical error when multiplying or     '
  47. '         |  dividing two negative numbers the + sign was '
  48. '         |  missing.                                     '
  49. '         | Added * signs when a parentheses is trailed   '
  50. '         |  or followed directly with a number or with a '
  51. '         |  closing parentheses following by an open one '
  52. '         |  and vice-versa                               '
  53. '         | There is an apparent error in QB64 where some '
  54. '         |  floating point numbers assigned to variables '
  55. '         |  of type DOUBLE are forcibly converted to     '
  56. '         |  scientific notation by adding a decimal      '
  57. '         |  number distinct to zero at the end of the    '
  58. '         |  decimals. This was worked around with a      '
  59. '         |  sub-process that removes the scientific      '
  60. '         |  notation through string manipulation, as     '
  61. '         |  there is no way to remove it numerically.    '
  62. '
  63. ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
  64.  
  65.  
  66. OPTION EXPLICIT
  67. ' $DYNAMIC
  68. DEFINT A-Z
  69.  
  70.  
  71. ' -----Copy these declarations in your modules ----
  72. DECLARE SUB Constructor ()
  73. DECLARE SUB Destructor ()
  74. DECLARE SUB doLimpiaVar ()
  75. DECLARE SUB doRemVar (Variable AS STRING)
  76. DECLARE SUB getObtieneVar ()
  77. DECLARE SUB setExpresion (strCualExpresionEvaluar AS STRING)
  78. DECLARE SUB setNuevaVar (strNombre AS STRING)
  79. DECLARE SUB setNuevoValor (varVariable AS STRING, varValor AS DOUBLE)
  80. DECLARE FUNCTION AnalizaExpr# ()
  81. DECLARE FUNCTION Expresion$ ()
  82. DECLARE FUNCTION CErr% ()
  83. DECLARE FUNCTION CuentaVar% ()
  84. DECLARE FUNCTION DErr$ ()
  85. DECLARE FUNCTION NombreVar$ (iCualVariable AS INTEGER)
  86. DECLARE FUNCTION Valor# (varVariable AS STRING)
  87. ' -----Copy should be up to here. It is not necessary to copy the rest of the declarations
  88.  
  89.  
  90. ' ******** Local Functions *********************
  91. DECLARE FUNCTION SinAcentos% (strCadena AS STRING)
  92. DECLARE FUNCTION BuscaVar% (CualVar AS STRING)
  93. DECLARE FUNCTION LimpiaFormula# (strFormula AS STRING)
  94. DECLARE FUNCTION CalculaFormula# (strFormula AS STRING)
  95. DECLARE FUNCTION NumDer# (strCadena AS STRING, iPos AS INTEGER, iPosD AS INTEGER)
  96. DECLARE FUNCTION NumIzq# (strCadena AS STRING, iPos AS INTEGER, iPosI AS INTEGER)
  97. DECLARE FUNCTION SustituyeVars$ ()
  98. DECLARE FUNCTION VerificaVar% ()
  99. ' ************************************************
  100.  
  101.  
  102. ' 32-bit value
  103. TYPE RegistroVar
  104.     Nombre AS STRING * 24
  105.     Valor AS STRING * 8
  106.  
  107.  
  108. DIM aregVariables(0 TO 0) AS RegistroVar ' Operation variables
  109. DIM strExpresion AS STRING ' String to analyze
  110. DIM iError AS INTEGER ' The error happened
  111.  
  112.  
  113. ' Constants
  114. CONST FALSE = 0
  115. CONST TRUE = NOT FALSE
  116. CONST Debug = FALSE
  117.  
  118.  
  119.  
  120.  
  121. ' ********* Main program cycle ********
  122. DIM strCadena AS STRING
  123. DIM dblValor AS DOUBLE
  124.  
  125.  
  126. CLS ' Clean screen
  127.  
  128.  
  129. ' Run the following procedure before any other
  130. Constructor
  131.  
  132.  
  133.     strCadena = COMMAND$
  134.     c = TRUE
  135.     ' Sees if it is a test file
  136.     '  THIS ONLY WORKS IN QB64
  137.     IF FILEEXISTS("TESTMEA.TXT") THEN
  138.         tf = TRUE
  139.         OPEN "TESTMEA.TXT" FOR INPUT AS #1
  140.     ELSE
  141.         tf = FALSE
  142.     END IF
  143.  
  144.  
  145.  
  146.  
  147. ' Repeat until you get an N
  148. PRINT "This program interprets simple mathematical expressions. Write"
  149. PRINT "one at the prompt and press Enter to see the results. Read the"
  150. PRINT "file README.TXT for further details. You can use"
  151. PRINT "variables in the expression."
  152.     doLimpiaVar ' Clean variables
  153.     IF tf THEN
  154.         IF NOT EOF(1) THEN
  155.             LINE INPUT #1, strCadena
  156.         ELSE
  157.             strCadena = ""
  158.             tf = FALSE
  159.             CLOSE #1
  160.         END IF
  161.     ELSE
  162.         INPUT "Expression to evaluate"; strCadena ' Gets the string
  163.     END IF
  164.  
  165.  
  166.     IF strCadena <> "" THEN
  167.         setExpresion strCadena ' Assigns the string to the module
  168.         getObtieneVar ' Gets variables
  169.         x = CuentaVar ' Count how many variables the expression has
  170.  
  171.         IF x > 0 THEN ' If variables found, ask for their values.
  172.             FOR i = 1 TO x ' Loop for each variable found.
  173.                 PRINT "Value of " + NombreVar(i); ' Show the variable name to request its value
  174.                 INPUT dblValor ' Capture the value
  175.                 setNuevoValor LTRIM$(STR$(i)), dblValor ' Assign the value to the variable
  176.             NEXT i
  177.         END IF
  178.         IF c OR tf THEN
  179.             PRINT "Result of: "; strCadena
  180.         END IF
  181.         PRINT USING "###,###,###,###.####"; AnalizaExpr ' Show the result
  182.  
  183.  
  184.         IF CErr > 0 THEN ' Is any error happened?
  185.             PRINT "Error" + STR$(CErr) + ": " + DErr ' Show the error message
  186.             PRINT
  187.         END IF
  188.     END IF
  189.  
  190.  
  191.     IF NOT tf THEN
  192.         PRINT "Again? (Y/N)" ' Want to try again?
  193.         PRINT
  194.         DO
  195.             t = INKEY$
  196.         LOOP UNTIL UCASE$(t) = "Y" OR UCASE$(t) = "N" ' Get Y or N
  197.     ELSE
  198.         t = "Y"
  199.     END IF
  200. LOOP UNTIL UCASE$(t) = "N"
  201.  
  202.  
  203. ' Even though is not strictly necessary, it is advised to
  204. '  free the resources used by the module
  205. Destructor
  206. PRINT "End of program" ' End of the program execution
  207.  
  208.  
  209. DEFSNG A-Z
  210. ' Public procedure to set if the formula analysis should be done.
  211. FUNCTION AnalizaExpr# ()
  212.     ' Var
  213.     DIM strFormula AS STRING
  214.     SHARED iError AS INTEGER
  215.     SHARED strExpresion AS STRING
  216.  
  217.  
  218.     iError = 0
  219.     IF strExpresion <> "" THEN
  220.         strExpresion = RTRIM$(LTRIM$(strExpresion)) ' Removes spaces
  221.         IF SinAcentos(strExpresion) THEN
  222.             IF CuentaVar% = 0 THEN ' Just if there are no variables
  223.                 getObtieneVar ' Verifies if there are variables, just in case
  224.             END IF
  225.             IF VerificaVar THEN
  226.                 strFormula = SustituyeVars ' Substitues variables
  227.                 AnalizaExpr = LimpiaFormula(strFormula)
  228.             ELSE
  229.                 iError = 4
  230.                 AnalizaExpr = 0
  231.             END IF
  232.         END IF
  233.     ELSE
  234.         iError = 5
  235.         AnalizaExpr = 0
  236.     END IF
  237.  
  238.  
  239. FUNCTION BuscaVar% (CualVar AS STRING)
  240.     ' Var
  241.     DIM i AS INTEGER
  242.     DIM x AS INTEGER
  243.     DIM strCualVar AS STRING
  244.     SHARED aregVariables() AS RegistroVar
  245.  
  246.  
  247.     strCualVar = UCASE$(CualVar)
  248.     i = 0
  249.     x = UBOUND(aregVariables)
  250.     IF x > 0 THEN
  251.         DO
  252.             i = i + 1
  253.         LOOP UNTIL UCASE$(RTRIM$(aregVariables(i).Nombre)) = strCualVar OR i = x
  254.  
  255.  
  256.         IF UCASE$(RTRIM$(aregVariables(i).Nombre)) <> strCualVar THEN
  257.             i = 0
  258.         END IF
  259.     END IF
  260.  
  261.  
  262.     BuscaVar = i
  263.  
  264.  
  265. ' Do the formula analysis
  266. FUNCTION CalculaFormula# (strFormula AS STRING)
  267.     ' Var
  268.     DIM dblNum1 AS DOUBLE
  269.     DIM dblNum2 AS DOUBLE
  270.     DIM dblRes AS FLOAT, strRes AS STRING
  271.     DIM iOperacion AS INTEGER
  272.     DIM strOperacion AS STRING * 1
  273.     DIM strSigno AS STRING * 2
  274.     DIM strSubFormula AS STRING
  275.     DIM strCar AS STRING
  276.     DIM iPos AS INTEGER, iPosI AS INTEGER, iPosD AS INTEGER
  277.     DIM iPosParI AS INTEGER, iPosParD AS INTEGER
  278.     DIM iPosParI2 AS INTEGER, iCuantosI AS INTEGER
  279.     DIM iOper1 AS INTEGER, iOper2 AS INTEGER
  280.     DIM iNC AS INTEGER, strNC AS STRING, iNCPD AS INTEGER
  281.     DIM strASuma AS STRING
  282.     SHARED iError AS INTEGER
  283.     CONST strSimbolo = "^^*/+-" ' Recognized symbols (From most important to least important)
  284.  
  285.  
  286.     ' Calculates the formula
  287.     iError = 0
  288.     DIM iPosParI2(1 TO 10) AS INTEGER
  289.     DO
  290.         strCar = ""
  291.         IF iCuantosI > 0 THEN
  292.             iPosParI = INSTR(iPosParI2(iCuantosI) + 1, strFormula, "(")
  293.             iPosParD = INSTR(iPosParI2(iCuantosI) + 1, strFormula, ")")
  294.         ELSE
  295.             iPosParI = INSTR(strFormula, "(")
  296.             iPosParD = INSTR(strFormula, ")")
  297.         END IF
  298.  
  299.  
  300.         ' Runs the code according the parentheses location
  301.         IF iPosParI < iPosParD AND iPosParI > 0 THEN
  302.             iCuantosI = iCuantosI + 1
  303.             IF UBOUND(iPosParI2) < iCuantosI THEN
  304.                 REDIM PRESERVE iPosParI2(1 TO iCuantosI + 9) AS INTEGER
  305.             END IF
  306.  
  307.  
  308.             ' Validates if the previous character of the opening parentheses is a number
  309.             '  if so, then add the asterisc
  310.             IF iPosParI > 1 THEN
  311.                 strCar = MID$(strFormula, iPosParI - 1, 1)
  312.             END IF
  313.             IF strCar <> "" THEN
  314.                 IF INSTR("0123456789)", strCar) > 0 THEN
  315.                     strFormula = LEFT$(strFormula, iPosParI - 1) + "*" + MID$(strFormula, iPosParI)
  316.                     iPosParI = iPosParI + 1
  317.                 END IF
  318.             END IF
  319.             iPosParI2(iCuantosI) = iPosParI
  320.         ELSEIF iPosParD > 0 THEN
  321.             IF iCuantosI > 0 THEN
  322.                 strCar = MID$(strFormula, iPosParD + 1, 1)
  323.                 ' Validates if the following character of the closing parentheses is a number. if so
  324.                 '   then adds an asterisc.
  325.                 IF strCar <> "" THEN
  326.                     IF INSTR("0123456789(", strCar) > 0 THEN
  327.                         strFormula = LEFT$(strFormula, iPosParD) + "*" + MID$(strFormula, iPosParD + 1)
  328.                     END IF
  329.                 END IF
  330.  
  331.  
  332.                 IF iPosParI2(iCuantosI) > 0 THEN
  333.                     strSubFormula = MID$(strFormula, iPosParI2(iCuantosI) + 1, iPosParD - iPosParI2(iCuantosI) - 1)
  334.                     IF Debug THEN
  335.                         PRINT "strFormula="; strFormula
  336.                         PRINT "strSubFormula="; strSubFormula
  337.                     END IF
  338.                     GOSUB HazLaOperacion
  339.                     strFormula = LEFT$(strFormula, iPosParI2(iCuantosI) - 1) + strSubFormula + MID$(strFormula, iPosParD + 1)
  340.                     iCuantosI = iCuantosI - 1
  341.                 ELSE
  342.                     iError = 6 ' Parentheses mismatch
  343.                     EXIT FUNCTION
  344.                 END IF
  345.             ELSE
  346.                 iError = 6 ' Parentheses mismatch
  347.                 EXIT FUNCTION
  348.             END IF
  349.         ELSEIF iPosParI > 0 AND iPosParD = 0 THEN
  350.             iError = 6 ' Parentheses mismatch
  351.             EXIT FUNCTION
  352.         ELSEIF iPosParI = 0 AND iPosParD = 0 THEN
  353.             strSubFormula = strFormula
  354.             IF Debug THEN
  355.                 PRINT "strFormula="; strFormula
  356.                 PRINT "strSubFormula="; strSubFormula
  357.             END IF
  358.             GOSUB HazLaOperacion
  359.             strFormula = strSubFormula
  360.             iCuantosI = 0
  361.         END IF
  362.     LOOP UNTIL iPosParI = 0 AND iPosParD = 0
  363.  
  364.  
  365.     CalculaFormula = VAL(strFormula)
  366.  
  367.  
  368.  
  369.  
  370.     HazLaOperacion:
  371.     ' Do the operation
  372.     iOperacion = 1
  373.     DO
  374.         strSigno = MID$(strSimbolo, (2 * (iOperacion - 1) + 1), 2)
  375.  
  376.  
  377.         ' If one of these operators ( ^^ */ +- ) is inside the operation
  378.         iOper1 = INSTR(strSubFormula, LEFT$(strSigno, 1))
  379.         iOper2 = INSTR(strSubFormula, RIGHT$(strSigno, 1))
  380.         IF iOper1 > 0 OR iOper2 > 0 THEN
  381.  
  382.  
  383.             ' If the first operator exists (^*+) and is before the second one (^/-)
  384.             IF iOper1 <= iOper2 AND iOper1 > 0 THEN
  385.                 iPos = iOper1
  386.                 strOperacion = LEFT$(strSigno, 1)
  387.  
  388.  
  389.                 ' If the second operator (^/-) exists
  390.             ELSEIF iOper2 = 0 THEN
  391.                 iPos = iOper1
  392.                 strOperacion = LEFT$(strSigno, 1)
  393.  
  394.  
  395.                 ' If the second operator (^*+) exists and is after the second (^/-)
  396.             ELSEIF iOper1 > iOper2 AND iOper2 > 0 THEN
  397.  
  398.  
  399.                 ' If the first character on the formula is a negative sign, do the operation with the operator at the left (^*+)
  400.                 IF LEFT$(strSubFormula, 1) = "-" THEN
  401.                     iPos = iOper1
  402.                     strOperacion = LEFT$(strSigno, 1)
  403.                 ELSE ' Else, do the operation with the operator at the right (^/-)
  404.                     iPos = iOper2
  405.                     strOperacion = RIGHT$(strSigno, 1)
  406.                 END IF
  407.             ELSE
  408.                 ' The operation will be done with the right-side operator (^/-)
  409.                 strOperacion = RIGHT$(strSigno, 1)
  410.  
  411.  
  412.                 ' But if the first character is a negative sign, do the operation with the operator at the right-side (^/-)
  413.                 IF iOper2 = 1 THEN
  414.                     iPos = INSTR(iOper2 + 1, strSubFormula, strOperacion)
  415.                 ELSE
  416.                     iPos = iOper2
  417.                 END IF
  418.             END IF
  419.  
  420.  
  421.             ' If it is 1 is very likely that is a number with negative sign
  422.             strASuma = ""
  423.             IF iPos > 1 THEN
  424.                 dblNum1 = NumIzq(strSubFormula, iPos, iPosI)
  425.                 dblNum2 = NumDer(strSubFormula, iPos, iPosD)
  426.                 IF Debug THEN
  427.                     PRINT "dblNum1: "; dblNum1; "dblNum2: "; dblNum2
  428.                 END IF
  429.                 SELECT CASE strOperacion
  430.                     CASE "^": dblRes = dblNum1 ^ dblNum2
  431.                     CASE "*"
  432.                         dblRes = dblNum1 * dblNum2
  433.                         IF SGN(dblNum1) = -1 AND SGN(dblNum2) = -1 THEN
  434.                             strASuma = "+"
  435.                         END IF
  436.                     CASE "/"
  437.                         IF dblNum2 = 0 THEN
  438.                             iError = 8
  439.                             dblRes = 0
  440.                         ELSE
  441.                             dblRes = dblNum1 / dblNum2
  442.                         END IF
  443.                         IF SGN(dblNum1) = -1 AND SGN(dblNum2) = -1 THEN
  444.                             strASuma = "+"
  445.                         END IF
  446.                     CASE "+": dblRes = dblNum1 + dblNum2
  447.                     CASE "-": dblRes = dblNum1 - dblNum2
  448.                 END SELECT
  449.  
  450.  
  451.                 ' Removes scientific notation if any
  452.                 dblRes = CDBL(CLNG(dblRes * 1000000) / 1000000)
  453.                 strRes = LTRIM$(STR$(dblRes))
  454.                 iNC = INSTR(strRes, "D")
  455.                 IF iNC > 0 THEN
  456.                     GOSUB RemoverNotacionCientifica
  457.                     IF Debug THEN PRINT "I removed the scientific notation."
  458.                 END IF
  459.  
  460.  
  461.                 IF Debug THEN
  462.                     PRINT "dblRes:"; dblRes; "strRes: "; strRes
  463.                     IF INSTR(strRes, "D") THEN
  464.                         WHILE INKEY$ = "": WEND
  465.                     END IF
  466.                 END IF
  467.  
  468.  
  469.                 ' If the first character is a negative sign and the operation is an addition
  470.                 IF LEFT$(strSubFormula, 1) = "-" AND strOperacion = "+" THEN
  471.                     ' If the operator position is greater than 1
  472.                     IF iPosI > 1 THEN ' There is a negative number at left-side, so it is needed to force the addition adding the opperator
  473.                         strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strOperacion + strRes + MID$(strSubFormula, iPosD + 1)
  474.                     ELSE
  475.                         strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strRes + MID$(strSubFormula, iPosD + 1)
  476.                     END IF
  477.                 ELSE
  478.                     strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strASuma + strRes + MID$(strSubFormula, iPosD + 1)
  479.                 END IF
  480.  
  481.  
  482.                 IF Debug THEN
  483.                     PRINT "strSubFormula="; strSubFormula
  484.                     IF INSTR(strSubFormula, "D") > 0 THEN
  485.                         PRINT "strFormula="; strFormula
  486.                         WHILE INKEY$ = "": WEND
  487.                     END IF
  488.                 END IF
  489.  
  490.  
  491.             ELSE
  492.                 iOperacion = iOperacion + 1
  493.             END IF
  494.         ELSE
  495.             iOperacion = iOperacion + 1
  496.         END IF
  497.     LOOP UNTIL iOperacion > 3
  498.     RETURN
  499.  
  500.  
  501.     RemoverNotacionCientifica:
  502.     iNC = INSTR(strRes, "D")
  503.     IF iNC = 0 THEN
  504.         iNC = INSTR(strRes, "E")
  505.     END IF
  506.     IF iNC > 0 THEN
  507.         strNC = LEFT$(strRes, iNC - 1)
  508.         iNC = VAL(MID$(strRes, iNC + 1))
  509.         iNCPD = INSTR(strNC, ".")
  510.         strNC = LEFT$(strNC, iNCPD - 1) + MID$(strNC, iNCPD + 1)
  511.         iNCPD = iNCPD + iNC
  512.         IF iNCPD < 0 THEN
  513.             strNC = "." + STRING$(iNCPD, "0") + strNC
  514.         ELSEIF iNCPD > LEN(strNC) THEN
  515.             strNC = strNC + STRING$(iNCPD - LEN(strNC), "0") + "."
  516.         ELSE
  517.             strNC = LEFT$(strNC, iNCPD) + "." + MID$(strNC, iNCPD)
  518.         END IF
  519.         strRes = strNC
  520.     END IF
  521.     RETURN
  522.  
  523.  
  524. FUNCTION CErr% ()
  525.     ' Var
  526.     SHARED iError AS INTEGER
  527.  
  528.  
  529.     CErr = iError
  530.  
  531.  
  532. SUB Constructor ()
  533.     ' Var
  534.     SHARED iError AS INTEGER
  535.     SHARED strExpresion AS STRING
  536.     SHARED aregVariables() AS RegistroVar
  537.  
  538.  
  539.     ' Initializes the string value
  540.     strExpresion = ""
  541.     iError = 0
  542.     REDIM aregVariables(0 TO 0) AS RegistroVar
  543.  
  544.  
  545. ' Returns how many variables are in memory
  546. FUNCTION CuentaVar% ()
  547.     ' Var
  548.     SHARED aregVariables() AS RegistroVar
  549.  
  550.  
  551.     CuentaVar = UBOUND(aregVariables)
  552.  
  553.  
  554. FUNCTION DErr$ ()
  555.     ' Var
  556.     DIM strError AS STRING ' The string with the description of the error
  557.     SHARED iError AS INTEGER
  558.  
  559.  
  560.     ' Returns the text with the error description
  561.     SELECT CASE iError
  562.         CASE 0: strError = "Operation succeed"
  563.         CASE 1: strError = "Special characters not allowed"
  564.         CASE 2: strError = "Variable name doesn't exist"
  565.         CASE 3: strError = "Only numeric values accepted"
  566.         CASE 4: strError = "There are uninitialized variables"
  567.         CASE 5: strError = "No expression to evaluate"
  568.         CASE 6: strError = "Parentheses pairs don't match"
  569.         CASE 7: strError = "Variable name aleady exists"
  570.         CASE 8: strError = "Cannot divide by zero"
  571.         CASE 9: strError = "Haven't executed the constructor"
  572.     END SELECT
  573.  
  574.     DErr = strError
  575.  
  576.  
  577. SUB Destructor ()
  578.     ' Var
  579.     SHARED iError AS INTEGER
  580.  
  581.  
  582.     ' Cleans the variables of the list and others. This is not strictly
  583.     '  needed, but is a good programming practice to free the resources.
  584.     setExpresion ""
  585.     iError = 0
  586.     doLimpiaVar
  587.  
  588.  
  589. ' Gets rid of all variables in the buffer
  590. SUB doLimpiaVar ()
  591.     ' Var
  592.     SHARED aregVariables() AS RegistroVar
  593.  
  594.  
  595.     ERASE aregVariables
  596.     REDIM aregVariables(0 TO 0) AS RegistroVar
  597.  
  598.  
  599. ' Gets rid of the indicated variable in the varVariable parameter
  600. SUB doRemVar (varVariable AS STRING)
  601.     ' Var
  602.     DIM i AS INTEGER
  603.     DIM j AS INTEGER
  604.     DIM x AS INTEGER
  605.     DIM l AS INTEGER
  606.     REDIM aregX(0 TO 0) AS RegistroVar
  607.     SHARED iError AS INTEGER
  608.     SHARED aregVariables() AS RegistroVar
  609.  
  610.  
  611.     iError = 0
  612.     i = VAL(varVariable)
  613.     IF i = 0 THEN
  614.         i = BuscaVar(varVariable)
  615.     END IF
  616.  
  617.  
  618.     IF i > 0 THEN
  619.         x = UBOUND(aregVariables)
  620.         REDIM aregX(0 TO x - 1) AS RegistroVar
  621.         l = 0
  622.         FOR j = 1 TO x
  623.             IF j <> i THEN
  624.                 l = l + 1
  625.                 aregX(l) = aregVariables(j)
  626.             END IF
  627.         NEXT j
  628.         x = x - 1
  629.         REDIM aregVariables(0 TO x) AS RegistroVar
  630.         FOR j = 1 TO x
  631.             aregVariables(j) = aregX(j)
  632.         NEXT j
  633.         ERASE aregX
  634.     ELSE
  635.         iError = 2
  636.     END IF
  637.  
  638.  
  639. FUNCTION Expresion$ ()
  640.     ' Var
  641.     SHARED strExpresion AS STRING
  642.  
  643.  
  644.     ' Gets the string to evaluate
  645.     Expresion = strExpresion
  646.  
  647.  
  648. ' In this procedure are gathered the strings with the variable names
  649. '  included in the provided formula.
  650. '  This procedure will find those variables that
  651. '  fulfill the requirements of a variable name, although it will
  652. '  limit the names to 24 characters:
  653. '  MyData, Data1, Numeric_Value.
  654. ' It will reject special characters, like accented letters and ñ. If any, this procedure
  655. '  will issue an error.
  656. SUB getObtieneVar ()
  657.     ' Var
  658.     DIM strVariable AS STRING
  659.     DIM strCaracter AS STRING * 1
  660.     DIM iIniVar AS INTEGER
  661.     DIM iInicio AS INTEGER
  662.     DIM iFinal AS INTEGER
  663.     DIM bFinVar AS INTEGER
  664.     SHARED iError AS INTEGER
  665.     SHARED strExpresion AS STRING
  666.     SHARED aregVariables() AS RegistroVar
  667.  
  668.     iError = 0
  669.     IF SinAcentos(strExpresion) THEN
  670.         ' Check the string to find variable names
  671.         iInicio = 1
  672.         iIniVar = 0
  673.         iFinal = 1
  674.         DO WHILE iInicio <= LEN(strExpresion)
  675.             strCaracter = UCASE$(MID$(strExpresion, iInicio, 1))
  676.             IF strCaracter >= "A" AND strCaracter <= "Z" AND iIniVar = 0 THEN
  677.                 ' It found a letter... Now, find where it ends for the variable name.
  678.                 iFinal = iInicio + 1
  679.                 bFinVar = FALSE
  680.                 DO
  681.                     IF iFinal <= LEN(strExpresion) THEN
  682.                         strCaracter = UCASE$(MID$(strExpresion, iFinal, 1))
  683.                         IF (strCaracter >= "A" AND strCaracter <= "Z") OR (strCaracter >= "0" AND strCaracter <= "9") OR strCaracter = "_" THEN
  684.                             iFinal = iFinal + 1
  685.                         ELSE
  686.                             bFinVar = TRUE
  687.                         END IF
  688.                     ELSE
  689.                         bFinVar = TRUE
  690.                     END IF
  691.                 LOOP UNTIL bFinVar
  692.        
  693.                 ' Get the variable name
  694.                 strVariable = MID$(strExpresion, iInicio, iFinal - iInicio)
  695.        
  696.                 ' Add the variable to the variable list
  697.                 setNuevaVar strVariable
  698.                 iError = 0
  699.                 iInicio = iFinal
  700.                 iIniVar = 0
  701.             ELSE
  702.                 IF (strCaracter >= "0" AND strCaracter <= "9") OR strCaracter = "." THEN
  703.                     IF iIniVar = 0 THEN
  704.                         iIniVar = iInicio
  705.                     END IF
  706.                 ELSE
  707.                     iIniVar = 0
  708.                 END IF
  709.                 iInicio = iInicio + 1
  710.             END IF
  711.         LOOP
  712.     END IF
  713.  
  714.  
  715. ' Private procedure to calculate the formula,
  716. '  includes the verification of the law of the signs (Alejandro Juarez).
  717. FUNCTION LimpiaFormula# (strFormula AS STRING)
  718.     DIM iPos AS INTEGER
  719.     DIM i AS INTEGER
  720.     DIM strSignos AS STRING
  721.     DIM strLey AS STRING
  722.    
  723.     ' Gets rid of blank spaces to test the law of signs
  724.     DO
  725.         iPos = INSTR(strFormula, SPACE$(1))
  726.         IF iPos > 0 THEN
  727.             strFormula = MID$(strFormula, 1, iPos - 1) + MID$(strFormula, iPos + 1)
  728.         END IF
  729.     LOOP UNTIL iPos = 0
  730.    
  731.     ' Do the modifications according the law of signs ( - by + equals - ), etcetera.
  732.     strSignos = "+++--+--"
  733.     FOR i = 1 TO 4
  734.         strLey = MID$(strSignos, 1, 2)
  735.         DO
  736.             iPos = INSTR(strFormula, strLey)
  737.             IF iPos > 0 THEN
  738.                 SELECT CASE strLey
  739.                     CASE "++", "--"
  740.                         strFormula = MID$(strFormula, 1, iPos - 1) + "+" + MID$(strFormula, iPos + 2)
  741.                     CASE "+-", "-+"
  742.                         strFormula = MID$(strFormula, 1, iPos - 1) + "-" + MID$(strFormula, iPos + 2)
  743.                 END SELECT
  744.             END IF
  745.         LOOP UNTIL iPos = 0
  746.         strSignos = MID$(strSignos, 3)
  747.     NEXT
  748.     LimpiaFormula = CalculaFormula(strFormula)
  749.  
  750.  
  751. ' Returns the name of the variable in the indicated possition
  752. FUNCTION NombreVar$ (iCualVariable AS INTEGER)
  753.     ' Var
  754.     SHARED iError AS INTEGER
  755.     SHARED aregVariables() AS RegistroVar
  756.  
  757.     iError = 0
  758.     IF iCualVariable > 0 AND iCualVariable <= UBOUND(aregVariables) THEN
  759.         NombreVar = RTRIM$(aregVariables(iCualVariable).Nombre)
  760.     ELSE
  761.         iError = 2
  762.         NombreVar = ""
  763.     END IF
  764.  
  765.  
  766.  
  767. ' Gets the number at the right of the sign
  768. FUNCTION NumDer# (strCadena AS STRING, iPos AS INTEGER, iPosD AS INTEGER)
  769.     ' Var
  770.     DIM strCar AS STRING * 1
  771.     DIM bNumero AS INTEGER
  772.     DIM strNumDer AS STRING
  773.  
  774.     iPosD = iPos + 1
  775.     bNumero = FALSE
  776.     strNumDer = ""
  777.     IF iPosD <= LEN(strCadena) THEN
  778.         DO
  779.             strCar = MID$(strCadena, iPosD, 1)
  780.             IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" OR strCar = "+" THEN
  781.                 'IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" THEN
  782.                 IF (strCar >= "0" AND strCar <= "9") OR strCar = "." THEN
  783.                     bNumero = TRUE
  784.                 END IF
  785.        
  786.                 IF iPosD < LEN(strCadena) THEN
  787.                     IF (strCar = "-" OR strCar = "+") AND NOT bNumero THEN
  788.                         ' IF strCar = "-" AND NOT bNumero THEN
  789.                         iPosD = iPosD + 1
  790.                         bNumero = TRUE
  791.                         strNumDer = strNumDer + strCar
  792.                     ELSEIF strCar <> "-" AND strCar <> "+" THEN
  793.                         iPosD = iPosD + 1
  794.                         strNumDer = strNumDer + strCar
  795.                     ELSEIF strCar = "-" OR strCar = "+" THEN
  796.                         iPosD = iPosD - 1
  797.                         EXIT DO
  798.                     END IF
  799.                 ELSE
  800.                     strNumDer = strNumDer + strCar
  801.                     EXIT DO
  802.                 END IF
  803.             ELSE
  804.                 iPosD = iPosD - 1
  805.                 EXIT DO
  806.             END IF
  807.         LOOP
  808.  
  809.  
  810.         NumDer = CDBL(VAL(strNumDer))
  811.         ' NumDer = VAL(LTRIM$(RTRIM$(MID$(strCadena, iPos + 1, iPosD - iPos))))
  812.     ELSE
  813.         NumDer = 0
  814.     END IF
  815.  
  816.  
  817.  
  818.  
  819. ' Gets the number at the left of the sign
  820. FUNCTION NumIzq# (strCadena AS STRING, iPos AS INTEGER, iPosI AS INTEGER)
  821.     ' Var
  822.     DIM strCar AS STRING * 1
  823.  
  824.  
  825.     iPosI = iPos - 1
  826.  
  827.  
  828.     IF iPosI > 0 THEN
  829.         DO
  830.             strCar = MID$(strCadena, iPosI, 1)
  831.             IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" THEN
  832.                 IF iPosI > 1 THEN
  833.                     IF (INSTR(strCadena, "^") > 0 OR INSTR(strCadena, "*") > 0 OR INSTR(strCadena, "/") > 0 OR INSTR(strCadena, "+") > 0) AND strCar = "-" THEN
  834.                         '***** CODIGO CORREGIDO ******'
  835.                         IF strCar = "-" THEN
  836.                             EXIT DO
  837.                         END IF
  838.                         iPosI = iPosI - 1
  839.                     ELSEIF strCar <> "-" THEN
  840.                         iPosI = iPosI - 1
  841.                     ELSE
  842.                         EXIT DO
  843.                     END IF
  844.                 ELSE
  845.                     EXIT DO
  846.                 END IF
  847.             ELSE
  848.                 iPosI = iPosI + 1
  849.                 EXIT DO
  850.             END IF
  851.         LOOP
  852.  
  853.  
  854.         NumIzq = VAL(LTRIM$(MID$(strCadena, iPosI, iPos - iPosI)))
  855.     ELSE
  856.         NumIzq = 0
  857.     END IF
  858.  
  859.  
  860. ' Set the string to evaluate
  861. SUB setExpresion (strCualExpresionEvaluar AS STRING)
  862.     ' Var
  863.     SHARED strExpresion AS STRING
  864.  
  865.  
  866.     strExpresion = strCualExpresionEvaluar
  867.  
  868.  
  869. ' Ads a variable to the context.
  870. ' If the variable already exists, it will not add it
  871. '  and returns an error.
  872. SUB setNuevaVar (strNombre AS STRING)
  873.     ' Var
  874.     DIM i AS INTEGER
  875.     DIM j AS INTEGER
  876.     REDIM aregX(0 TO 0) AS RegistroVar
  877.     SHARED iError AS INTEGER
  878.     SHARED aregVariables() AS RegistroVar
  879.          
  880.     ' Check if this variable name already exists
  881.     iError = 0
  882.     IF SinAcentos(strNombre) THEN
  883.         i = BuscaVar(strNombre)
  884.  
  885.  
  886.         IF i = 0 THEN
  887.             i = UBOUND(aregVariables) + 1
  888.             REDIM aregX(0 TO i) AS RegistroVar
  889.             FOR j = 1 TO i - 1
  890.                 aregX(j) = aregVariables(j)
  891.             NEXT j
  892.             REDIM aregVariables(0 TO i) AS RegistroVar
  893.             FOR j = 1 TO i - 1
  894.                 aregVariables(j) = aregX(j)
  895.             NEXT j
  896.             aregVariables(i).Nombre = strNombre
  897.             aregVariables(i).Valor = ""
  898.             ERASE aregX
  899.         ELSE
  900.             iError = 7
  901.         END IF
  902.     END IF
  903.  
  904.  
  905. ' Sets a new value (varValor) to the indicated variable name (varVariable)
  906. SUB setNuevoValor (varVariable AS STRING, varValor AS DOUBLE)
  907.     ' Var
  908.     DIM i AS INTEGER
  909.     SHARED iError AS INTEGER
  910.     SHARED aregVariables() AS RegistroVar
  911.  
  912.  
  913.     iError = 0
  914.     i = VAL(varVariable)
  915.     IF i = 0 THEN
  916.         i = BuscaVar(varVariable)
  917.     END IF
  918.  
  919.  
  920.     IF i > 0 AND i <= UBOUND(aregVariables) THEN
  921.         LSET aregVariables(i).Valor = MKD$(varValor)
  922.     END IF
  923.  
  924.  
  925. ' This function determines if the string has accents or strange characters
  926. FUNCTION SinAcentos% (strCadena AS STRING)
  927.     DIM i AS INTEGER
  928.     DIM strCaracter AS STRING * 1
  929.     DIM bCorrecto AS INTEGER
  930.     SHARED iError AS INTEGER
  931.  
  932.     ' Evaluate if there are characters beyond 127 in the string
  933.     iError = 0
  934.     bCorrecto = TRUE
  935.     i = 127
  936.     DO WHILE bCorrecto AND i < 256
  937.         strCaracter = CHR$(i)
  938.         IF INSTR(strCadena, strCaracter) > 0 THEN
  939.             iError = 1
  940.             bCorrecto = FALSE
  941.         END IF
  942.         i = i + 1
  943.     LOOP
  944.     SinAcentos = bCorrecto
  945.  
  946.  
  947. ' Substitues variable names with values in the string
  948. FUNCTION SustituyeVars$ ()
  949.     ' Var
  950.     DIM strMalos AS STRING
  951.     DIM iEncontrado AS INTEGER
  952.     DIM strVariable AS STRING
  953.     DIM strCaracter AS STRING * 1
  954.     DIM bCorrecto AS INTEGER
  955.     DIM j AS INTEGER
  956.     DIM x AS INTEGER
  957.     DIM strCadena AS STRING
  958.     SHARED strExpresion AS STRING
  959.     SHARED aregVariables() AS RegistroVar
  960.  
  961.  
  962.     strCadena = UCASE$(strExpresion)
  963.     strMalos = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
  964.     x = UBOUND(aregVariables)
  965.     FOR j = 1 TO x
  966.         strVariable = UCASE$(RTRIM$(aregVariables(j).Nombre))
  967.         iEncontrado = 1
  968.         DO
  969.             iEncontrado = INSTR(iEncontrado, strCadena, strVariable)
  970.             IF iEncontrado > 0 THEN
  971.                 bCorrecto = TRUE
  972.                 IF iEncontrado > 1 THEN
  973.                     strCaracter = MID$(strCadena, iEncontrado - 1, 1)
  974.                     bCorrecto = (INSTR(strMalos, strCaracter) = 0)
  975.                 END IF
  976.  
  977.  
  978.                 IF bCorrecto THEN
  979.                     strCaracter = MID$(strCadena, iEncontrado + LEN(strVariable), 1)
  980.                     bCorrecto = (INSTR(strMalos, strCaracter) = 0)
  981.                 END IF
  982.  
  983.  
  984.                 IF bCorrecto THEN
  985.                     strCadena = LEFT$(strCadena, iEncontrado - 1) + LTRIM$(STR$(Valor(strVariable))) + MID$(strCadena, iEncontrado + LEN(strVariable))
  986.                     iEncontrado = 1
  987.                 ELSE
  988.                     iEncontrado = iEncontrado + 1
  989.                 END IF
  990.             ELSE
  991.                 iEncontrado = 1
  992.             END IF
  993.         LOOP UNTIL INSTR(iEncontrado, strCadena, strVariable) = 0
  994.     NEXT j
  995.  
  996.  
  997.     SustituyeVars = strCadena
  998.  
  999.  
  1000. ' Gets the value of the variable indicated in varVariable
  1001. FUNCTION Valor# (varVariable AS STRING)
  1002.     ' Var
  1003.     DIM i AS INTEGER
  1004.     SHARED aregVariables() AS RegistroVar
  1005.     SHARED iError AS INTEGER
  1006.  
  1007.  
  1008.     iError = 0
  1009.     i = VAL(varVariable)
  1010.     IF i = 0 THEN
  1011.         i = BuscaVar(varVariable)
  1012.     END IF
  1013.  
  1014.  
  1015.     IF i > 0 AND i <= UBOUND(aregVariables) THEN
  1016.         IF RTRIM$(aregVariables(i).Valor) <> "" THEN
  1017.             Valor = CVD(aregVariables(i).Valor)
  1018.         ELSE
  1019.             Valor = 0
  1020.             iError = 4
  1021.         END IF
  1022.     ELSE
  1023.         Valor = 0
  1024.         iError = 2
  1025.     END IF
  1026.  
  1027.  
  1028.  
  1029.  
  1030. ' Verifies if all assigned variables have values
  1031. FUNCTION VerificaVar% ()
  1032.     ' Var
  1033.     DIM bCorrecto AS INTEGER
  1034.     DIM x AS INTEGER
  1035.     DIM i AS INTEGER
  1036.     SHARED iError AS INTEGER
  1037.     SHARED aregVariables() AS RegistroVar
  1038.  
  1039.  
  1040.     iError = 0
  1041.     bCorrecto = TRUE
  1042.     x = UBOUND(aregVariables)
  1043.     IF x > 0 THEN
  1044.         FOR i = 1 TO x
  1045.             IF RTRIM$(aregVariables(i).Valor) = "" THEN
  1046.                 iError = 4
  1047.                 bCorrecto = FALSE
  1048.                 EXIT FOR
  1049.             END IF
  1050.         NEXT i
  1051.     END IF
  1052.     VerificaVar = bCorrecto
  1053.  
  1054.  
  1055.  
* MEANQB64-v1.1.BAS (Filesize: 34 KB, Downloads: 128)
Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #5 on: August 26, 2020, 02:39:22 pm »
yes i get 60 in microA...
anyway nice program !


Thank you, Aurel. Please, try the new version 1.1 that I just uploaded. I hope everything runs ok.


Saludos cordiales,
Tron.BAS
Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #6 on: August 26, 2020, 03:29:40 pm »
Quote
So if I got the number 0.012, it is converted into 1.2000000000000001D-2. I tried to get rid through numeric rounds of the scientific notation, but the environment turned it back into scientific notation adding another number at the end (3 or 2 or other). This doesn't happen in QB45 nor VB-DOS where I was testing the code. I had a kind of nightmare trying to resolve this in QB64. Then, I had to do a workaround with string manipulation to get rid of this problem.

Ha! yeah, since you posted originally I had devised my own set of String math routines. It seems scientific notation system is constantly getting in the way of display of accurate results.

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #7 on: August 26, 2020, 04:37:16 pm »
Ha! yeah, since you posted originally I had devised my own set of String math routines. It seems scientific notation system is constantly getting in the way of display of accurate results.
Had to do a very tricky workaround to address it.
Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #8 on: August 26, 2020, 04:55:10 pm »
Had to do a very tricky workaround to address it.

Code: [Select]
FUNCTION N2S$ (EXP$) 'scientific Notation to String
 
    'PRINT "Before notation:"; exp$
 
    t$ = LTRIM$(RTRIM$(EXP$))
    IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
 
    dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
    ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
    check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
    IF check1 < 1 OR check1 > 1 THEN N2S = EXP$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
 
    SELECT CASE l 'l now tells us where the SN starts at.
        CASE IS < dp: l = dp
        CASE IS < dm: l = dm
        CASE IS < ep: l = ep
        CASE IS < em: l = em
    END SELECT
 
    l$ = LEFT$(t$, l - 1) 'The left of the SN
    r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
 
 
    IF INSTR(l$, ".") THEN 'Location of the decimal, if any
        IF r&& > 0 THEN
            r&& = r&& - LEN(l$) + 2
        ELSE
            r&& = r&& + 1
        END IF
        l$ = LEFT$(l$, 1) + MID$(l$, 3)
    END IF
 
    SELECT CASE r&&
        CASE 0 'what the heck? We solved it already?
            'l$ = l$
        CASE IS < 0
            FOR i = 1 TO -r&&
                l$ = "0" + l$
            NEXT
            l$ = "0." + l$
        CASE ELSE
            FOR i = 1 TO r&&
                l$ = l$ + "0"
            NEXT
    END SELECT
 
    N2S$ = sign$ + l$
    'PRINT "After notation:"; N2S$
END SUB

One of the functions from my math evaluator; it converts scientific notation into a string for string processing.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #9 on: August 26, 2020, 07:37:39 pm »
FUNCTION N2S$ (EXP$) 'scientific Notation to String
One of the functions from my math evaluator; it converts scientific notation into a string for string processing.


Wow! I think I will integrate your code in my code (with the corresponding credit, for sure).
Saludos cordiales,

A. David Garza Marín (Tron.BAS)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: MEANALYZ: Math Expressions Analyzer V.1.0b
« Reply #10 on: August 26, 2020, 09:07:15 pm »
Code: [Select]
FUNCTION N2S$ (EXP$) 'scientific Notation to String
 
    'PRINT "Before notation:"; exp$
 
    t$ = LTRIM$(RTRIM$(EXP$))
    IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
 
    dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
    ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
    check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
    IF check1 < 1 OR check1 > 1 THEN N2S = EXP$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
 
    SELECT CASE l 'l now tells us where the SN starts at.
        CASE IS < dp: l = dp
        CASE IS < dm: l = dm
        CASE IS < ep: l = ep
        CASE IS < em: l = em
    END SELECT
 
    l$ = LEFT$(t$, l - 1) 'The left of the SN
    r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
 
 
    IF INSTR(l$, ".") THEN 'Location of the decimal, if any
        IF r&& > 0 THEN
            r&& = r&& - LEN(l$) + 2
        ELSE
            r&& = r&& + 1
        END IF
        l$ = LEFT$(l$, 1) + MID$(l$, 3)
    END IF
 
    SELECT CASE r&&
        CASE 0 'what the heck? We solved it already?
            'l$ = l$
        CASE IS < 0
            FOR i = 1 TO -r&&
                l$ = "0" + l$
            NEXT
            l$ = "0." + l$
        CASE ELSE
            FOR i = 1 TO r&&
                l$ = l$ + "0"
            NEXT
    END SELECT
 
    N2S$ = sign$ + l$
    'PRINT "After notation:"; N2S$
END SUB

One of the functions from my math evaluator; it converts scientific notation into a string for string processing.

That does look handy!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MEANALYZ: Math Expressions Analyzer V.1.1
« Reply #11 on: August 26, 2020, 10:02:03 pm »
You guys might want to take a look at it here sometime:  https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989

It deals with type symbols (%,!,#,##,&,&&,%% -- even the unsigned ~ types), scientific notation, string addition, math, multiplication, orders of precedence, duplicate symbols (-- becomes +, +- becomes -, ect), tons of possible error messages...

There's a lot of useful little functions and routines in it.  Feel free to use whatever you'd like from it.  Believe it or not, you've used it countless times already, and have probably contributed to stress-testing and error-checking of it already.  All you have to do is look in QB64.BAS, and you'll see Steve's Math Evaluator is what we use internally to calculate values anytime you enter a formula into a CONST...  ;D
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline adgarza

  • Newbie
  • Posts: 8
  • Winners are losers who never gave up
    • View Profile
    • Painless computing (Spanish)
Re: MEANALYZ: Math Expressions Analyzer V.1.1
« Reply #12 on: August 27, 2020, 03:01:48 pm »
You guys might want to take a look at it here sometime:  https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989


I will... I am sure I will learn from your code...
Saludos cordiales,

A. David Garza Marín (Tron.BAS)