11111010111 1010 1011

Programar por Programar


¿Te gusta programar?
Inicio


El código de EvaluarExpresiones


Esta clase forma parte de elGuille.EvaluarExpresiones.dll


Publicado: 13/Oct/2007
Actualizado: 13/Oct/2007
Autor: Guillermo 'guille' Som


El código de la clase EvaluarExpresiones
'------------------------------------------------------------------------------
' Evaluar expresiones                                               (01/Oct/07)
' Evaluar expresiones numéricas simples a partir de una cadena
'
' Compilado como una DLL                                            (04/Oct/07)
'
'
' ©Guillermo 'guille' Som, 2007
'
' El espacio de nombre de esta librería es:
' elGuille.Developer
'------------------------------------------------------------------------------
Option Strict On
Option Compare Text

Imports Microsoft.VisualBasic
Imports System

Imports System.Collections.Generic
Imports System.Text
Imports System.Threading

Imports System.Globalization

Imports System.Reflection
Imports System.Diagnostics

''' <summary>
''' Evaluar expresiones aritméticas
''' Se admiten: +, -, *, x, /, ^, %, \u412?
''' </summary>
''' <remarks>
''' El signo \u412? se usa para Mod
''' El signo % se usa para calcular porcentajes
''' </remarks>
Public Class EvaluarExpresiones

    Protected Const letras As String = "abcdefghijklmnopqrstuvwxyz"
    Protected Const cifras As String = "0123456789" 'E"

    ' el % es porcentaje
    ' el \u412? es Mod
    ' la x es para multiplicar * (lo vuelvo a añadir:       v.39    (13/Oct/07)
    Protected Const operadores As String = "^*x/\m\u623?%+-" ' \u623?\u412?

    ' Los números negativos (los marcados como negativos o positivos con - y +)
    ' se tienen en cuenta justo después de la exponenciación ^

    ' Se recorrerá de mayor proridad a menor, 
    Protected Const prioridadOp As String = operadores

    '' Los separadores, etc.                                 v.30    (12/Oct/07)
    '' contar los números como separadores...                v.31    (12/Oct/07)
    '' ¿no sería más fácil que NO sea letra?
    'Protected Const separadores As String = cifras & _
    '                                        operadores & _
    '                                        " ()[]{}<>=,;:_!#$%&'" & _
    '                                        ChrW(34) & vbCrLf & vbTab



    ''' <summary>
    ''' Comprobar si la cadena a evaluar tiene números negativos.
    ''' Si los hay, cambia el signo - (menos) por _ (subrayado)
    ''' </summary>
    ''' <param name="texto"></param>
    ''' <returns></returns>
    ''' <remarks>
    ''' 08/Oct/2007
    ''' </remarks>
    Protected Function comprobarNegativos(ByVal texto As String) As String
        ' Buscar un operador seguido de un signo - (puede tener espacios)
        ' (2 + -5) ^ 2 * 23

        ' si no hay -, salir sin hacer nada más
        Dim p As Integer = InStr(texto, "-")
        If p = 0 Then Return texto
        Dim hayOperador As Boolean = False


        For Each op As String In operadores
            p = 1
            Do
                Dim i As Integer = InStr(p, texto, op)
                If i = 0 Then Exit Do
                p = i + 1
                If op = "-" Then
                    hayOperador = True
                    ' Si es el signo -
                    ' buscar hacia atrás
                    ' si es una cifra o un operador, no es negativo
                    For j As Integer = i - 1 To 1 Step -1
                        Dim c As String = Mid(texto, j, 1)
                        Dim k As Integer = (cifras & operadores).IndexOf(c)
                        If k > -1 Then
                            hayOperador = False
                            Exit For
                        End If
                    Next
                    If hayOperador Then
                        Mid(texto, i, 1) = "_"
                    End If
                Else
                    ' Buscar un signo -
                    ' solo admitir espacios
                    ' cualquier otra cosa es que no es un número negativo
                    For j As Integer = p To Len(texto)
                        Dim c As String = Mid(texto, j, 1)
                        Dim k As Integer = cifras.IndexOf(c)
                        If k > -1 Then
                            Exit For
                        End If
                        If c = "-" Then
                            ' Es negativo
                            Mid(texto, j, 1) = "_"
                            Exit For
                        End If
                    Next
                End If
            Loop
        Next

        Return texto
    End Function

    ''' <summary>
    ''' Analiza la prioridad de los operadores
    ''' Si hay diferentes niveles los pone dentro de paréntesis
    ''' </summary>
    ''' <param name="texto"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function analizarPrioridad(ByVal texto As String) As String

        '
        '======================================================================
        ' TODO: (12/Oct/07)
        '======================================================================
        ' Para analizar los parámetros de las funciones,
        ' comprobar si la cadena tiene comas,
        ' en ese caso, agrupar los que estén en cada grupo de comas.
        '
        '======================================================================
        '

        ' Agregar el texto en el stringBuilder
        ' los cambios se harán con esta clase
        Dim sb As New StringBuilder(texto)
        Dim op1, op2 As String
        Dim p As Integer

        ' Se debe evaluar si todos los operadores son del mismo nivel
        ' en ese caso no se encierran las operaciones entre paréntesis
        Dim mismoNivel As Boolean = todosMismoNivelPri(texto)

        For Each op As String In prioridadOp
            ' Repetir mientras haya de este signo
            p = 1
            Do
                Dim i As Integer
                i = InStr(p, texto, op)
                If i = 0 Then Exit Do
                p = i + 1

                ' Buscar cifra anterior
                op1 = buscarCifra(texto, i, anterior:=True)

                ' Si es un paréntesis,
                ' es que el anterior está entre paréntesis
                ' por tanto, no evaluar.
                ' Nota:
                '   Aunque se compare con ) es un indicador
                '   de que se ha encontrado un paréntesis
                '   y por tanto no hay que evaluarlo por separado
                If op1 = ")" Then Continue Do

                op2 = buscarCifra(texto, i, anterior:=False)
                If op2 = ")" Then Continue Do

                ' Tener en cuenta el texto a reemplazar             (07/Oct/07)
                If mismoNivel = False Then
                    sb.Replace(op1 & op & op2, "(" & op1 & op & op2 & ")")
                End If
            Loop
        Next

        Return sb.ToString
    End Function

    ''' <summary>
    ''' Comprueba si todos los operadores de la expresión tienen el mismo nivel
    ''' </summary>
    ''' <param name="texto"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function todosMismoNivelPri(ByVal texto As String) As Boolean
        Dim opAnt As String = ""
        Dim p As Integer = 0
        Do
            Dim i As Integer = texto.IndexOfAny(prioridadOp.ToCharArray, p)
            If i > -1 Then
                p = i + 1
                If Len(opAnt) > 0 Then
                    If mismoNivelPri(opAnt, texto(i)) = False Then
                        Return False
                    End If
                End If
                opAnt = texto(i)
            Else
                Exit Do
            End If
        Loop

        Return True
    End Function

    ''' <summary>
    ''' Función de apoyo para todosMismoNivelPri
    ''' </summary>
    ''' <param name="op1"></param>
    ''' <param name="op2"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function mismoNivelPri(ByVal op1 As String, ByVal op2 As String) As Boolean
        If op1 = op2 Then Return True

        Select Case op1
            Case "^"
                Return False
                'Case "*", "/", "÷", ":" ', "x" ' No usar la x porque se lía con Max
            Case "*", "/", "x"
                ' If "*/÷x:".IndexOf(op2) > -1 Then
                ' If "*/÷:".IndexOf(op2) > -1 Then
                If "*x/".IndexOf(op2) > -1 Then
                    Return True
                Else
                    Return False
                End If
            Case "\"
                Return False
            Case "%", "\u412?", "\u623?", "m"
                Return False
            Case "+", "-"
                If op2 = "+" OrElse op2 = "-" Then
                    Return True
                Else
                    Return False
                End If
        End Select

        Return False
    End Function

    ''' <summary>
    ''' Buscar la siguiente cifra
    ''' </summary>
    ''' <param name="texto"></param>
    ''' <param name="i">
    ''' El valor de i será en base 1
    ''' primer caracter es el 1 no el 0
    ''' </param>
    ''' <param name="anterior"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function buscarCifra(ByVal texto As String, ByVal i As Integer, _
                                   Optional ByVal anterior As Boolean = True) As String
        Dim iPila As Integer = 0
        Dim iB, fB, pB As Integer
        Dim hayCifras As Boolean = False
        Dim ultimo As Integer = -1
        If anterior Then
            iB = i - 1
            fB = 1
            pB = -1
        Else
            iB = i + 1
            fB = texto.Length
            pB = 1
        End If

        For j As Integer = iB To fB Step pB
            Dim c As String = Mid(texto, j, 1)
            Select Case c
                Case " "
                    ' Añadirlo, pero no tenerlo en cuenta
                    ' como cifra
                    ultimo = j

                Case "(", "["
                    iPila = 0
                    If anterior Then
                        ' Solo vale si es )
                        ' salir
                        If ultimo > -1 Then
                            Exit For
                        End If
                        Return ")"
                    End If
                    iPila += 1 ' push
                    ' seguir buscando la pareja
                    For k As Integer = j + pB To fB Step pB
                        If Mid(texto, k, 1) = "(" Then
                            iPila += 1 ' push
                        End If
                        If Mid(texto, k, 1) = ")" Then
                            iPila -= 1 ' pop
                            If iPila = 0 Then
                                ' Lo hemos encontrado
                                ultimo = k
                                j = fB
                                Exit For
                            End If
                        End If
                    Next

                Case ")", "]"
                    iPila = 0
                    If anterior = False Then
                        ' Solo vale si es (
                        ' salir
                        ' pero no si hay alguna cifra
                        If ultimo > -1 Then
                            Exit For
                        End If
                        Return ")"
                    End If
                    iPila += 1 ' push
                    ' seguir buscando la pareja
                    For k As Integer = j + pB To fB Step pB
                        If Mid(texto, k, 1) = ")" Then
                            iPila += 1 ' push
                        End If
                        If Mid(texto, k, 1) = "(" Then
                            iPila -= 1 ' pop
                            If iPila = 0 Then
                                ' Lo hemos encontrado
                                ultimo = k
                                j = fB
                                Exit For
                            End If
                        End If
                    Next
                    ' Quitar el comentario
                    ' para poner un punto de interrupción (debug)
                    'j = j


                    ' debe ser un operador
                    ' No usar la x para multiplicar
                    ' Case "^", "*", "/", ":", "÷", "\", "\u412?", "\u623?", "%", "+", "-" ', "x"
                Case "^", "*", "/", "\", "\u412?", "\u623?", "%", "+", "-", "m", "x"
                    Exit For

                Case Else
                    ' es una cifra, añadirla
                    hayCifras = True
                    ultimo = j

            End Select
        Next
        If ultimo > -1 Then
            If anterior Then
                Return Mid(texto, ultimo, i - ultimo)
            Else
                Return Mid(texto, i + 1, ultimo - i)
            End If
        End If
        Return ")"
    End Function



    ''' <summary>
    ''' Evalúa una expresión y devuelve el resultado
    ''' Las expresiones indicadas solo deben ser cifras y operaciones aritméticas
    ''' </summary>
    ''' <param name="expresion"></param>
    ''' <returns></returns>
    ''' <remarks>
    ''' NO debe contener funciones y pueden estar encerradas entre paréntesis,
    ''' pero no contener varios paréntesis anidados.
    ''' Si tiene decimales, estarán en el formato del idioma (la coma para España)
    ''' Solo se usarán operadores del mismo nivel de prioridad.
    ''' (todas estas cosas se tienen ya en cuenta, pero... para que quede claro)
    ''' 12 + 5 + 10
    ''' 
    ''' </remarks>
    Protected Overridable Function evaluaExp(ByVal expresion As String) As String
        If expresion.StartsWith("(") AndAlso expresion.EndsWith(")") Then
            expresion = expresion.Substring(1, expresion.Length - 2)
        End If

        '' Cambiar los puntos por comas
        'If sepDec = "," Then
        '    expresion = expresion.Replace(".", ",")
        'End If

        Dim exp As String = expresion

        Dim op As String
        Dim pIz As Integer
        Dim opIz, opDe As String
        Dim res As String = ""
        Dim pDer As Integer

        ' No sustituir todos los - con _
        ' si empieza con - es negativo, sustituir con _             (08/Oct/07)
        If expresion.TrimStart().StartsWith("-") Then
            expresion = "_" & expresion.TrimStart().Substring(1)
        End If
        If expresion.Contains("[") AndAlso expresion.Contains("]") Then
            exp = expresion
        Else
            exp = analizarPrioridad(expresion)
        End If
        'exp = analizarPrioridad(expresion)
        ' si al analizar solo se añaden paréntesis                  (07/Oct/07)
        ' no añadirlos, que se cuelga...
        If "(" & expresion & ")" = exp Then
            exp = expresion
        End If

        ' Si hay paréntesis anidados
        ' (después de analizar prioridad
        pIz = exp.IndexOf("(")
        While pIz > -1
            pDer = exp.IndexOf(")", pIz)
            If pDer > -1 Then
                ' Analizar lo que está entre paréntesis
                ' Tomar el inicio desde el final hallado            (07/Oct/07)
                pIz = exp.LastIndexOf("(", pDer)
                Dim exp2 As String = exp.Substring(pIz, pDer - pIz + 1)
                exp2 = Evalua(exp2)
                exp = exp.Substring(0, pIz) & exp2 & exp.Substring(pDer + 1)
                ' Seguir analizando                                 (04/Oct/07)
                pIz = exp.IndexOf("(")
            End If
        End While

        pIz = exp.IndexOfAny(operadores.ToCharArray)
        If pIz = -1 Then
            pIz = exp.IndexOf("_")
        End If
        If pIz = -1 Then Return exp


        opIz = exp.Substring(0, pIz).Trim
        If opIz = "" Then
            ' Seguramente el número es negativo
            pIz = exp.IndexOfAny("-_".ToCharArray)
            If pIz > -1 Then
                ' Sumar 1 porque en buscarCifra el primero es el 1
                opIz = buscarCifra(exp, pIz + 1, anterior:=False)
                opIz = "-" & opIz
                ' Si es negativo, no seguir comprobando             (06/Oct/07)
                ' (al menos si no queda más)
                If pIz <= 1 Then
                    exp = exp.Substring(pIz + opIz.Length)
                    If Len(exp) = 0 Then
                        Return opIz '& exp
                    End If
                Else
                    exp = exp.Substring(0, pIz - 1)
                End If
                pIz = exp.IndexOfAny(operadores.ToCharArray)
                If pIz = -1 Then Return opIz
            End If
        End If
        exp = exp.Substring(pIz)
        Do
            pIz = exp.IndexOfAny(operadores.ToCharArray)
            If pIz = -1 Then
                Exit Do
            End If
            op = exp(pIz)
            pDer = exp.IndexOfAny(operadores.ToCharArray, pIz + 1)
            If pDer = -1 Then
                pDer = exp.Length
            End If
            opDe = exp.Substring(pIz + 1, pDer - pIz - 1).Trim
            If opDe = "" Then
                ' Seguramente el número es negativo
                pDer = exp.IndexOf("-")
                If pDer > -1 Then
                    ' Sumar 1 porque en buscarCifra el primero es el 1
                    opDe = buscarCifra(exp, pDer + 1, anterior:=False)
                    opDe = "-" & opDe
                    ' si es negativo, posicionar bien el puntero    (06/Oct/07)
                    pDer = pDer + Len(opDe)
                Else
                    res = opIz
                    Exit Do
                End If
            End If
            ' Por si tiene _ en vez de -                            (07/Oct/07)
            If opIz.Contains("_") Then
                opIz = opIz.Replace("_", "-")
            End If
            If opDe.Contains("_") Then
                opDe = opDe.Replace("_", "-")
            End If
            '
            ' El cambio de los decimales solo debe hacerse aquí     (09/Oct/07)
            '
            ' Ya no se debe cambiar nada                    v.20    (12/Oct/07)
            ' se usa la cultura Invariant
            '' Cambiar los puntos por comas
            'If sepDec = "," Then
            '    opIz = opIz.Replace(".", ",")
            '    opDe = opDe.Replace(".", ",")
            'End If

            ' Si tiene la letra E,                          v.13  (12/Oct/07)
            ' ¡es que es un número a lo bestia!
            ' Las mayúsculas y minúsculas...                v.26    (12/Oct/07)
            If opIz.ToLower.EndsWith("e") Then
                opIz = opIz & op & opDe
                opDe = "0"
            End If
            res = Evalua(op, CDbl(opIz), CDbl(opDe)).ToString

            ' Ya no se debe cambiar nada                    v.20    (12/Oct/07)
            ' se usa la cultura Invariant
            '' Volver a dejar el punto como decimal
            'If sepDec = "," Then
            '    res = res.Replace(",", ".")
            'End If

            opIz = res
            exp = exp.Substring(pDer)
            If Len(exp) = 0 Then
                Exit Do
            End If
        Loop

        Return res
    End Function

    '
    '--------------------------------------------------------------------------
    ' Métodos públicos de instancia
    '--------------------------------------------------------------------------
    '


    ''' <summary>
    ''' Evaluar una expresión.
    ''' Este es el método principal al que debe llamarse para evaluar
    ''' </summary>
    ''' <param name="expresion">
    ''' La expresión a evaluar
    ''' </param>
    ''' <param name="mostrarInfo">
    ''' True si se quiere mostrar detalle de las operaciones realizadas
    ''' False (valor por defecto) para no mostrar detalle
    ''' </param>
    ''' <returns></returns>
    ''' <remarks>
    ''' Los operadores son los operadores simples
    ''' no las palabras, por ejemplo * o x para multiplicar, pero no mult
    ''' </remarks>
    Public Overridable Function Evalua(ByVal expresion As String, _
                                       Optional ByVal mostrarInfo As Boolean = False _
                                       ) As String
        expresion = Trim(expresion)
        If Len(expresion) = 0 Then Return "0"

        Dim negativo As String = ""
        If expresion.StartsWith("-") Then
            negativo = "-"
            expresion = expresion.Substring(1)
        End If

        ' Tener en cuenta la prioridad de los operadores
        ' (se encerrarán entre paréntesis extras)
        Dim expAnt As String = expresion

        ' Comprobar si hay números negativos                        (08/Oct/07)
        ' El caso es que si hay un operador y después un -
        ' es que es negativo
        expAnt = comprobarNegativos(expresion)

        ' Si es una función,                                v.21    (12/Oct/07)
        ' no evaluar la prioridad
        ' Las funciones contienen corchetes
        If Not (expAnt.Contains("[") AndAlso expAnt.Contains("]")) Then
            expresion = analizarPrioridad(expAnt)
            '#If DEBUG Then
            '        Else
            '            Debug.WriteLine(expAnt)
            '#End If
        End If
        ' si al analizar solo se añaden paréntesis                  (07/Oct/07)
        ' no añadirlos, que se cuelga...
        If "(" & expAnt & ")" = expresion Then
            expresion = expAnt
        End If

        If mostrarInfo Then
            Console.WriteLine(expAnt)
            Console.WriteLine(expresion)
        End If

        Dim pGr As AgruparPares

        ' No cambiar los puntos por comas                           (08/Oct/07)
        ' se cambiará en evaluaExp
        ' con idea de tener en cuenta los parámetros

        '' No añadir paréntesis extras (por si ya tiene)             (09/Oct/07)
        'If expresion.Trim().StartsWith("(") = False OrElse expresion.Trim().EndsWith(")") = False Then
        '    expresion = "(" & expresion & ")"
        'End If
        expresion = "(" & expresion & ")"

        pGr = AgruparPares.CrearInstancia(expresion, "(", ")")

        Dim parametros(0 To pGr.Sustituciones.Count - 1) As String

        If mostrarInfo Then
            ' Mostrar las sustituciones
            Console.WriteLine(pGr.Texto)
            For i As Integer = 0 To pGr.Sustituciones.Count - 1
                Dim s As String = pGr.Sustituciones(i)
                Console.WriteLine("  {0}: {1}", i, s)
            Next
            Console.WriteLine()
        End If

        For i As Integer = 0 To pGr.Sustituciones.Count - 1
            Dim s As String = pGr.Sustituciones(i)
            If pGr.ContieneMarcador(i) Then
                Dim j As Integer
                Dim res As String = ""
                Do
                    j = s.IndexOf(pGr.MarcadorInicio)
                    If j > -1 Then
                        Dim marca As String = s.Substring(j + pGr.MarcadorInicio.Length, pGr.LenFormato) '2)
                        Dim index As Integer = CInt(marca)
                        s = s.Replace(s.Substring(j, pGr.LenMarcador), parametros(index))
                    End If
                Loop While j > -1

                'If sepDec = "," Then
                '    res = evaluaExp(s).Replace(",", ".")
                'Else
                '    res = evaluaExp(s)
                'End If

                res = evaluaExp(s)
                parametros(i) = res

                If mostrarInfo Then
                    Console.WriteLine("  {0,2}: {1} --> {2}", i, s, res)
                End If
            Else
                Dim res As String

                ' Si tiene coma, es que son parámetros
                If s.IndexOf(",") = -1 Then
                    res = evaluaExp(s)

                    '' Convertir las comas en puntos después de evaluar
                    '' Comprobar con el separador correcto           (09/Oct/07)
                    'If sepDec = "," Then
                    '    res = evaluaExp(s).Replace(",", ".")
                    'Else
                    '    res = evaluaExp(s)
                    'End If

                ElseIf s.IndexOf("[") > -1 Then
                    res = evaluaExp(s)

                    'If sepDec = "," Then
                    '    res = evaluaExp(s).Replace(",", ".")
                    'Else
                    '    res = evaluaExp(s)
                    'End If
                Else
                    res = s
                End If
                parametros(i) = res

                If mostrarInfo Then
                    Console.WriteLine("  {0,2}: {1} --> {2}", i, s, res)
                End If
            End If
        Next

        '----------------------------------------------------------------------

        ' En realidad ya se cambia en la clase base, pero...
        ' De todas formas, como se ha cambiado el valor en el constructor
        ' esto NUNCA se cumplirá...


        ' Aquí si se debe cambiar,                          v.27    (12/Oct/07)
        ' ya que esto es para devolverlo adecuado a la configuración regional

        ' Antes no estaba el cambio aquí,
        ' pero es preferible hacerlo en Evalua,
        ' por si se usa una instancia en lugar del método compartido

        expAnt = negativo & parametros(parametros.Length - 1)

        If sepDec = "," Then
            expAnt = expAnt.Replace(".", ",")
        End If

        '----------------------------------------------------------------------

        Return expAnt
        'Return negativo & parametros(parametros.Length - 1)
    End Function


    ''' <summary>
    ''' Evalúa una operación con el operador indicado
    ''' </summary>
    ''' <param name="operador">
    ''' Operador o función a utilizar.
    ''' Los operadores y funciones reconocidos son:
    ''' +
    ''' -, (también acepta _ para restar)
    ''' *
    ''' /, \ (no distingue división entera)
    ''' ^
    ''' \u412? o m (mod)
    ''' % calcular el porcentaje
    ''' </param>
    ''' <param name="num1">
    ''' Primer operando (izquierda del operador)
    ''' </param>
    ''' <param name="num2">
    ''' (Opcional) Segundo operando (derecha del operador)
    ''' </param>
    ''' <returns>
    ''' Un valor Double con el resultado
    ''' </returns>
    ''' <remarks></remarks>
    Public Overridable Function Evalua(ByVal operador As String, _
                                       ByVal num1 As Double, _
                                       ByVal num2 As Double) As Double
        Dim numeros(0 To 0) As Double
        If num2 <> Double.NaN Then
            ReDim numeros(0 To 1)
            numeros(1) = num2
        End If
        numeros(0) = num1

        Return Evalua(operador, numeros)
    End Function

    ''' <summary>
    ''' Evalúa una operación con el operador indicado
    ''' </summary>
    ''' <param name="operador">
    ''' Operador o función a utilizar en la expresión
    ''' </param>
    ''' <param name="num1">
    ''' Parámetro a evaluar con la función u operador
    ''' </param>
    ''' <returns>
    ''' Un valor Double con el resultado
    ''' </returns>
    ''' <remarks></remarks>
    Public Overridable Function Evalua(ByVal operador As String, _
                                       ByVal num1 As Double) As Double

        'Return Evalua(operador, num1, Double.NaN)
        Return Evalua(operador, New Double() {num1})
    End Function


    ''' <summary>
    ''' Evalúa una operación usando el mismo operador
    ''' Este método NO evalúa las funciones,
    ''' para evaluar funciones usar la clase EvaluarFunciones.
    ''' </summary>
    ''' <param name="operador">
    ''' Ver la sobrecarga que recibe dos parámetros para los operadores aceptados
    ''' </param>
    ''' <param name="numeros">
    ''' Array de tipo Double con los valores a evaluar
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overridable Function Evalua(ByVal operador As String, _
                                       ByVal ParamArray numeros() As Double) As Double

        Select Case operador.ToLower
            Case "+"
                Return Suma(numeros)
            Case "-", "_"
                Return Resta(numeros)
            Case "*", "x"
                Return Multiplica(numeros)
            Case "/" ', "\" ', ":", "÷"
                Return Divide(numeros)
            Case "\"
                Return DivideEnteros(numeros)
            Case "^"
                Return Math.Pow(numeros(0), numeros(1))
            Case "\u623?", "m"
                Return numeros(0) Mod numeros(1)
            Case "%"
                Return Porcentaje(numeros(0), numeros(1))
        End Select
    End Function


    '
    '--------------------------------------------------------------------------
    ' Métodos de instancia protegidos (podían hacerse públicos, pero...)
    '--------------------------------------------------------------------------
    '

    ''' <summary>
    ''' Calcula el porcentaje de los números indicados
    ''' 100 % 10 será el 10% de 100
    ''' </summary>
    ''' <param name="num1">
    ''' Número del que se calculará el porcentaje
    ''' </param>
    ''' <param name="num2">
    ''' Porcentaje a calcular de num1
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Porcentaje(ByVal num1 As Double, ByVal num2 As Double) As Double
        Return num1 * num2 / 100
    End Function

    ''' <summary>
    ''' Suma todos los valores indicados
    ''' </summary>
    ''' <param name="parametros">
    ''' Array de números a sumar
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Suma(ByVal ParamArray parametros() As Double) As Double
        Dim t As Double = parametros(0)
        For i As Integer = 1 To parametros.Length - 1
            t = t + parametros(i)
        Next
        Return t
    End Function

    ''' <summary>
    ''' Resta al primer valor todos los demás
    ''' </summary>
    ''' <param name="parametros">
    ''' Array de números a restar
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Resta(ByVal ParamArray parametros() As Double) As Double
        Dim t As Double = parametros(0)
        For i As Integer = 1 To parametros.Length - 1
            t = t - parametros(i)
        Next
        Return t
    End Function

    ''' <summary>
    ''' Multiplica todos los valores
    ''' </summary>
    ''' <param name="parametros">
    ''' Array de números a multiplicar
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Multiplica(ByVal ParamArray parametros() As Double) As Double
        Dim t As Double = parametros(0)
        For i As Integer = 1 To parametros.Length - 1
            t = t * parametros(i)
        Next
        Return t
    End Function

    ''' <summary>
    ''' Divide todos los valores
    ''' </summary>
    ''' <param name="parametros">
    ''' Array de números a dividir
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Divide(ByVal ParamArray parametros() As Double) As Double
        Dim t As Double = parametros(0)
        For i As Integer = 1 To parametros.Length - 1
            t = t / parametros(i)
        Next
        Return t
    End Function

    ''' <summary>
    ''' División entera
    ''' </summary>
    ''' <param name="parametros"></param>
    ''' <returns></returns>
    ''' <remarks>
    ''' v1.0.0.10
    ''' 11/Oct/07
    ''' </remarks>
    Protected Function DivideEnteros(ByVal ParamArray parametros() As Double) As Long
        Dim t As Long = CLng(parametros(0))
        For i As Integer = 1 To parametros.Length - 1
            t = t \ CLng(parametros(i))
        Next
        Return t
    End Function

    ''' <summary>
    ''' Eleva el primer número a la potencia indicada
    ''' </summary>
    ''' <param name="numero"></param>
    ''' <param name="pot"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function Potencia(ByVal numero As Double, ByVal pot As Double) As Double
        Return numero ^ pot
        'Return Math.Pow(numero, pot)
    End Function

    '
    '--------------------------------------------------------------------------
    ' Métodos públicos compartidos
    '--------------------------------------------------------------------------
    '

    ''' <summary>
    ''' Este es el método principal al que debe llamarse para evaluar la expresión
    ''' internamente se crea una instancia de la clase y se llama al método Evalua.
    ''' </summary>
    ''' <param name="expresion">
    ''' La expresión a evaluar
    ''' </param>
    ''' <param name="mostrarInfo">
    ''' True si se quiere mostrar detalle de las operaciones realizadas
    ''' False (valor por defecto) para no mostrar detalle
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function Evaluar(ByVal expresion As String, _
                                   ByVal mostrarInfo As Boolean _
                                   ) As String
        Dim ev As New EvaluarExpresiones
        Dim exp As String = ev.Evalua(expresion, mostrarInfo)

        ' Ya no se debe cambiar nada                        v.20    (12/Oct/07)
        ' se usa la cultura Invariant
        'If sepDec = "," Then
        '    exp = exp.Replace(".", ",")
        'End If

        Return exp
    End Function

    Public Shared Function Evaluar(ByVal expresion As String) As String
        Return Evaluar(expresion, False)
    End Function

    ''' <summary>
    ''' Devuelve el número indica en hexadecimal
    ''' </summary>
    ''' <param name="num"></param>
    ''' <param name="cifras">
    ''' Número de cifras a mostrar
    ''' (predetermniado 16)
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function DecToHex(ByVal num As Object, Optional ByVal cifras As Integer = 16) As String
        Dim d As Double = CDbl(num)
        If Double.IsNaN(d) OrElse Double.IsInfinity(d) Then
            Return "NaN"
        End If
        Return CLng(num).ToString("X" & cifras.ToString).TrimStart("0"c)
    End Function

    ''' <summary>
    ''' Devuelve el valor decimal del número hexadecimal indicado
    ''' </summary>
    ''' <param name="num"></param>
    ''' <returns></returns>
    ''' <remarks>
    ''' v.22
    ''' 12/Oct/07
    ''' </remarks>
    Public Shared Function HexToDec(ByVal num As Object) As String
        Dim d As Double = CDbl(num)
        If Double.IsNaN(d) OrElse Double.IsInfinity(d) Then
            Return "NaN"
        End If
        Return ("&H" & num.ToString)
    End Function


    ''' <summary>
    ''' Devuelve el número indica en octal
    ''' </summary>
    ''' <param name="num"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function DecToOct(ByVal num As Object) As String
        Dim d As Double = CDbl(num)
        If Double.IsNaN(d) OrElse Double.IsInfinity(d) Then
            Return "NaN"
        End If
        Return Oct(num)
    End Function

    ''' <summary>
    ''' Devuelve el valor decimal del número octal indicado
    ''' </summary>
    ''' <param name="num"></param>
    ''' <returns></returns>
    ''' <remarks>
    ''' v.22
    ''' 12/Oct/07
    ''' </remarks>
    Public Shared Function OctToDec(ByVal num As Object) As String
        Dim d As Double = CDbl(num)
        If Double.IsNaN(d) OrElse Double.IsInfinity(d) Then
            Return "NaN"
        End If
        Return ("&O" & num.ToString)
    End Function

    ''' <summary>
    ''' Devuelve el número indicado en binario
    ''' </summary>
    ''' <param name="num">
    ''' Número a convertir en binario
    ''' (primero se convierte a Int64)
    ''' </param>
    ''' <param name="cifras">
    ''' Cantidad de cifras máximas a mostrar
    ''' (predeterminado 32)
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function DecToBin(ByVal num As Object, Optional ByVal cifras As Integer = 32) As String
        Dim d As Double = CDbl(num)
        If Double.IsNaN(d) OrElse Double.IsInfinity(d) Then
            Return "NaN"
        End If

        Dim s As New StringBuilder
        Dim n As Long = CLng(num)
        If n = 0 Then
            Return "0"
        End If

        Dim j As Integer = 0

        For i As Integer = cifras - 1 To 0 Step -1
            If ((n And CInt(2 ^ i)) <> 0) Then
                s.Append("1")
            Else
                s.Append("0")
            End If
            j = j + 1
            If j = 4 Then
                j = 0
                s.Append(" ")
            End If
        Next
        Return s.ToString.TrimStart(" 0".ToCharArray)
    End Function

    ''' <summary>
    ''' Convierte un número binario en decimal
    ''' </summary>
    ''' <param name="sDec"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function BinToDec(ByVal sDec As String) As Long
        Dim i, j As Integer
        Dim n As Long

        For j = sDec.Length - 1 To 0 Step -1
            If (sDec(j) = "1"c) Then
                n += CInt(2 ^ i)
                i += 1
            ElseIf (sDec(j) <> " "c) Then
                i += 1
            End If
        Next
        Return n
    End Function


    ''' <summary>
    ''' La versión actual de la DLL (revisión)
    ''' </summary>
    ''' <param name="conNombre">
    ''' Opcional (False) si se debe devolver el nombre del ensamblado
    ''' </param>
    ''' <returns>
    ''' La versión de la DLL (versión de FileVersion)
    ''' </returns>
    ''' <remarks></remarks>
    Public Shared Function Version(ByVal conNombre As Boolean) As String
        Dim ensamblado As Assembly = Assembly.GetExecutingAssembly
        Dim fvi As FileVersionInfo = FileVersionInfo.GetVersionInfo(ensamblado.Location)
        If conNombre Then
            Return ensamblado.GetName.Name & " v" & fvi.FileVersion
        Else
            Return " v" & fvi.FileVersion
        End If
    End Function

    ''' <summary>
    ''' La versión actual de la DLL (revisión)
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    ''' v.18
    ''' 12/Oct/07
    ''' Lo convierto en función con dos sobrecargas
    ''' El único código que rompe es el de C#...
    ''' </remarks>
    Public Shared Function Version() As String
        Return Version(False)
    End Function


    ' Definir el separador decimal, según la cultura actual         (09/Oct/07)
    ' Pongo que use InvariantCulture                        v.17    (12/Oct/07)
    Public Shared ReadOnly Property SeparadorDecimal() As String
        Get
            Return sepDec
        End Get
    End Property

    Protected Shared sepDec As String

    ' Crear el objeto Random al iniciar la instancia compartida
    ' (primera vez que se use)
    Protected Shared m_Rnd As Random

    ' Usar InvariantCulture para evitar el follón de los decimales  (12/Oct/07)
    Shared Sub New()
        m_Rnd = New Random
        Thread.CurrentThread.CurrentCulture = CultureInfo.InvariantCulture
        sepDec = Thread.CurrentThread.CurrentCulture.NumberFormat.CurrencyDecimalSeparator
    End Sub

d End Class

 

Programar por programar... ¡porque te gusta programar!
Ir al índice principal
Ir al sitio del Guille - Ir a los foros del Guille

Has entrado usando el host www.programarporprogramar.org