String Term Rechner [Delphi]

[warfley]

Hey ho Leute,

für ein aktuelles Projekt brauchte ich eine Funktion die Terme die als String angegeben werden ausrechnen kann. Da so etwas bestimmt jeder mal gebrauchen kann stelle ich diese für euch zur freien Verfügung.

Ist zwar in Delphi geschrieben, aber wer nicht grade vollends blöd ist sollte das einfach in andere Sprachen übersetzten können.

Das ganze kennt die befehle +, -, *, /, sowie POW was für hoch steht, und ROOT was für wurzel steht (So ist 2 POW 3 also 2³ und 2 ROOT 4 die quadratwurzel (2te wurzel) aus 4)

Es werden multiple klammer ebenen unterstützt, aber wichtig ist dass operatoren und zahlen durch leerstellen getrennt sind, d.h. 3+2 ist nicht gültig, 3 + (1 + 2) schon

Vllt baue ich noch ein paar sachen wie sinus und cosinus ein, aber so funktioniert es vorerst schon recht gut (auch wenn es wohl nicht die performanteste lösung ist)

uses Math;

type
  TOperator = (opNil, opAdd, opSub, OpMulti, OpDiff, opPow, opRoot);
  PValue = ^TValue;

  TValue = record
    Op: TOperator;
    Val: Real;
  end;

function Evaluate(Inp: string): Real;
  procedure Calc(ValLst: TList; i: Integer);
  var
    val1, val2: PValue;
    z: Integer;
  begin
    val1 := ValLst[i];
    val2 := ValLst[i + 1];
    if (val1^.Op = opAdd) or (val1^.Op = opSub) then
    begin
      if (val2^.Op = OpMulti) or (val2^.Op = OpDiff) or (val2^.Op = opRoot) or
        (val2^.Op = opPow) then
        Calc(ValLst, i + 1);
    end
    else if (val1^.Op = OpMulti) or (val1^.Op = OpDiff) then
    begin
      if (val2^.Op = opRoot) or (val2^.Op = opPow) then
        Calc(ValLst, i + 1);
    end;
    case val1^.Op of
      opAdd:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := val1^.Val + val2^.Val;
        end;
      opSub:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := val1^.Val - val2^.Val;
        end;
      OpMulti:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := val1^.Val * val2^.Val;
        end;
      OpDiff:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := val1^.Val / val2^.Val;
        end;
      opPow:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := Power(val1^.Val, val2^.Val);
        end;
      opRoot:
        begin
          val1^.Op := val2^.Op;
          val1^.Val := Power(val2^.Val, 1 / val1^.Val);
        end;
    end;
    Dispose(ValLst[i + 1]);
    ValLst.Delete(i + 1);
  end;

  function IsFloat(S: string): boolean;
  var
    f: extended;
  begin
    Result := TextToFloat(PChar(S), f, fvExtended);
  end;

  function Eval(str: string; var i: Integer): Real;
  var
    tmp: string;
    Vals: TList;
    x: Integer;
    tmpVal: PValue;
  begin
    Vals := TList.Create;
    tmpVal := nil;
    try
      // Zwischenspeicher
      tmp := '';
      repeat
        inc(i);
        // Wenn leer, nach einem operator oder zahl des terms
        if (str[i] = ' ') then
        begin
          // Wenn es ein Operator ist
          if tmp = '+' then
          begin
            tmpVal^.Op := opAdd;
          end
          else if tmp = '-' then
          begin
            tmpVal^.Op := opSub;
          end
          else if tmp = '*' then
          begin
            tmpVal^.Op := OpMulti;
          end
          else if tmp = '/' then
          begin
            tmpVal^.Op := OpDiff;
          end
          else if tmp = 'POW' then
          begin
            tmpVal^.Op := opPow;
          end
          else if tmp = 'ROOT' then
          begin
            tmpVal^.Op := opRoot;
          end
          else if IsFloat(tmp) then // Wenn es eine zahl ist (zahl immer vor op)
          begin
            if not Assigned(tmpVal) then
              new(tmpVal); // Neue Value erstellen
            tmpVal^.Val := StrToFloat(tmp); // zahl setzen
            tmpVal^.Op := opNil; // Operator auf nil
          end;

          if Assigned(tmpVal) then // wenn zahl erstellt
            if (tmpVal^.Op <> opNil) then // Und operator gesetzt
            begin
              Vals.Add(tmpVal); // Zur liste hinzufügen
              tmpVal := nil;
            end;

          tmp := '';
        end
        else if str[i] = '(' then // Bei Subterm
        begin
          if tmpVal = nil then
            new(tmpVal); // Neue Value erstellen
          tmpVal^.Val := Eval(str, i); // zahl setzen
          inc(i);
          tmpVal^.Op := opNil; // Operator auf nil
        end
        else if str[i]<>')' then
          tmp := tmp + str[i];
        if ((i = Length(str)) or (str[i] = ')')) then
        begin
          if IsFloat(tmp) then
          begin
            if not Assigned(tmpVal) then
              new(tmpVal); // Neue Value erstellen
            tmpVal^.Val := StrToFloat(tmp); // zahl setzen
            tmpVal^.Op := opNil; // Operator auf nil
          end;
          if Assigned(tmpVal) then
            Vals.Add(tmpVal);
        end;
      until ((str[i] = ')') Or (i > Length(str))); // wiederholen für jedes zeichen bis subterm oder zeilen ende
      // Rechenen
      repeat
        x := 0;
        repeat
          Calc(Vals, x);
          inc(x);
        until (x >= Vals.Count - 2);
      until (Vals.Count = 1);
      Result := PValue(Vals[0])^.Val;
    finally
      for x := 0 to Vals.Count - 1 do
        Dispose(Vals[x]);
      Vals.Free;
    end;
  end;

var
  i: Integer;

begin
  i := 0;
  result:=Eval(Inp, i);
end;

[Serraniel]

Danke, finde ich ist ein hilfreiches Snippet für die, die mit Delphi arbeiten (wie ich manchmal).