String Evaluation 
Author Message
 String Evaluation

This is a multi-part message in MIME format.

------=_NextPart_000_0005_01BDEB9F.2B0335C0
Content-Type: text/plain;
        charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

I have two functions, one is database independent (mth_eval.4gl) and the
other one could be more efficient and support more operators, but is
database dependent (mth_evaldbs.4gl). Choose which is better for you.

Any comments or suggestions is welcome!

Ing. Melvin Perez Cedano
Vicepresidente Tecnico
CAM Informatica, S. A.

------=_NextPart_000_0005_01BDEB9F.2B0335C0
Content-Type: application/octet-stream;
        name="mth_eval.4gl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
        filename="mth_eval.4gl"

--***********************************************************************=
*****
--* Modulo          : mth_eval.4gl
--*
--* Descripcion     :=20

aritmeticas.

basicas:







contener=20

debe=20

operadores.
--*
--* Funciones       : fgl_eval()
--*

--* Autor           : Ing. Melvin Perez Cedano
--* Fecha           : 4/17/97 17:25:24
--* Path            : /mant/infogen/lib.4gm/SCCS/math.std/s.mth_eval.4gl
--*
--* El uso, modificacion o duplicacion total o parcial del contenido de =
este
--* archivo esta limitado por el acuerdo de adquisicion.
--*
--* (C) 1996 CAM Informatica, S. A.
--* Todos los Derechos Reservados.
--***********************************************************************=
*****
{------------------------------------------------------------------------=
----}

--> Definicion de variables estaticas del modulo.
DEFINE=20
    --> Stack conteniendo los operandos de la expresion
    Num_Stack RECORD
        nextitem SMALLINT,
        items ARRAY[100] OF FLOAT
    END RECORD,

    NumSet  CHAR(13),
    OprSet  CHAR(10),
    infija, postfija ARRAY[100] OF CHAR(16),
    Opr_Stack CHAR(256),
    NextItem,
    LastItemIf,
    LastItemPf SMALLINT

--***********************************************************************=
*****

--*
--* Descripcion     :=20

metodo de


basicas:







contener=20

debe=20

operadores.
--*
--* Parametros      : p_expresion         Expresion a resolver.
--*
--* Retorno         : Resultado de la expresion.
--*
--* Globales        : n/a
--*
--* Forms           : n/a
--*
--* Autor           : Ing. Melvin Perez Cedano
--***********************************************************************=
*****
{------------------------------------------------------------------------=
----}
FUNCTION fgl_eval(p_expresion)
    DEFINE p_expresion    CHAR(256)

    CALL Init_eval()
    CALL ReversePolish(p_expresion)

    RETURN calcula()
END FUNCTION

--***********************************************************************=
*****
--* Init_eval()
--*
--* Esta funcion inicializa las variables globales del modulo.
--***********************************************************************=
*****
{------------------------------------------------------------------------=
----}
FUNCTION Init_eval()
    LET NumSet=3D"[.0123456789]"
    LET OprSet=3D"[+-*/^%]"
    LET LastItemPf =3D 1
    LET LastItemIf =3D 0
    LET Num_Stack.NextItem =3D 101

    LET Opr_Stack =3D "+"
    CALL PushStack(0)
END FUNCTION

--***********************************************************************=
*****
--* ReversePolish()
--*
--* Esta funcion toma la expresion en notacion Infija y la convierte a =
su
--* equivalente PostFija o Polaca Inversa.
--*
--* Argumentos:
--*     <ninguno>
--* Retorno   :
--*     <ninguno>
--***********************************************************************=
*****
{------------------------------------------------------------------------=
----}
FUNCTION ReversePolish(p_expresion)
    DEFINE p_expresion CHAR(256),
           i, n , l, p SMALLINT,
           chr CHAR(1)

    LET i =3D 1

    --> Pone la expresion recibida como una cadena en un arreglo,
    --> poniendo de en cada elemento del arreglo un operador o un =
operando.
    CALL MakeInfija(p_expresion)
    LET n =3D LastItemIf

    --> Recorre la Infija y crea la PostFija
    WHILE i <=3D n
        LET l =3D LENGTH(Infija[i])

        --> Toma el ultimo caracter de la cadena para determinar su =
contenido
        LET chr=3DInfija[i][l]

        CASE=20
            --> Si es un operando.
            WHEN chr MATCHES NumSet
                LET PostFija[LastItemPf] =3D Infija[i]
                LET LastItemPf =3D LastItemPf + 1
            --> Si es un operador.
            WHEN chr =3D "+" OR chr =3D "-" OR chr =3D "*" OR chr =3D =
"/"
                CALL PushOperator(i)
            --> Condiciones especiales para los Parentesis
            WHEN chr =3D "("
                LET Opr_Stack =3D Opr_Stack CLIPPED, "("
            WHEN chr =3D ")"
                CALL CloseParenthesis()
        END CASE

        LET i =3D i + 1
    END WHILE

    --> Concatena los operandores restantes en la Opr_Stack.
    CALL finish()
END FUNCTION

--***********************************************************************=
*****
--* MakeInfija()
--*=20
--* Esta funcion pone la cadena o expresion especificada en un arreglo.
--* En cada posicion del arreglo se encuentra un Operando o un Operador.
--*
--* Argumentos:
--*     p_expresion        Expresion a procesar.
--***********************************************************************=
*****
{------------------------------------------------------------------------=
----}
FUNCTION MakeInfija(p_expresion)
    DEFINE p_expresion CHAR(256),
           lf_negative,
           i SMALLINT

    --> Inicializa las variables.
    LET i =3D  1
    LET lf_negative =3D FALSE

    WHILE i <=3D LENGTH(p_expresion)
        --> Si no es un numero negativo, pasa a la siguiente posicion
        IF NOT lf_negative THEN
            LET LastItemIf=3DLastItemIf+1
            LET Infija[LastItemIf] =3D ""
        ELSE
            LET lf_negative =3D FALSE
        END IF

        --> Indentifica los operandos. Un operando es cualquier cadena=20
        --> incluyendo numeros y punto FLOAT.
        IF (p_expresion[i] MATCHES NumSet) THEN=20
            WHILE (p_expresion[i] MATCHES NumSet) AND=20
                  (i <=3D LENGTH(p_expresion))
                LET Infija[LastItemIf] =3D Infija[LastItemIf] CLIPPED,=20
                                         p_expresion[i]
                LET i=3Di+1
            END WHILE
        ELSE
            LET Infija[LastItemIf] =3D p_expresion[i]

            --> Detecta los numeros negativos.
            IF p_expresion[i] =3D "-" THEN
                --> Si esta en una posicion dentro de la cadena.
                IF i > 1 THEN
                    --> Verifica si en la posicion anterior hubo otro =
operando.
                    IF p_expresion[i-1] NOT MATCHES NumSet THEN
                        --> Si no hubo un operando, este es un numero =
negativo.
                        LET lf_negative =3D TRUE
                    END IF
                ELSE
                    --> Si esta en la primera posicion.
                    LET lf_negative =3D TRUE
                END IF
            END IF

            LET i=3D i+1
        END IF
    END WHILE

END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION PushOperator(i)
    DEFINE i,
           l,
           f_preced,
           f_parent SMALLINT
       =20
    LET f_preced =3D TRUE
    LET f_parent =3D FALSE

    WHILE f_preced AND NOT f_parent
        LET l =3D Length(Opr_Stack)

        IF l > 0 THEN
            CALL Precede(Opr_Stack[l], Infija[i][1]) RETURNING f_preced

            IF Opr_Stack[l] =3D "(" THEN
                LET f_parent =3D TRUE
            ELSE
                LET f_parent =3D FALSE
            END IF
        ELSE
            LET f_preced =3D FALSE
        END IF

        IF f_preced THEN
            Let PostFija[LastItemPf] =3D Opr_Stack[l]
            LET LastItemPf =3D LastItemPf + 1
            IF l > 1 THEN
                Let Opr_Stack =3D Opr_Stack[1, l-1]
            ELSE
                LET Opr_Stack =3D ""
            END IF
        END IF
    END WHILE

    LET Opr_Stack =3D Opr_Stack CLIPPED, Infija[i] CLIPPED
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION Precede(Op1, Op2)
    DEFINE Op1, Op2 CHAR(1)

    CASE
        WHEN Op1 MATCHES "[+-]"
            IF Op2 MATCHES "[+-]" THEN
                RETURN TRUE
            ELSE
                RETURN FALSE
            END IF
        WHEN Op1 MATCHES "[*/]"
            IF Op2 MATCHES "[*/+-]" THEN
                RETURN TRUE
            ELSE
                RETURN FALSE
            END IF
        OTHERWISE
            RETURN FALSE
    END CASE
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION CloseParenthesis()
    DEFINE l SMALLINT

    LET l =3D LENGTH(Opr_Stack)

    WHILE Opr_Stack[l] !=3D "("
        LET PostFija[LastItemPf] =3D Opr_Stack[l];
        LET LastItemPf =3D LastItemPf + 1
        LET Opr_Stack =3D Opr_Stack[1, l - 1]
        LET l =3D LENGTH(Opr_Stack)
    END WHILE

    IF l > 1 THEN
        LET Opr_Stack =3D Opr_Stack[1, l -1]
    ELSE
        LET Opr_Stack =3D ""
    END IF
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION finish()
    DEFINE l SMALLINT

    LET l =3D LENGTH(Opr_Stack)

    WHILE l > 0
        LET PostFija[LastItemPf] =3D Opr_Stack[l]

        IF l > 1 THEN
            LET Opr_Stack =3D Opr_Stack[1, l-1]
        ELSE
            LET Opr_Stack =3D ""
        END IF

        LET l =3D LENGTH(Opr_Stack)
        LET LastItemPf =3D LastItemPf + 1
    END WHILE

    LET LastItemPf =3D LastItemPf - 1
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION calcula()
    DEFINE l SMALLINT

    WHILE LastItemPf > 0=20
        LET l =3D LENGTH(PostFija[1])

        WHILE PostFija[1][l] MATCHES NumSet AND LastItemPf > 0
            --> Introduce en el stack el numero tope del postfijo y se
            --> mueve al proximo elemento del postfijo.
            CALL PushStack(PopPostFijo())

            LET l =3D LENGTH(PostFija[1])
        END WHILE

        --> Realiza la operacion con los dos operandos del tope.
        CALL Operations(PopStack(), PopStack(), PopPostFijo())
    END WHILE

    --> Retorna el elemento del stack =3D resultado de la expresion.
    RETURN PopStack()
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION PushStack(Num)
    DEFINE Num FLOAT

    --> Introduce un numero en el stack
    If Num_Stack.NextItem !=3D 1 THEN
        LET Num_Stack.NextItem =3D Num_Stack.NextItem - 1
        LET NextItem=3DNum_Stack.NextItem
        LET Num_Stack.Items[NextItem] =3D Num
    END IF
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION PopStack()
    DEFINE Num FLOAT

    --> Saca el elemeto tope del stack.
    LET NextItem=3DNum_Stack.NextItem
    LET Num =3D Num_Stack.Items[NextItem]

    IF Num_Stack.NextItem < 100 THEN
        LET Num_Stack.NextItem =3D Num_Stack.NextItem + 1
    END IF

    --> Retorna el elemento tope del stack.
    RETURN Num
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION PopPostFijo()
    DEFINE i SMALLINT,
           S CHAR(16)

    --> Saca el elemento tope del postfijo.
    LET S =3D PostFija[1]

    FOR i =3D 1 TO LastItemPf - 1
        LET PostFija[i] =3D PostFija[i+1]
    END FOR

    LET LastItemPf=3D LastItemPf - 1

    --> Retorna el elemento tope del postfijo.
    RETURN S
END FUNCTION

{------------------------------------------------------------------------=
----}
FUNCTION Operations(Operando1, Operando2, Op)
    DEFINE Op CHAR(1),
        Operando1,
        Operando2 FLOAT

    --> Introduce el resultado al stack.
    CASE Op
        WHEN "+"
            CALL PushStack(Operando2 + Operando1)
        WHEN "-"
            CALL PushStack(Operando2 - Operando1)
        WHEN "*"
            CALL PushStack(Operando2 * Operando1)
        WHEN "/"
            CALL PushStack(Operando2 / Operando1)
        WHEN "%"
            CALL PushStack(Operando2 MOD Operando1)
    END CASE
END FUNCTION

------=_NextPart_000_0005_01BDEB9F.2B0335C0
Content-Type: application/octet-stream;
        name="mth_evaldbs.4gl"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
        filename="mth_evaldbs.4gl"

main
    define l_result decimal,
        l_expr char(512)

    let l_expr = arg_val(1)

    if length(l_expr) = 0 then
        let l_expr = "0"
    end if

    database bas

    let l_result = mth_eval(l_expr)

    display l_result
end main

FUNCTION mth_eval(p_expresion)
    DEFINE p_expresion CHAR(512),
        l_selstmt CHAR(512),
        l_result  DECIMAL

    LET l_selstmt = "SELECT ", p_expresion CLIPPED,
                    " FROM systables WHERE tabid = 1"

    PREPARE ex_selstmt FROM l_selstmt
    DECLARE c_eval CURSOR FOR ex_selstmt

    OPEN c_eval
    FETCH c_eval INTO l_result

    RETURN l_result
END FUNCTION

------=_NextPart_000_0005_01BDEB9F.2B0335C0--



Wed, 18 Jun 1902 08:00:00 GMT
 
 [ 1 post ] 

 Relevant Pages 

1. Integer to String Evaluation in SQL Statement

2. Need info on evaluation of DBMS /evaluation criteria

3. Need info on evaluation of DBMS /evaluation criteria

4. ORA-04030 out of process memory when trying to allocate string bytes (string,string)

5. How to split string into integer and string

6. find string within string

7. String consists string by LETTERS

8. UDF only returns first letter of a string not whole string

9. Manipulating Strings Using Transact-SQL (Spliting Strings)

10. Parse ASP search string into query string?


 
Powered by phpBB® Forum Software