Procesar Expresiones


Actualizado: 10-May-97

(09/Feb/99) Pulsa aquí si quieres ver la nueva versión de este código...

Pulsa este link si quieres ver las revisiones del 11 y 22/Ene/2001

Nota del 02/Nov/2002:
Te recomiendo que veas el contenido de esta página que te mantendrá al día



Este es un módulo que tenía para procesar expresiones en BASIC, con sus variables y todo ese rollo.
Lo he retomado por una consulta que me hicieron, que al final resultaron dos del mismo tema.
Así que aquí la pongo para el que la quiera usar, se admiten sugerencias, mejoras y si la amplias, me lo cuentas.

Si quieres bajar los listados, pincha aquí.

El procedimiento Formula recibe dos parámetros, el primero es la expresión a procesar y el segundo son las variables a usar, el resultado se devuelve en el segundo parámetro, por tanto el segundo debe ser una variable.
Por ejemplo:
sVar$ = "A=10, B=25, C=(B-A)/2"
sForm$ = "A * B + INT(10*C)"
Formula sForm, sVar
Devolvería 325

O sea, que una variable puede estar formada por una expresión y usando los valores de otras varibales.
Los únicos "operadores" que reconoce son, además de los clásicos +, -, /, *. ^ también entiende el INT y se puede usar un IF/ELSE un tanto particular, por ejemplo:
IF B>10;A*2 ;ELSE A/2
Se debe usar un punto y coma (;) después de la expresión a evaluar y otro delante del ELSE, sé que es rudimentario, pero algo es algo.

De todas formas a ver si encuentro un "intérprete" de BASIC que me fabriqué y que lo tengo que tener por ahí, ya que creo que en él tenía mejorado el tema del cálculo de las expresiones además de permitir más "instrucciones"

Bien, vamos a ver el listado y además acompaño un form de prueba, para que veas que funciona.
Tal como está el programa ahora mismo, sólo acepta variables de una sola letra, pero eso será fácil de modificar, espero, también hay que aclarar que sólo procesa de izquierda a derecha, salvo que se usen paréntesis, es decir que en basic la multiplicación y división se procesan antes que la suma o la resta, en esta versión no se hace así, por tanto:

10 + 2 * 3 dará como resultado 36 (12 * 3)
Sin embargo esta expresión producirá el resultado esperado:
10 + (2 * 3) dará 16 (10+ 6)

Si en la expresión pasada como fórmula se incluye una variable que no existe, simplemente se ignora y si se hace una asignación, se tomará el valor que hay después del signo igual, eliminándose la asignación, osea que cualquier carácter no "esperado", simplemente se ignora.
Por ejemplo: X=10+25*A será lo mismo que 10+25*A y lo mismo que X=10+25*A+X
Es decir como X no se ha declarado, se ignora totalmente, se supone que A tiene asignado un valor

Como verás es un poco "añejo", pero a mi me ha servido para un programa de "caja-diaria"

'----------------------------------------------------------------------------
' Formula.bas                                                    (25/Sep/91)
'
'Adaptado a Visual Basic                            (10/Jun/97)
'
'(c)Guillermo Som, 1991-97
'
' Módulo con SUBprograma de proceso de fórmulas.
' Inicio : 25/Sep/91
' Término: 22/Oct/91
'          25/Oct/91         Añado condiciones IF ...
'           5/May/93         Añado condiciones ELSE ...
'          10/May/93         Corrección para números negativos,
'                            Nueva proceso para Calcular...
'
' Queda por mejorar el cálculo de variables, para meter entre paréntesis
' cuando sea una expresión en lugar de un valor constante.
' (El 5/May/93, ya estaba mejorado de antes, además de más condiciones en IF)
'----------------------------------------------------------------------------

Option Explicit


Private Sub BuscarCifra(Expresion$, Cifra$)
    '-------------------------------------------------------------------------
    'Buscar en f$ una cifra                                  ( 5 / 10/May/93)
    '-------------------------------------------------------------------------
    
    Const OPERADORES = "+-*/^%"
    Const CIFRAS = "0123456789. "
    Const POSITIVO = 1, NEGATIVO = -1
    
    Dim Signo%, ultima%, i%, n$
    
    Expresion$ = LTrim$(Expresion$)
    
    Signo = POSITIVO                    'Comprobar si es un número negativo
    If Left$(Expresion$, 1) = "-" Then
        Signo = NEGATIVO
        Expresion$ = Mid$(Expresion$, 2)
    End If
    
    ultima = 0
    n$ = ""
    For i = 1 To Len(Expresion$)
        If InStr(CIFRAS, Mid$(Expresion$, i, 1)) Then
            n$ = n$ + Mid$(Expresion$, i, 1)
            ultima = i
        Else
            Exit For
        End If
    Next i
    Cifra$ = Str$(Val(n$) * Signo)
    Expresion$ = LTrim$(Mid$(Expresion$, ultima + 1))
End Sub


Private Sub Calcular(f$)
    '--------------------------------------------------------------------------
    ' Calcula el resultado de la expresión que entra en f$         (22/Oct/91)
    ' Modificado por la cuenta de la vieja...                (01.12  7/May/93)
    '--------------------------------------------------------------------------
    Dim Operador$, Cifra1$, Cifra2$
    Dim n1#, n2#, n3#
    
    Operador$ = ""
    Cifra1$ = ""
    Cifra2$ = ""
    
    Do
        '---Buscar la primera cifra
        If Cifra1$ = "" Then
            BuscarCifra f$, Cifra1$
        End If
        Operador$ = Left$(f$, 1)
        f$ = Mid$(f$, 2)
        '---Buscar la segunda cifra
        BuscarCifra f$, Cifra2$
        
        n1# = Val(Cifra1$)
        n2# = Val(Cifra2$)
        Select Case Operador$
        Case "+"
            n3# = n1# + n2#
        Case "-"
            n3# = n1# - n2#
        Case "*"
            n3# = n1# * n2#
        Case "/"
            If n2# <> 0# Then
                n3# = n1# / n2#
            Else
                n3# = 0#
            End If
        Case "^"
            n3# = n1# ^ n2#
        Case "%"
            n3# = n1# * (n2# / 100#)
        Case Else
            n3# = CDbl(Val(Cifra1$) + Val(Cifra2$))
        End Select
        Cifra1$ = Str$(n3#)
    Loop While Operador$ <> ""
    f$ = Str$(n3#)
End Sub


Public Sub Formula(Form$, Variable$)
    '--------------------------------------------------------------(25/Sep/91)-
    ' Calcula la Formula$, usando los valores de Variable$
    ' devuelve el resultado al principio de Variable$, R=resultado
    ' Las variables deben ser una sola letra y deben estar separadas por comas
    '--------------------------------------------------------------------------
    Const DIGITOS = "0123456789."
    Const SIGNOS = "+-*/%() "
    
    Dim f$, Entero%, NumVar%, NombreVar$
    Dim v$, i%, j%, k%, a$, Condicion%
    Dim Cond$, Operador$, VarAct$, valor$
    Dim p%, haymas%, pn%, strP$
    
    f$ = Form$
    v$ = Variable$
    Entero = 0
    '--------------------------------------------------------------------------
    ' Sustituir las variables dentro de la formula por el valor
    '--------------------------------------------------------------------------
    f$ = LTrim$(RTrim$(UCase$(f$)))
    v$ = LTrim$(RTrim$(UCase$(v$)))
    '--------------------------------------------------------------------------
    'Quitar los espacios entre el nombre de la variable y el signo = (10/Jun/97)
    '--------------------------------------------------------------------------
    QuitarEspacios v$
    '--------------------------------------------------------------------------
    ' Para comprobar si hay más variables                          (21/Oct/91)
    '--------------------------------------------------------------------------
    NumVar = 0
    NombreVar$ = ""
    For i = 1 To Len(v$)
        If Mid$(v$, i, 1) = "=" Then
            NombreVar$ = NombreVar$ + Mid$(v$, i - 1, 1)
            NumVar = NumVar + 1
        End If
    Next
    '--------------------------------------------------------------------------
    ' Guardar los valores de las variables                         (25/Oct/91)
    '--------------------------------------------------------------------------
    ReDim NomVar$(1 To NumVar)
    NumVar = 0
    For j = 1 To Len(v$)
        If Mid$(v$, j, 1) = "=" Then
            NumVar = NumVar + 1
            For k = j + 1 To Len(v$)
                a$ = Mid$(v$, k, 1)
                If a$ = "," Then
                    Exit For
                Else
                    NomVar$(NumVar) = NomVar$(NumVar) + a$
                End If
            Next
        End If
    Next
    
    '--------------------------------------------------------------------------
    ' Se permiten condiciones en las fórmulas.                     (25/Oct/91)
    ' El formato será: IF <variable> OPERADOR <condición>;<fórmula>
    ' Si la <condición> es númerica, la comparación se hace como números.
    ' Ejemplo: IF A=10;INT(A+B*.05)
    '--------------------------------------------------------------------------
    If Left$(f$, 2) = "IF" Then
        i = InStr(f$, ";")
        Condicion = True
        If i Then
            Cond$ = LTrim$(RTrim$(Mid$(f$, 3, i - 3)))
            f$ = Mid$(f$, i + 1)
            '----------------------------------------------------------------------
            ' Comprobar la condición.
            ' Condiciones permitidas: igual (=), distinta (!=), menor (<), mayor (>)
            ' menor o igual (<=, =<), mayor o igual (>=, =>)
            ' El primer operando debe ser una variable.
            '----------------------------------------------------------------------
            Operador$ = Mid$(Cond$, 2, 2)
            VarAct$ = Left$(Cond$, 1)
            If InStr("=< => >= <=", Operador$) Then
                j = InStr(NombreVar$, VarAct$)
                valor$ = Mid$(Cond$, 4)
                k = Val(valor$)
                Condicion = False
                If InStr("=< <=", Operador$) Then        'Menor o igual
                    If k Then
                        If Val(NomVar$(j)) <= Val(valor$) Then Condicion = True
                    Else
                        If NomVar$(j) <= valor$ Then Condicion = True
                    End If
                ElseIf InStr("=> >=", Operador$) Then    'Mayor o igual
                    If k Then
                        If Val(NomVar$(j)) >= Val(valor$) Then Condicion = True
                    Else
                        If NomVar$(j) >= valor$ Then Condicion = True
                    End If
                End If
            ElseIf InStr("< >", Mid$(Cond$, 2, 1)) Then
                j = InStr(NombreVar$, VarAct$)
                valor$ = Mid$(Cond$, 3)
                k = Val(valor$)
                Condicion = False
                If Mid$(Cond$, 2, 1) = "<" Then          'Menor
                    If k Then
                        If Val(NomVar$(j)) < Val(valor$) Then Condicion = True
                    Else
                        If NomVar$(j) < valor$ Then Condicion = True
                    End If
                ElseIf Mid$(Cond$, 2, 1) = ">" Then      'Mayor
                    If k Then
                        If Val(NomVar$(j)) > Val(valor$) Then Condicion = True
                    Else
                        If NomVar$(j) > valor$ Then Condicion = True
                    End If
                End If
            ElseIf Mid$(Cond$, 2, 1) = "=" Then        '=  Igual
                If InStr(v$, Cond$) = 0 Then
                    Condicion = False
                End If
            ElseIf Operador$ = "!=" Then               '!= Distinta
                Cond$ = Left$(Cond$, 1) + Mid$(Cond$, 3)
                If InStr(v$, Cond$) Then
                    Condicion = False
                End If
            End If
        Else
                Condicion = False
        End If
        If Not Condicion Then
            '----------------------------------------------------------------------
            ' Evaluar ELSE (;E/;ELSE)                            (16.37  5/May/93)
            '----------------------------------------------------------------------
            If InStr(f$, ";E") Then
                i = InStr(f$, ";ELSE")
                If i Then
                    i = i + 5
                Else
                    i = InStr(f$, ";E") + 2
                End If
                f$ = Mid$(f$, i)
                Condicion = True
            End If
            If Not Condicion Then
                Variable$ = ""
                Exit Sub
            End If
        Else
            If InStr(f$, ";") Then
                i = InStr(f$, ";")
                f$ = Left$(f$, i - 1)
            End If
        End If
    End If
    
    '----------------------------------------------
    'Admite que se convierta en entero  (22/Oct/91)
    '----------------------------------------------
    If Left$(f$, 3) = "INT" Then
        Entero = 1
        f$ = Mid$(f$, 4)
    End If
    
    Do
        i = 1
        Do
            a$ = Mid$(f$, i, 1)
            If InStr(DIGITOS + SIGNOS, a$) = 0 Then
                p = InStr(NombreVar$, a$)      'debe ser una variable
                If p Then
                    f$ = Left$(f$, i - 1) + NomVar$(p) + Mid$(f$, i + 1)
                End If
            End If
            i = i + 1
        Loop Until i > Len(f$)
        
        haymas = 0                         'Comprobar si hay más variables
        For i = 1 To NumVar
            If InStr(f$, Mid$(NombreVar$, i, 1)) Then
                haymas = 1
                Exit For
            End If
        Next
    Loop While haymas
    '--------------------------------------------------------------------------
    ' Procesar la fórmula con los valores de las variables
    '--------------------------------------------------------------------------
    '
    'Buscar paréntesis e ir procesando las expresiones.
    Do While InStr(f$, "(")
        pn = InStr(f$, ")")
        If pn = 0 Then
            Variable$ = "R= 0, " + Variable$
            Exit Sub
        End If
        For i = pn To 1 Step -1
            If Mid$(f$, i, 1) = "(" Then
                strP = Mid$(f$, i + 1, pn - i - 1)
                Calcular strP
                f$ = Left$(f$, i - 1) + strP + Mid$(f$, pn + 1)
                Exit For
            End If
        Next
    Loop
    
    Calcular f$
    'Variable$ = "R=" + f$ + ", " + Variable$
    If Entero Then
        f$ = Str$((Int(Val(f$) + 0.5)))
    End If
    Variable$ = f$
End Sub


Private Sub QuitarEspacios(sVar As String)
    'Quitar los espacios de sVar
    Dim i As Integer
    Dim sTmp  As String
    
    sTmp = sVar
    sVar = ""
    For i = 1 To Len(sTmp)
        If Mid$(sTmp, i, 1) <> " " Then
            sVar = sVar & Mid$(sTmp, i, 1)
        End If
    Next
End Sub

Este es el formulario de prueba, una "foto" y el listado:

Formulario de prueba

'--------------------------------------------------------------
'Form para probar las rutinas de fórmulas           (10/Jun/97)
'
'(c)Guillermo Som, 1997
'--------------------------------------------------------------
Option Explicit

'Constantes para los TextBox
Const cTxtNombreVar = 0
Const cTxtValorVar = 1
Const cTxtFormula = 2

'constantes para los labels
Const cLblResultado = 4


Private Sub cmdAddVar_Click()
    'Añadir el contenido de a la lista de variables
    Dim sTmp As String
    
    sTmp = Text1(cTxtNombreVar) & " = " & Text1(cTxtValorVar)
    List1.AddItem sTmp
End Sub


Private Sub cmdBorrarVar_Click()
    'Borrar la variable que está seleccionada del ListBox
    Dim i%
    
    With List1
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                .RemoveItem i
            End If
        Next
    End With
End Sub


Private Sub cmdCalcular_Click()
    Dim sVar$, sFormula$
    Dim i%
    
    
    If List1.ListCount < 1 Then
        MsgBox "No hay variables asignadas..." & vbCrLf & "Si se especifica alguna en la fórmula, se ignorará."
    End If
    For i = 0 To List1.ListCount - 1
        sVar$ = sVar$ & List1.List(i) & ","
    Next
    'quitar la última coma
    If Right$(sVar, 1) = "," Then
        sVar = Left$(sVar, Len(sVar) - 1)
    End If
    'Procesar la fórmula
    sFormula = Text1(cTxtFormula)
    
    cmdCalcular.Caption = "Calculando..."
    Formula sFormula, sVar
    Label1(cLblResultado) = sVar
    cmdCalcular.Caption = "Probar Fórmula"
End Sub


Private Sub Form_Load()
    'inicio
    'Variables a probar
    '"A=10,B=2,C=(A+B),D=(C+B)"
    '"A=2000, B=-500"
    'Fórmulas a probar
    '"(10 +(A*3) -5 +B +C +D)"
    '"D*(100-3*C)+B*(3*(A-2))"
    '"INT(" + Form$ + "*(99990000+(10%)))"
    '"IF B>10;(1) ;ELSE (2)"
    '"(1000 + B - A)"
    '"INT(((1000 + B - A)*2)*(-1) + B*2 + A*2.5+.6)-1"
    Dim i%
    For i = 0 To 2
        Text1(i) = ""
    Next
    Label1(cLblResultado) = ""
    With List1
        .AddItem "A = 2000"
        .AddItem "B = -500"
        .AddItem "C=(A+B)"
        .AddItem "D=(C+B)"
    End With
    Text1(cTxtFormula) = "(1000 + B - A) - C * 2 + D"
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
End Sub


Private Sub List1_Click()
    'Recuperar la variable
    Dim sTmp As String
    Dim i As Integer
    
    With List1
        If .ListIndex > -1 Then
            sTmp = .List(.ListIndex)
            i = InStr(sTmp, "=")
            If i Then
                Text1(cTxtNombreVar) = Trim$(Left$(sTmp, i - 1))
                Text1(cTxtValorVar) = Trim$(Mid$(sTmp, i + 1))
            End If
        End If
    End With
End Sub

ir al índice principal