kleiner, vlt auch etwas uneffizienter Mathe Parser

[mr_emre_d]

:)

Mir war fad :(

Erkläuterung:

Code:

o Punkt vor Strich wird beachtet
o +-*/ kann er sehr gut lösen
o Klammern () werden unterstützt
evt buggy:
o Potenzieren via ^ möglich
o Wurzel ziehen XsY  -> 9s2 --> 3

EDIT
Math Unit wird benötigt

Aufruf könnte wie "ShowMessage( SolveProblem( Edit1.Text ) )" folgen

EDIT #n
Es sind keine Fehlerbehandlungen mit eingebaut worden:
Fehler:
- doppelte Operatoren
- Klammer offen vergessen
- "4+2-" ...
So das ist mein letzter Edit heute ...
Wünsch euch allen eine gute Nacht

Code:

Delphi-Quellcode:

var
  Operators: Set of Char = ['s', '^','+', '-', '*', '/'];
  Clamp: Set of Char = [ '(', ')', #8];
  Numbers: Set of Char = [ '0'..'9' ];

function SolveProblem( Problem: String ): String;
var
  newProblem: String;
  x, t: Word;          // x = pos, solution, ...
  Solution: Single;
  function OperatorInString(Buf: String): Boolean;
  begin
    Result := True;
    if Pos('s', Buf) = 0 then
      if Pos('^', Buf) = 0 then
        if Pos('*', Buf) = 0 then
          if Pos('/', Buf) = 0 then
            if Pos('+', Buf) = 0 then
              if Pos('-', Buf) = 0 then
                Result := False;
  end;
  // x3+3 --> x = left | startpos = +
  function GetLeft(P: String; StartPos: Word): Word;
  var
    x: Word;
  begin
    x := StartPos-1;
    while (P[x] in Numbers) and (x>=1) do
      dec(x);
    if x = 0 then
      Result := 1
    else
      Result := x+1;
  end;
  // 3+3x --> x = left | startpos = +
  function GetRight(P: String; StartPos: Word): Word;
  var
    x: Word;
  begin
    x := StartPos+1;
    while (P[x] in Numbers) and (x<=Length(P)) do
      inc(x);
    Result := x;
  end;
  {leftcompo+12}
  function GetLeftComponent(P: String): Single;
  var
    x: Word;
  begin
    x := Pos( 's', LowerCase(P) );
    if x = 0 then
      x := Pos( '^', P );
    if x = 0 then
      x := Pos( '*', P );
    if x = 0 then
      x := Pos( '/', P );
    if x = 0 then
      x := Pos( '+', P );
    if x = 0 then
      x := Pos( '-', P );
    if x = 0 then
      Result := x
    else
      result := StrToFloat( Copy( P, 1, x-1 ) );
  end;
  {123+rightcompo}
  function GetRightComponent(P: String): Single;
  var
    x: Word;
  begin
    x := Pos( 's', LowerCase(P) );
    if x = 0 then
      x := Pos( '^', P );
    if x = 0 then
      x := Pos( '*', P );
    if x = 0 then
      x := Pos( '/', P );
    if x = 0 then
      x := Pos( '+', P );
    if x = 0 then
      x := Pos( '-', P );
    if x = 0 then
      Result := x
    else
      result := StrToFloat( Copy( P, x+1, Length(p) ) );
  end;
  { (1*3*5+3+2 ..) }
  function SolveThatProblems(var P: String ): Single;
  var          //  3*5*6+5*6
    Sqrt, Sqr,
    Dot, _Div,
    Plus, Minus,
    x, y: Word;
    c1, c2: Single;
    buf: String;
  begin
    Minus := 0;
    Sqr := Pos( '^', P );
    if Sqr = 0 then
      Sqrt := Pos( 's', LowerCase(P) );
    if Sqrt = 0 then
      Dot := Pos( '*', P );
    if Dot = 0 then
      _Div := Pos( '/', P );
    if _Div = 0 then
      Plus := Pos( '+', P );
    if Plus = 0 then
      Minus := Pos( '-', P );

    if (Sqr > 0) then
    begin
      x :=  GetLeft(P, Sqr);
      y := GetRight(P, Sqr);
    end else
    if (Sqrt > 0) then
    begin
      x :=  GetLeft(P, Sqrt);
      y := GetRight(P, Sqrt);
    end else
    if (Dot > 0) then
    begin
      x :=  GetLeft(P, Dot);
      y := GetRight(P, Dot);
    end else
    if (_Div > 0) then
    begin
      x :=  GetLeft(P, _Div);
      y := GetRight(P, _Div);
    end else
    if (Plus > 0) then
    begin
      x :=  GetLeft(P, Plus);
      y := GetRight(P, Plus);
    end else
    if (Minus > 0) then
    begin                 
      x :=  GetLeft(P, Minus);
      y := GetRight(P, Minus);
    end else
    begin
      Result := 0;
      Exit;
    end;
    buf := copy( P, x, y-x );
    c1 :=  GetLeftComponent( buf );
    c2 := GetRightComponent( buf );
    if Sqr > 0 then
      Result := Power( c1, c2 )
    else
    if Sqrt > 0 then
      Result := Power( c1, 1/c2 )
    else
    if Dot > 0 then
      Result := c1*c2
    else
    if _Div > 0 then
      Result := c1/c2
    else
    if Plus > 0 then
      Result := c1+c2
    else
    if Minus > 0 then
      Result := c1-c2;
    delete( P, x, y-x );
    Insert( FloatToStr(Result), P, x );
    if OperatorInString(P) then
      SolveThatProblems(P)
    else
      Result := StrToFloat(P);
  end;
  function KlammerEnde(buf: String): Word;
  var
    kAufs, kZus: Word;
    i: Integer;
  begin
    kAufs := 0;
    kZus  := 0;
    for i := 1 to Length(buf) do
    begin
      if buf[i] = '(' then
        inc(kAufs)
      else
      if buf[i] = ')' then
      begin
        inc(kZus);
        if kAufs-kZus=0 then
        begin
          Result := i;
          Exit;
        end;
      end;
    end;
  end;
begin
  x := Pos('(', Problem);
  if x > 0 then
  begin
    newProblem := Copy( Problem, x+1, KlammerEnde(Problem)-x-1 );  // ausdruck in klammern
    Delete( Problem, x, Length(NewProblem)+2 );
    Insert( SolveProblem( newProblem ), Problem, x);
    x := Pos( '(', Problem );
    if x > 0 then
      Problem := SolveProblem( Problem );  // löse werte in einer klammer auf
  end;
  if OperatorInString( Problem ) then
    SolveThatProblems( Problem );
  Result := Problem;
end;

MfG

[Dax]

Kann dein Parser mit ((1+2)+3)+4 umgehen? Und in der Tat ist das ganze.. naja, sehr langsam. Stringoperationen sind ungefähr das langsamste was es gibt, geschlagen nur von Operationen auf physischem Zeugs ;)

[mr_emre_d]

Jetzt schon :)

Du sagtest stringoperatoren seien zu langsam:
Wie sollte ichs sonst machen ?

[Dax]

(1+2)+(3+4)

Du könntest den String zu einem Baum auseinanderpflücken und jeweils einzelne Teilbäume berechnen, wobei Attribute eines Nodes die Operation beschreiben. Damit sparst du dir das löschen/einfügen.

[mr_emre_d]

Ok es war ein kleiner Fehler drinnen, der nun gefixt ist

[Dax]

Oke, weils so schön ist: 1/*2

[mr_emre_d]

ouukaayy... Was ist denn bitte das für eine Rechnung ?
Falls du die Fehlerbehandlung meinst:
Siehe Post ( - sie wird nicht behandelt )

MfG

[Dax]

Nagut, wenn du drauf bestehst ;)

2s2 + 1

[mr_emre_d]

:cry:

[Dax]

Das ist nicht böse gemeint ;) Ich will dir nur Schwachstellen in deiner Implementation zeigen und dich dazu bringen, selbst danach zu suchen. Der Parser ist an sich schon ein guter Anfang, so ist es ja nicht - aber für Real Word Usage™ noch nicht geeignet.