1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Evaluateur d'expression mathématique (parenthese, puissance, modulo, +-*/)

Evaluateur d'expression mathématique (parenthese, puissance, modulo, +-*/)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 157 fois - Téléchargée 32 fois

Commenter

Contenu du snippet

C'est un évaluateur d'expression mathématique. Vous lui donnez une chaine de caractère, il vous retourne la valeur calculée...
Il gére les opérateurs classique +-*/, mais aussi les puissances : ^ et le modulo \
Il gère également les parenthèses... à notez que si si le nombre parenthèses ouvertes et fermées sont différent, il corrige lui seul le bug... en complètant les parenthèses manquantes !!!

Il peut par exemple vous calculer : 2 * ((2^4 + 4) * 5 ) * 5 = 1000
ou 10 \ 3 = 1 (le modulo : 10 modulo 3 =1)

Source / Exemple : 


Function TVARS.GetValExpr(Sender : TObject ; Value : string; posi : integer; avant : boolean) : string;
const
  operation = '*/\+-^{}';  //
var
  i : integer;
  go : boolean;
  s : string;
begin
  // extrait l'expression avant=True : avant la position  ou avant=false : aprés la position
  if avant then
    i := -1
  else
    i := 1;
  s := '';
  // condition pour continuer
  go := true;
  if (posi + i < 0) or (posi + i > length(Value)) then
    go := false;
  if Go then
  Begin
    // faire la boucle pour extraire la valeur à retourner
    while go and ((pos(Value[posi + i], operation) < 1)) do  // And (i > 1)
    begin
      if avant then
      begin
        s := Value[posi + i] + s;
        dec(i);
        // récupérer le signe pour faire l'opération suivante...
        If Value[posi + i] = '-' then
          s := '-' + s;
      end
      else
      begin
        s := s + Value[posi + i];
        inc(i);
      end;
      if (posi + i < 0) or (posi + i > length(Value)) then
        go := false;
    end;
  end;
  // retourner la valeur
  GetValExpr := s;
end;

Function TVARS.EvalExpression(Sender : TObject ; var Value : string) : string;
var
  i : integer;
  posi : integer;
  s1, s2 : string;
//  premier : boolean;
  retour : string;   // Valeur de retour : le résultat du calcul
  startparent : integer;  // position dans Value de la première parenthése ouverte
  Endparent : integer;    // position dans Value de la parenthése fermée
  ouvreparent : integer;  // nombre de parenthèses ouvertes
  fermeparent : integer;  // nombre de parenthèses  fermées
begin
  // Auteur : fabien FERT  ==> adress Mail : fabien.fert@wanadoo.fr
  //   version 0.8 : 11/07/2004 : gestion d'un calcul unique (suppressions des espaces sur les valeur retournées avant le calcul)
  //   version 0.9 : 17/07/2004 : gestion de plusieurs calculs cumulés
  //   version 1.0 : 17/07/2004 : gestion des parenthèses
  //   version 1.1 : 19/07/2004 : gestion des espaces (début et fin de chaîne) : Erreur soulevée par Japee sur www.delphifr.com
  //   version 1.2 : 25/07/2004 : Remplacement des () par les {} pour la compatibilité SQL
  //   version 1.3 : 30/07/2004 : Correction Bug - comme signe rencontré dans les expressions : -{-0.1-2},  -2+1, 3-{4-3*4},  5+{-2}, 1+125+{25-36}
  //   version 1.4 : 12/08/2004 : Correstion Bug - Ln{2} = Ln0

  // TODO : gestion des fonctions : Sin, cos, Tan, Exp, Ln, 1/n, Sqr
  // vous pouvez réutilisez ce code à votre guise à condition de ne pas effacer les lignes ci-dessus.

//  Premier := false;  // le premier chiffre est finit ? : non   // Attention suppression à vérifier !!!
  s1 := '';
  s2 := '';
  // vérifie que toutes les parenthèse ouvertes sont fermées...
  i := 1;
  Value := Trim(Value);
  ouvreparent := 0;
  fermeparent := 0;
  while i < length(Value)+1 do
  begin
    if Value[i] = '{' then
    begin
      inc(ouvreparent);
    end
    else if Value[i] = '}' then
    begin
      inc(fermeparent);
    end;
    inc(i);
  end;
  // s'il y a un problème de paranthése : on complète ( en début ou ) à la fin
  if ouvreparent > fermeparent then
  begin
    i := 0;
    while i < ouvreparent-fermeparent Do
    begin
      Value := Value + '}';
      inc(i);
    end;
  end
  else if ouvreparent < fermeparent then
  begin
    // ouvre la parenthése
    for i := ouvreparent to fermeparent Do
    begin
      Value := '{' + Value;
    end;
  end;

  // Gére les parenthèse ou les reste....
  if pos('{', Value) > 0 then
  Begin
    // s'il y a des parenthèse on les gère ici
    // faire un appel récursif du contenu des parenthèses
    startParent := 0;
    EndParent := 0;
    ouvreparent :=0;
    fermeparent :=0;
    i := 1;
    while i < length(Value)+1 do
    begin
      if Value[i] = '{' then
      begin
        inc(ouvreparent);
        If StartParent = 0 then StartParent := i;
      end
      else if Value[i] = '}' then
      begin
        inc(fermeparent);
        If (endParent = 0) and (fermeparent = ouvreparent) then EndParent := i;
      end;
      inc(i);
    end;
    // Evaluer la chaine contenue dans les parenthèses
    if StartParent + 1 <= EndParent - 1 Then
    begin
      Retour := copy(Value, startParent + 1, EndParent -1 - startparent);
      EvalExpression(Sender, Retour);
    end
    else
      retour := '0';
    // concaténé le resultat
    if (EndParent + 1 < Length(Value)) and (StartParent > 0) then
      Value := copy(Value, 0, StartParent -1) + retour + copy(Value, EndParent+1, length(value))
    else if startParent = 0 then
      Value := retour + copy(Value, EndParent+1, length(value))
    else if (EndParent + 1 > Length(Value)) then
      Value := copy(Value, 0, StartParent -1) + retour;
    // faire un appel récursif pour évaluer la chaine résultante
    EvalExpression(Sender, Value);
  end
  else if pos('@', uppercase(Value)) > 0 then
  begin
{  PAS UTILISE ICI : sert pour l'exécution de fonctions : envois de Mail, Liste les variables, exécuter des applications extérieures, etc... fonctions avancées...
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    posi := pos('@', Value);
    Value := VarEvalFunction(Sender, Value);
}
  end
  else if pos('$', uppercase(Value)) > 0 then
  begin
{   PAS UTILISE ICI : Sert pour la gestion des variables interne
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    posi := pos('$', Value);
    s1 := GetVarName(sender, Value);
    // affecte et retourne la valeur....
    Value := GetVarStrAffect(Sender, copy(Value, pos(s1, uppercase(Value)) + length(s1), length(Value)), s1);
    // supprimer l'affectation si il y a lieu
//    Value :=  copy(Value, 0, pos(s1, uppercase(Value)) + length(s1)) + Copy(Value, pos(s1, uppercase(Value)) + length(s1) + posi2, length(Value));
}
  end
  else if pos('A', uppercase(Value)) + pos('B', uppercase(Value)) + pos('C', uppercase(Value)) + pos('D', uppercase(Value)) + pos('E', uppercase(Value)) + pos('F', uppercase(Value)) + pos('G', uppercase(Value)) + pos('H', uppercase(Value)) + pos('I', uppercase(Value)) + pos('J', uppercase(Value)) + pos('K', uppercase(Value)) + pos('L', uppercase(Value)) + pos('M', uppercase(Value)) + pos('N', uppercase(Value)) + pos('O', uppercase(Value)) + pos('P', uppercase(Value)) + pos('Q', uppercase(Value)) + pos('R', uppercase(Value)) + pos('S', uppercase(Value)) + pos('T', uppercase(Value)) + pos('U', uppercase(Value)) + pos('V', uppercase(Value)) + pos('W', uppercase(Value)) +   pos('X', uppercase(Value)) +   pos('Y', uppercase(Value)) +  pos('Z', uppercase(Value)) +  pos('"', uppercase(Value)) +  pos(':', uppercase(Value)) +  pos('=', uppercase(Value)) > 0 then
  begin
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    Value := Value;
  end
  else if pos('*', Value) + pos('/', Value) + pos('\', Value) + pos('+', Value) + pos('-', Value) + pos('^', Value) > 0 then
  begin
    if pos('^', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('^', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(Power(strToFloat(trim(s1)),strToFloat(trim(s2))));
      // remplacer la valeur
      s1 := s1 + '^' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1), length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('*', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('*', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToFloat(trim(s1)) * strToFloat(trim(s2)));
      // remplacer la valeur
      s1 := s1 + '*' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1), length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('/', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('/', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      if (s2 <> '0') and (s2 <> '-0') then
        retour := FloatToStr(strToFloat(trim(s1)) / strToFloat(trim(s2)))
      else
        retour := '0';
      // remplacer la valeur
      s1 := s1 + '/' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('\', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('\', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToint(trim(s1)) Mod strToint(trim(s2))); // calcule le modulo 10 mod 3=1
      // remplacer la valeur
      s1 := s1 + '\' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('+', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('+', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToFloat(trim(s1)) + strToFloat(trim(s2)));
      // remplacer la valeur
      s1 := s1 + '+' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('-', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('-', Value);
      If posi = 1 then
        posi := 1 + pos('-', Copy(Value,2, length(Value)));
      // ne pas compter le permier signe..
      if posi > 1 then
      begin
        // si c'est bien une opération (pas le signe de la valeur résultat) : on peut calculer...
        s1 := GetValExpr(sender, Value, posi, True);
        If Value[Posi + 1] = '-' then
        Begin
          Value[Posi + 1] := '0';
          s2 := GetValExpr(sender, Value, posi, False);
        end
        Else
        Begin
          s2 := GetValExpr(sender, Value, posi, False);
        End;
        If s1 <> '' then
        begin
          retour := FloatToStr(strToFloat(trim(s1)) - strToFloat(trim(s2)));
          // remplacer la valeur
          s1 := s1 + '-' + s2;
          Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
        // faire un appel récursif
          EvalExpression(Sender, Value);
        end;
      end
    end;
    // Gérer le double Signe - du départ : le supprimer
    If Value[1] = '-' then
      If Value[2] = '-' then
        Value := '-' + Copy(Value, 3, length(Value));  // := '0';
  end;
  // Retourner la valeur
  EvalExpression := Value;
end;

Conclusion :


L'appel de l'évaluateur se fait de la façon suivante :
resultat.Caption := ListeVar.EvalExpression('2*((2^4+4)*5)*5');

NOTA : le résultat retourné est une chaine de caractère... pour l'utiliser en numérique il faut la convertir...

NOTA 2 : Pour la compatibilité avec l'ensemble de composants que je suis en train de développer, j'ai été obligé de remplacer les () par des {}.... Donc pensez à utiliser les {} au lieu des () sinon Erreur !!! (car j'utilise cette évaluateur d'expression dans des requêtes SQL....)... Merci de votre comprehension et désolé pour ce petit désagrément, remplacer simplement les {} par des () pour une utilisation normale
Tous les BUG connus sont Corrigés dans cette source.... (merci Japee, GrandVizir, xoleras, pyroflo)

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
1
Date d'inscription
jeudi 13 juillet 2006
Statut
Membre
Dernière intervention
4 septembre 2006
Bravo FFERT,
Et merci de penser à ceux qui programment en autoditacte et dont ce n'est pas le métier, perso pour mon projet j'ai gagné un temps considérable car ta source correspond exactement à mes besoins... Note pour ma part : 15/20. A+
Signaler
Messages postés
1106
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
3 septembre 2006
 21
Il faudrait vraiment être fou pour affirmer que cette MAJ fonctionne. Je vois mal où est la pleine fonctionnalité que présupposent les descriptions.

1) Dans le cas où il y a des contraintes de syntaxe, il faut implémenter un correcteur de syntaxe. C'est d'ailleurs ce que je ferai sur mon ID=20662.
2) ln{2}=ln2 Woaa!!
3) Que disais-je à propos du var ?
4) Pourquoi un TObject survient-il ? Je mets un NIL en paramètre pour ignorer.
5) Incohérence dans l'explication finale: parenthèses, vraiment ??
6) Il faudrait implémenter un ZIP. Ca évitera de perdre du temps déjà si précieux, ou de se tromper dans les commentaires parce que le source a été manipulé comme il ne faudrait pas.

Sinon, quand c'est voté, c'est voté. Il faudra compter sur les nouveaux visiteurs. C'est bête ça d'ailleurs de ne pas pouvoir corriger un vote. Faudra avertir Nix !! S'il nous regarde...

Donc, voilà. Sans vouloir être méchant, c'est vraiment toujours très étrange. Cependant, il est vrai qu'il y a eu de bonnes modifications. J'accorde donc virtuellement un bonus. :)
Signaler
Messages postés
63
Date d'inscription
samedi 18 janvier 2003
Statut
Membre
Dernière intervention
15 décembre 2009
CA Y EST, voilà la dernière version qui fonctionne !!!

(avant que vous ne trouviez d'autres Bugs !! :)) )

Comme elle fait parti d'un grand projet : pensez à utiliser les {} au lieu des () dans vos expressions à évaluer. ou bien remplacer dans ma source les {} par des ()... au choix.

J'ai volontairement désactiver 2 zones : gestion des variables et exécution de fonctions spéciales, car la source aurait été trop volumineuse....
Mais vous retrouverez tous ceci lors de la publication du projet complet...

Merci à bientôt... si vous avez des commentaires n'hésitez pas....

Au fait xoleras, je connais pas Free Pascal, mais je n'ai rien utilisé de spécial dans cette source...

Bon utilisation de ce code !!! (PS : si cette nouvelle mouture vous convient mieux : faite remonter la note ça marque mal !!!) :)))))))))))

bye
Signaler
Messages postés
63
Date d'inscription
samedi 18 janvier 2003
Statut
Membre
Dernière intervention
15 décembre 2009
Ok Merci à tous pour ces commentaires...

Je vais essayer d'en tenir compte et d'y remédier...

En fait depuis que je l'ai posté, j'ai été obligé de modifier ce code... Mais je ne l'ai pas remis à jour ici !!! désolé...

Car cela fait parti d'un projet de plus grande envergure !!!! Un générateur d'application base de données !!! (avec le quel on peut faire n'importe quel type d'application sans recompiler une seule ligne !!!)... Donc désolé par manque de temps j'ai pas fait de mise à jour... J'essayerai de l'exécuter rapidement... Mais de toute façon je vais probablement publier mon projet ici... Donc...

Merci encore, à bientôt..
Signaler
Messages postés
2
Date d'inscription
dimanche 21 novembre 2004
Statut
Membre
Dernière intervention
21 novembre 2004
Votre évaluateur ne fonctionne pas sous Free Pascal (100% compatible Delphi)

Expressions unaires (du type '-25', '666'): OK

Autres expressions: plantage avec un message d'erreur vide.
Afficher les 11 commentaires
S'inscrire maintenant

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.

Du même auteur (ffert)