Einheiten parsen

[Bjoerk]

Ja, das weiß ich doch selbst? Dieser Parser arbeitet aber halt anders. Ansonsten ja zum Beispiel so, so einen hab ich auch mal gemacht.

Delphi-Quellcode:

procedure TParser.ParseFunctions(var S: string);
var
  Index: integer;
begin
  Index := OperatorPos(S, 'A');
  while Index > 0 do
  begin
    MathWork(S, Index);
    Index := OperatorPos(S, 'A');
  end;
end;

procedure TParser.ParseOperator(var S: string; const AOperator: Char);
var
  Index: integer;
begin
  Index := OperatorPos(S, AOperator);
  while Index > 0 do
  begin
    MathWork(S, Index);
    Index := OperatorPos(S, AOperator);
  end;
end;

procedure TParser.Parse(var S: string);
begin
  // Diese Reihenfolge
  ParseFunctions(S); // Funktionen, Von Rechts nach Links;
  ParseOperator(S, '^'); // Power, Von Rechts nach Links;
  ParseOperator(S, '*'); // Punktrechnung, Von Links nach Rechts;
  ParseOperator(S, '+'); // Strichrechnung Von Links nach Rechts;
end;

function TParser.Solve(T: string; Sender: boolean): string; // Aufruf mit Sender = false;
var
  A, B: Integer;
  S: string;
  AFloat: double;
begin
  while HaveBrackets(T, A, B) do
  begin
    S := StrMid(T, A + 1, B - 1);
    Solve(S, true);
    Parse(S);
    T := StrLeft(T, A - 1) + S + StrRight(T, B + 1);
  end;
  if not Sender then
  begin
    Parse(T);
    if TryStrToFloat(GetNumber(T), AFloat) then
      Result := GetNumber(T)
    else
      Result := '0'; // Syntaxerror
  end;
end;

[Bjoerk]

Was ich aber nicht hinkrieg ist daraus einen Stack zu machen? :oops:

Delphi-Quellcode:

function TJMUnitParser.Solve(S: string): TParserUnitStyle;
begin
  try
    if LastPos('+', S) > 0 then
      Result := FUnits.GetAdd(Solve(Left(S, '+', true)), Solve(Right(S, '+', true)))
    else
      if LastPos('/', S) > 0 then
        Result := FUnits.GetMult(Solve(Left(S, '/', true)), Solve(Right(S, '/', true)))
      else
        if LastPos('*', S) > 0 then
          Result := FUnits.GetDiv(Solve(Left(S, '*', true)), Solve(Right(S, '*', true)))
        else
          if FirstPos('^', S) > 0 then
            Result := FUnits.GetPower(Solve(Left(S, '^', false)), Solve(Right(S, '^', false)))
          else
            if Parenthesis(S) then
              Result := Solve(S)
            else
              Result := FUnits.SignToStyle(S);
  except
    Result := pusNone;
  end;
end;

In meinem jugendlichen Leichtsinn hab ich mal dahin überlegt? Geht das so in der Richtung? :gruebel:

Delphi-Quellcode:

function TJMUnitParser.Solve(const Term: string): TParserUnitStyle;
var
  Stack: TParserStack;
begin
  Result := pusNone;
  Stack := TParserStack.Create;
  try
    Stack.Push(Term);
    while not Stack.Empty do
    begin
      S := Stack.Pop.S;
      if LastPos('+', S) > 0 then
      begin
        Result :=
        Stack.Push(S);
      end
      else
        if LastPos('/', S) > 0 then
        begin
          Result :=
          Stack.Push(S);
        end
        else
          if LastPos('*', S) > 0 then
          begin
            Result :=
            Stack.Push(S);
          end
          else
            if Parenthesis(S) then
            begin
              Result :=
              Stack.Push(S);
            end
            else
              Result := FUnits.SignToStyle(S);
    end;
  finally
    Stack.Free;
  end;
end;

[Dejan Vu]

Ein Parser wird einen Baum erzeugen (wenn er das Ergebnis nicht schon zur Parsezeit ausrechnet). Mir fehlt bei deinem Parser einfach nur der Lexer. Ich würde das einfach nicht alles zusammen wurschteln, das ist alles.

[Bjoerk]

Der Witz an diesem Parser ist ja daß er keinen Tokenizer braucht. Durch z.B.

Delphi-Quellcode:

(Solve(Left(S, '+')), Solve(Right(S, '+')))

wird das Token + gezogen. Left ist der Tel links vom Operator, Right rechts davon.

Ich hab echt keinen Plan wie ich das hier machen kann? Hab nur einmal einen Stack ala Floodfill gemacht.

[Dejan Vu]

Na ja. Man braucht wirklich keinen modularen Aufbau und kann alles in eine Klasse stecken, ist schon klar. Irgendwo hier ist auch Code für einen Parser der mit 50 Zeilen Code auskommt.

[Bjoerk]

Ich lass es rekursiv. Die Wahrscheinlichkeit eines Stackoverflow ist m.E. ziemlich gering.

Der Stack sieht z.B. so aus. Das ist keine UPN.

1+3+5

Result1 = 1+3+5 = Result3 + Result4 + Result5
Result2 = 1+3 (Left) = Result3 + Result4
Result3 = 1 (Left)
Result4 = 3 (Right)
Result5 = 5 (Right)

Result = Result1

[Bjoerk]

Zitat:

Zitat von Dejan Vu (Beitrag 1293385)

Irgendwo hier ist auch Code für einen Parser der mit 50 Zeilen Code auskommt.

50 Zeilen ist heftig. Bin bei 120 Zeilen (inkl. unärem Minus). Schönes WE. :)

Delphi-Quellcode:

unit uSimpleParser; // (C) 2011, Dr. Joachim Mohr, Dipl.-Ing. Thomas Abel;

interface

uses
  SysUtils, StrUtils, Math;

function TermToFloat(S: string): double;

implementation

function OperatorPos(const Substr, S: string): integer;
var
  I, N: integer;
begin
  Result := 0;
  N := 0;
  for I := Length(S) downto 1 do
  begin
    if S[I] = '(' then Inc(N);
    if S[I] = ')' then Dec(N);
    if N = 0 then
      if PosEx(Substr, S, I) = I then
      begin
        Result := I;
        Break;
      end;
  end;
end;

function StrMid(const S: string; const A, B: integer): string;
begin
  Result := Copy(S, A, B - A + 1)
end;

function StrLeft(const S: string; const B: integer): string;
begin
  Result := StrMid(S, 1, B);
end;

function StrRight(const S: string; const A: integer): string;
begin
  Result := StrMid(S, A, Length(S));
end;

function Left(const S, Substr: string): string;
begin
  Result := StrLeft(S, OperatorPos(Substr, S) - 1);
end;

function Right(const S, Substr: string): string;
begin
  Result := StrRight(S, OperatorPos(Substr, S) + Length(Substr));
end;

function Parenthesis(var S: string; const Minus: boolean): boolean;
begin
  Result := false;
  if Minus then
  begin
    if Length(S) > 3 then
      if Copy(S, 1, 2) = '~(' then
      begin
        S := StrMid(S, 3, Length(S) - 1);
        Result := true;
      end;
  end
  else
  begin
    if Length(S) > 2 then
      if S[1] = '(' then
      begin
        S := StrMid(S, 2, Length(S) - 1);
        Result := true;
      end;
  end;
end;

function Solve(S: string): double;
begin
  try
    if OperatorPos('+', S) > 0 then
      Result := Solve(Left(S, '+')) + Solve(Right(S, '+'))
    else
      if OperatorPos('-', S) > 0 then
        Result := Solve(Left(S, '-')) - Solve(Right(S, '-'))
      else
        if OperatorPos('*', S) > 0 then
          Result := Solve(Left(S, '*')) * Solve(Right(S, '*'))
        else
          if OperatorPos('/', S) > 0 then
            Result := Solve(Left(S, '/')) / Solve(Right(S, '/'))
          else
            if Parenthesis(S, true) then
              Result := -Solve(S)
            else
              if Parenthesis(S, false) then
                Result := Solve(S)
              else
                Result := StrToFloat(StringReplace(S, '~', '-', []));
  except
    Result := 0;
  end;
end;

function TermToFloat(S: string): double; // ~ für unäres Minus;
begin
  Result := 0;
  S := StringReplace(S, #32, '', [rfReplaceAll]);
  if Length(S) > 0 then
  begin
    if S[1] = '-' then S[1] := '~';
    if S[1] = '+' then Delete(S, 1, 1);
    S := StringReplace(S, '*+', '*', [rfReplaceAll]);
    S := StringReplace(S, '/+', '/', [rfReplaceAll]);
    S := StringReplace(S, '(+', '(', [rfReplaceAll]);
    S := StringReplace(S, '*-', '*~', [rfReplaceAll]);
    S := StringReplace(S, '/-', '/~', [rfReplaceAll]);
    S := StringReplace(S, '(-', '(~', [rfReplaceAll]);
    Result := Solve(S);
  end;
end;

end.

[Sailor]

Es ist kein simples Problem, jedenfalls, wenn man es allgemeiner halten will. Ich habe mich aus Interesse mal daran versucht, im Anhang gibt es dazu ein kleines, bei weitem nicht perfektes Programm. Für eine generelle Lösung müßte man natürlich einen Einheitenparser gemäß SI implementieren.

[Bjoerk]

Hallo Sailor,
konnte deinen Code leider nicht testen weil ich keine Generics hab. Was ich bei Tests mit meinen Parser jedoch festgestellt habe, daß im Verlauf des Parsens Einheiten entstehen können die nicht existieren, z.B. bei 1 kN/m3 / 1 m3 * 1 m3 = 1 kN/m6 * 1 m3 = 1 kN/m3. Deshalb mache ich zwei Durchläufe, einmal / vor * und einmal * vor /.

[Sailor]

Die Generics sind nur der Beqemlichkeit geschuldet, man kann die üblichen arithmetischen Operatoren beibehalten. Ändere die generischen Operatoren (+,-,*,/) einfach in Funktionsaufrufe. d.h. da, wo in der Unit Actions "Normalize(Pop)+Normalize(Pop)" steht, machst Du "Add(Normalize(Pop),Normalize(Pop))" draus und änderst "CLASS OPERATOR Add..." in der Unit ExpStack zu "FUNCTION Add...". In der Unit Actions müßten bei "/" und "-" eigentlich die beiden oberen Stackelemente vertauscht werden. Ich habe aber gelernt, daß zumindest in D2010 die Parameter von rechts nach links ausgewertet werden. Na ja, Funktionen mit Seiteneffekten sind eben des Teufels. Ansonsten ist deine Aufgabe nicht ohne. Das eigentliche Problem ist die Synchronität von numerischen Ausdrücken und Einheitenausdrücken, ansonsten kann da viel Unsinn passieren. In einer verallgemeinerten Variante würde ich eine Arithmetik über den Einheiten aufbauen. Richtig fies wird es aber erst, wenn Variable zugelassen sind. Dann gibt es so schöne Dinge wie "3 kN/m * 4 kN / 3 m", eine echte Herausforderung :twisted:. Und wie gesagt, in meiner Variante gibt es sicher auch noch Überraschungen, ich hatte keine Zeit, das Ding ausgiebig zu testen.