Calculer la valeur d'un string '1+2*(4/2)' [mini parseur avec regles] , ex pour faust

Description

Faust m'a demandé comment faire ceci :

je voudrais que mon prog interprète les opérateurs: +,-,*,/; dans une String et qu'il fasse l'opération tout seul.
ex: je tape ça dans edit1 1+3 et il me réponds 4; voila

------
Voila une solution, c'est un parseur avec 6 regles qui calcule en entier (pour faire le calcul en reel il faut changer les StrToInt en StrToFloat et changer le DIV en / ):

Regles de calculs :
R1 : Si ($) alors res := [$];
R2 : Si $*$ alors res := [$*$];
R3 : Si $/$ alors res := [$/$];
R4 : Si $+$ alors res := [$+$];
R5 : Si $-$ alors res := [$-$];
Regles additionnelles :
pour mettre -3 en debut de ligne
R6 : Si -$ alors res := [-$]; << implicitement mise dans R4 et R5

ceci avec une strategie de control par priorité des regles et recurence.

s'il y a une erreur dans l'algorithme prevenez moi.

Source / Exemple :


{
 Base de regles :
 ----------------
 Regles de calculs :
   R1 : Si ($) alors res := [$];
   R2 : Si $*$ alors res := [$*$];
   R3 : Si $/$ alors res := [$/$];
   R4 : Si $+$ alors res := [$+$];
   R5 : Si $-$ alors res := [$-$];
 Regles additionnelles :
   pour mettre -3 en debut de ligne
   R6 : Si -$ alors res := [-$]; << implicitement mise dans R4 et R5

   pour permettre d'utiliser des expressions literale a la place de chiffres
   R7 : Si $<>[0..9]* alors res := $; << non implémentée

 Sur cette Base de regles on applique un systeme par priorité et par reccurence

 Problemes qui peuvent subvenir : la * et plus forte que la /, pour autant
 le probleme de 2*3/2 donnera un bon resultat. Mais ici les operations sont
 de type entier, donc 3/2 = 1 et non pas 1.5 
}

// variable globale pour savoir s'il ya eut une erreur, cette variable
// pourrait etre passé en parametre dans toutes les fonctions et renvoyer
// par exemple la position de l'erreur dans la chaine de caractere, mais bon
// ici c'est juste un exemple donc on mettra un boolean
var
   Calcul_regles_b : boolean;

// comme c'est de la reccurence on doit mettre l'entete de calcul_regles avant
// les autres fonctions
function calcul_regles (s : string) : string;

// calcul le contenu des parentheses et renvoie le resultat.
function calcul_R1 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
begin
     i := AnsiPos('(',s);
   While (i > 0) do
   begin
     t := '';
     j := 0; // nombre de parenthese ouverte ajoutée en +, au cas ou : (...(..)..)
     k := i+1; // compteur
     while ( (k <=StrLen(PChar(s))) and (s[k]<>')') and (j=0)) do
     begin
          if (s[k]='(') then Inc(j);
          if (s[k]=')') then Dec(j);
          t := t + s[k];
          Inc(k);
     end;
     // si k > StrLen(PChar(s)) c'est qu'il y a probleme dans l'equation,
     // renvoie de l'erreur
     if (k > StrLen(PChar(s))) then
     begin
          calcul_R1 := false;
          exit;
     end;
     // on calcul 't' qui est l'interieur de la parenthese et on remplace la
     // parenthese par le resultat du calcul
     // i : position parenthese (, k : position parenthese )
     u := calcul_regles(t);
     // cas d'erreur de calcul.
     if u='' then
     begin
          calcul_R1 := false;
          exit;
     end;
     // on remplace t par u dans la chaine :
     t := '('+ t +')';
     s := AnsiReplaceStr(s,t,u);
     // on renvoie que l'on a correctement fini :
     i := AnsiPos('(',s);
   end;
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R1 := true;
          exit;
     end;
end;

// calcul le terme de gauche, de droite et fais la multiplication.
function calcul_R2 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('*',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R2 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k>=1) and (t[k]<>'+') and (t[k]<>'-') and (t[k]<>'/') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'+') and (t[k]<>'-') and (t[k]<>'/') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R2 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) * StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R2 := true;
end;

// idem que la 2 mais avec la /
function calcul_R3 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('/',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R3 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k>=1) and (t[k]<>'+') and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'+') and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R3 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) DIV StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R3 := true;
end;

// idem que la 3 mais avec la +
function calcul_R4 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('+',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R4 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        while ( (k>=1) and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        if ((k=1) and (t[1]='-')) then
        begin
             Dec(k);
             u := '-'+u;
        end;
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R4 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) + StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R4 := true;
end;

// idem que la 4 mais avec la -
function calcul_R5 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('-',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R5 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        while ( (k>=1) and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
          // cas ou l'on a -3
          if (u ='') then
          begin
               // l'operation StrToInt verra parfaitement le -3 comme un negatif
               // donc on renvoie le resultat sans rien faire
               calcul_R5 := true;
               exit;
          end;

        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R5 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) - StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R5 := true;
end;

begin
     // regle 1 : (...)
     if not calcul_R1(s) then
     begin
          ShowMessage('Erreur dans l''une des () :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 2 : *
     if not calcul_R2(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la * :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 3 : /
     if not calcul_R3(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la / :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 4 : +
     if not calcul_R4(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la + :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 5 : -
     if not calcul_R5(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la - :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;

     // si aucune regle ne peut etre appliquée alors on retourne la variable
     // de depart :
     Calcul_regles := s;
end;

function StrCalcul (s : string) : string;
var t : string;
begin
     Calcul_regles_b := true;
     t := calcul_regles(s);
     if Calcul_regles_b
        then StrCalcul := t
        else StrCalcul := 'ERREUR durant l''operation';
end;

Conclusion :


exemple :

ShowMessage('Resultat de l''operation : '+StrCalcul('1+2*(4/2)'));

ShowMessage('Resultat de l''operation : '+StrCalcul('-1+2'));

ShowMessage('Resultat de l''operation : '+StrCalcul('1+')); << il se produira une erreur

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.