delphi - Delphi Prism: 複雑な式を評価するための TMathparser クラスの置き換え?

Question

Delphi では、式を評価して答えを得るために TMathparser というコンポーネントを使用します。Delphi Prism で動作させようとしていますが、うまくいきません。実際、エラーが多すぎます。それで、Delphi Prism で動作する同様のものがあるかどうか疑問に思っていました。

ありがとう、

score 1 · Accepted Answer

他の人の役に立つことを願ってクラスを投稿しています。

デビッドが指摘したように、私はこれをここに投稿する必要があると思います。さもないと、私の答えを完全に削除する必要があります。

{==========================================================================}
{ Expression Evaluator v1.4 for Delphi                                     }
{ (16 & 32 bits)                                                           }
{                                                                          }
{ Copyright © 1997 by BitSoft Development, L.L.C.                          }
{ All rights reserved                                                      }
{                                                                          }
{ Web:     http://www.bitsoft.com                                          }
{ E-mail:  info@bitsoft.com                                                }
{ Support: tech-support@bitsoft.com                                        }
{--------------------------------------------------------------------------}
{ Portions Copyright © 1992 by Borland International, Inc.                 }
{ All rights reserved                                                      }
{--------------------------------------------------------------------------}
{ This file is distributed as freeware and without warranties of any kind. }
{ You can use it in your own applications at your own risk.                }
{ See the License Agreement for more information.                          }
{==========================================================================}

Prism用のMathparserクラスの修正バージョンは次のとおりです。

namespace MathParserClass;

interface

uses
  System.Collections.Generic,
  System.Collections.*,
  System.Text;

type
    TExtendedWrapper = class(Object)
    public
    MyNumber: Extended;
    constructor;
    end;

type
  TGetVarEvent = procedure(Sender : System.Object; VarName : string; var
    Value : Extended; var Found : Boolean) of object;

  TParseErrorEvent = procedure(Sender : System.Object; ParseError : Integer)
    of object;

const
  ParserStackSize = 15;
  MaxFuncNameLen = 5;
  ExpLimit = 11356;
  SqrLimit = 1E2466;
  MaxExpLen = 4;
  TotalErrors = 7;
  ErrParserStack = 1;
  ErrBadRange = 2;
  ErrExpression = 3;
  ErrOperator = 4;
  ErrOpenParen = 5;
  ErrOpCloseParen = 6;
  ErrInvalidNum = 7;

type
  ErrorRange = 0..TotalErrors;

  TokenTypes = (Plus, Minus, Times, Divide, Expo, OParen, CParen, Num,
                Func, EOL, Bad, ERR, Modu, tmp);

  TokenRec = record
    State : Byte;
    Value : Extended;
    FuncName : String;
  end; { TokenRec }

type
  MathParser = class(System.Object)
  private
    { Private declarations }   //moved to public
      FInput : string;     //was private
      FOnGetVar : TGetVarEvent; //was private
      FOnParseError : TParseErrorEvent; //was private

  protected
      CurrToken : TokenRec;   //was protected begin
      MathError : Boolean;
      Stack : array[1..ParserStackSize] of TokenRec;
      StackTop : Integer;//0..ParserStackSize;
      TokenError : ErrorRange;
      TokenLen : Word;
      TokenType : TokenTypes;
      method GotoState(Production : Word) : Word;
      method IsFunc(S : String) : Boolean;
      method IsVar(var Value : Extended) : Boolean;
      method NextToken : TokenTypes;
      method Push(Token : TokenRec);
      method Pop(var Token : TokenRec);
      method Reduce(Reduction : Word);
      method Shift(State : Word);
                                      //was protected end

      public
      { Public declarations }
      Queue: Queue;   //not on-> on now
      Queue2: Queue;   //not on-> on now
      QueueHR: Queue;
      Position : Word; { Public declarations moved above}
      ParseError : Boolean;  { Public declarations moved above}
      ParseValue : Extended; { Public declarations moved above}
      TempToken : TokenRec;
      constructor;
      procedure Parse;
      property OnGetVar : TGetVarEvent read FOnGetVar write FOnGetVar;
      property OnParseError : TParseErrorEvent read FOnParseError write FOnParseError;
      property ParseString : string read FInput write FInput;
  end;



var
 FirstTimeThru, SecondTimeThru : Boolean;
 FirstTimeThruHR, SecondTimeThruHR : Boolean;
 FirstTimeThru3, SecondTimeThru3 : Boolean;
 FirstTimeThru4, SecondTimeThru4 : Boolean;
 icnt, icnt2, icnt3, icnt4, timecount : integer;
 NetAmount, NetAmount3, RunningTotalForMinute:extended;
 PrevToken, PrevToken3, PrevToken4, CurrentToken :extended;
 NetAmountHR, RunningTotalForHour, PrevTokenHR:extended;
 CurrentTokenHR,LastResultMin, LastResultHr:extended;
 toggleMin, toggleHr : boolean;
 kk,jj, m : integer;

implementation
const
  Letters : set of Char = ['A'..'Z', 'a'..'z'];
  Numbers : set of Char = ['0'..'9'];

constructor MathParser;
begin
  { defaults }
  FInput := '';
  FirstTimeThru := true;
  SecondTimeThru := false;
  FirstTimeThruHR := true;
  SecondTimeThruHR := false;
  FirstTimeThru3 := true;
  SecondTimeThru3 := false;
  FirstTimeThru4 := true;
  SecondTimeThru4 := false;
  toggleMin := true;
  toggleHr := true;
  //TempToken.Value := 0.0;
  RunningTotalForMinute := 0.0;
  RunningTotalForHOUR := 0.0;
  kk:=1;
  jj:=1;
  m:=0;
  Queue := new Queue; //need this here
  Queue2 := new Queue; //need this here
  QueueHR := new Queue; //need this here
  timecount := 0;
end;

method MathParser.GotoState(Production : Word) : Word;
{ Finds the new state based on the just-completed production and the
   top state. }
var
  State : Word;
begin
     //GotoState := 0;
     Result:=0;
  State := Stack[StackTop].State;
  if (Production <= 3) then
  begin
    case State of
      0 : Result:=1; //GotoState := 1;
      9 : Result:=19; //GotoState := 19;
      20 : Result:=28; //GotoState := 28;
    end; { case }
  end
  else if Production <= 6 then
  begin
    case State of
      0, 9, 20 : Result:=2; //GotoState := 2;
      12 : Result:=21; //GotoState := 21;
      13 : Result:=22; //GotoState := 22;
    end; { case }
  end
  else if (Production <= 8) or (Production = 100) then
  begin
    case State of
      0, 9, 12, 13, 20 : Result:=3; //GotoState := 3;
      14 : Result := 23; //GotoState := 23;
      15 : Result := 24; //GotoState := 24;
      16 : Result := 25; //GotoState := 25;
      40 : Result := 80; //GotoState := 80;
    end; { case }
  end
  else if Production <= 10 then
  begin
    case State of
      0, 9, 12..16, 20, 40 : Result := 4; //GotoState := 4;
    end; { case }
  end
  else if Production <= 12 then
  begin
    case State of
      0, 9, 12..16, 20, 40 : Result := 6; //GotoState := 6;
      5 : Result := 17; //GotoState := 17;
    end; { case }
  end
  else begin
    case State of
      0, 5, 9, 12..16, 20, 40 : Result:=8; //GotoState := 8;
    end; { case }
  end;
end; { GotoState }

method MathParser.IsFunc(S : String) : Boolean;
{ Checks to see if the parser is about to read a function }
var
  P, SLen : Word;
  FuncName : string;
begin
  P := Position;
  FuncName := '';

  while (P < Length(FInput)) do
  begin
    if (FInput[P] in ['A'..'Z', 'a'..'z', '0'..'9','_']) then
    begin
      FuncName := FuncName + FInput[P];
    end
    else
      break;
    Inc(P);
  end; { while }

  if FuncName.ToUpper = S then begin
           SLen := Length(S);
           CurrToken.FuncName := FInput.Substring(Position,SLen).ToUpper; 
           Inc(Position, SLen);
           Result:=true;//IsFunc := True;
         end { if }
    else Result:=false;//IsFunc := False;
end; { IsFunc }

method MathParser.IsVar(var Value : Extended) : Boolean;
var
  VarName : string;
  VarFound : Boolean;
begin
  VarFound := False;
  VarName := '';

  while (Position < Length(FInput)) do
  begin
    if (FInput[Position] in ['A'..'Z','a'..'z', '0'..'9', '_']) then
    begin
      VarName := VarName + FInput[Position];
    end
    else
      break;
    Inc(Position);
  end; { while }

  //if Assigned(FOnGetVar) then 
  //  FOnGetVar(Self, VarName, var Value, var VarFound);
  //If you notice above lines are commented out, for some reason the event assigned to it
  //did not fire. So, I called the method, which is defined in another namespace or file,
  //directly. It works fine. In your expression if you have a variable, this method 
  //varifies that it exists and that it can turn it to a value. It is totally upto you
  //how you define this method. It is very important to have if you are going to have
  //variables in your expression.
  MathParserGetVar(self,VarName,var Value,var VarFound);
  //IsVar := VarFound;
  Result := VarFound;
end; { IsVar }

method MathParser.NextToken : TokenTypes;
{ Gets the next Token from the Input stream }
var
  NumString : string;
  TLen, NumLen : Word;
  Check : Integer;
  Ch : Char;
  Decimal : Boolean;
  tmpVar : Double;
  tmpstr:String;
begin
     Result:=TokenTypes.tmp;
   while (Position < Length(FInput)) do
   begin
    if (FInput[Position] = ' ') then
     Inc(Position)
    else
      break;
   end;

   TokenLen := Position;
   if Position >= Length(FInput) then
   begin
     result:=TokenTypes.EOL;
     TokenLen := 0;
     Exit;
   end; { if }

   tmpstr:=FInput.Substring(Position,1).ToUpper;
   ch:=char(tmpstr[0]);
   if Ch in ['!'] then
   begin
      Result:=TokenTypes.ERR;
      TokenLen := 0;
      Exit;
   end; { if }
   if Ch in ['0'..'9', '.'] then
   begin
     NumString := '';
     TLen := Position;
     Decimal := False;

     while (TLen < Length(FInput)) do
     begin
           if ((FInput[TLen] in ['0'..'9']) or ((FInput[TLen] = '.') and (not Decimal))) then
           begin
            NumString := NumString + FInput[TLen];
            if Ch = '.' then
              Decimal := True;
           end
           else
             break;
           Inc(TLen);
     end; { while }

     if (TLen = 2) and (Ch = '.') then
     begin
       Result:=TokenTypes.BAD;
       TokenLen := 0;
       Exit;
     end; { if }

     if (TLen < Length(FInput)) then
     begin
      tmpStr := FInput.Substring(TLen,1).ToUpper;
      ch := char(tmpStr[0]);
      if (Ch in ['E']) then
      begin
       NumString := NumString + 'E';
       Inc(TLen);
       if FInput[TLen] in ['+', '-'] then
       begin
         NumString := NumString + FInput[TLen];
         Inc(TLen);
       end; { if }
       NumLen := 1;
       while (TLen <= Length(FInput)) and (NumLen <= MaxExpLen) do
       begin
         if (FInput[TLen] in ['0'..'9']) then
          NumString := NumString + FInput[TLen]
         else
          break;
         Inc(NumLen);
         Inc(TLen);
       end; { while }
      end;
     end; { if }


     if NumString[0] = '.' then
       NumString := '0' + NumString;
     if Double.TryParse(NumString, out tmpvar)=true then
     begin
        Check:=0;
        CurrToken.Value:=tmpVar;
     end
     else
        Check:=1;

     if Check <> 0 then
       begin
         MathError := True;
         TokenError := ErrInvalidNum;
         Inc(Position, NumString.Length-1);
       end { if }
     else
       begin
         Inc(Position, NumString.Length);
         TokenLen := Position - TokenLen;
         Result:=TokenTypes.NUM;
       end; { else }
     Exit;
   end { if }
   else if Ch in Letters then
   begin
     if IsFunc('ABS') or
        IsFunc('ATAN') or
        IsFunc('COS') or
        IsFunc('EXP') or
        IsFunc('LN') or
        IsFunc('ROUND') or
        IsFunc('SIN') or
        IsFunc('SQRT') or
        IsFunc('SQR') or
        IsFunc('TRUNC')
         then
     begin
       Result:=TokenTypes.FUNC;
       TokenLen := Position - TokenLen;
       Exit;
     end; { if }
     if IsFunc('MOD') then
     begin
       Result:=TokenTypes.MODU;
       TokenLen := Position - TokenLen;
       Exit;
     end; { if }
     if IsVar(var CurrToken.Value)
       then begin
              Result:=TokenTypes.NUM;
              TokenLen := Position - TokenLen;
              Exit;
            end { if }
       else begin
              Result:=TokenTypes.BAD;
              TokenLen := 0;
              Exit;
            end; { else }
   end { if }
   else begin
     case Ch of
       '+' : Result := TokenTypes.PLUS;
       '-' : Result := TokenTypes.MINUS;
       '*' : Result := TokenTypes.TIMES;
       '/' : Result := TokenTypes.DIVIDE;
       '^' : Result := TokenTypes.EXPO;
       '(' : Result := TokenTypes.OPAREN;
       ')' : Result := TokenTypes.CPAREN;
       else begin
         Result:=TokenTypes.BAD;
         TokenLen := 0;
         Exit;
       end; { case else }
     end; { case }
     Inc(Position);
     TokenLen := Position - TokenLen;
     Exit;
   end; { else if }
end; { NextToken }

procedure MathParser.Pop(var Token : TokenRec);
{ Pops the top Token off of the stack }
begin
  Token := Stack[StackTop];
  StackTop:=StackTop-1;
end; { Pop }

procedure MathParser.Push(Token : TokenRec);
{ Pushes a new Token onto the stack }
begin
  if StackTop = ParserStackSize then
    TokenError := ErrParserStack
  else begin
    StackTop:=StackTop+1;
    Stack[StackTop] := Token;
  end; { else }
end; { Push }

procedure MathParser.Parse;
{ Parses an input stream }
var
  FirstToken : TokenRec;
  Accepted : Boolean;
begin
  Position := 0;
  StackTop := 0;
  TokenError := 0;
  MathError := False;
  ParseError := False;
  Accepted := False;
  FirstToken.State := 0;
  FirstToken.Value := 0;
  Push(FirstToken);
  TokenType := NextToken;
  repeat
    case Stack[StackTop].State of
      0, 9, 12..16, 20, 40 : begin
        if TokenType = TokenTypes.NUM then
          Shift(10)
        else if TokenType = TokenTypes.FUNC then
          Shift(11)
        else if TokenType = TokenTypes.MINUS then
          Shift(5)
        else if TokenType = TokenTypes.OPAREN then
          Shift(9)
        else if TokenType = TokenTypes.ERR then
          begin
             MathError := True;
             Accepted := True;
          end { else if }
        else begin
          TokenError := ErrExpression;
          Dec(Position, TokenLen);
        end; { else }
      end; { case of }
      1 : begin
        if TokenType = TokenTypes.EOL then
          Accepted := True
        else if TokenType = TokenTypes.PLUS then
          Shift(12)
        else if TokenType = TokenTypes.MINUS then
          Shift(13)
        else begin
          TokenError := ErrOperator;
          Dec(Position, TokenLen);
        end; { else }
      end; { case of }
      2 : begin
        if TokenType = TokenTypes.TIMES then
          Shift(14)
        else if TokenType = TokenTypes.DIVIDE then
          Shift(15)
        else
          Reduce(3);
      end; { case of }
      3 : begin
       if TokenType = TokenTypes.MODU then
         Shift(40)
       else
         Reduce(6);
      end; { case of }
      4 : begin
       if TokenType = TokenTypes.EXPO then
         Shift(16)
       else
         Reduce(8);
      end; { case of }
      5 : begin
        if TokenType = TokenTypes.NUM then
          Shift(10)
        else if TokenType = TokenTypes.FUNC then
          Shift(11)
        else if TokenType = TokenTypes.OPAREN then
          Shift(9)
        else
          begin
            TokenError := ErrExpression;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      6 : Reduce(10);
      7 : Reduce(13);
      8 : Reduce(12);
      10 : Reduce(15);
      11 : begin
        if TokenType = TokenTypes.OPAREN then
          Shift(20)
        else
          begin
            TokenError := ErrOpenParen;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      17 : Reduce(9);
      18 : raise Exception('Bad token state');
      19 : begin
        if TokenType = TokenTypes.PLUS then
          Shift(12)
        else if TokenType = TokenTypes.MINUS then
          Shift(13)
        else if TokenType = TokenTypes.CPAREN then
          Shift(27)
        else
          begin
            TokenError := ErrOpCloseParen;
            Dec(Position, TokenLen);
          end;
      end; { case of }
      21 : begin
        if TokenType = TokenTypes.TIMES then
          Shift(14)
        else if TokenType = TokenTypes.DIVIDE then
          Shift(15)
        else
          Reduce(1);
      end; { case of }
      22 : begin
        if TokenType = TokenTypes.TIMES then
          Shift(14)
        else if TokenType = TokenTypes.DIVIDE then
          Shift(15)
        else
          Reduce(2);
      end; { case of }
      23 : Reduce(4);
      24 : Reduce(5);
      25 : Reduce(7);
      26 : Reduce(11);
      27 : Reduce(14);
      28 : begin
        if TokenType = TokenTypes.PLUS then
          Shift(12)
        else if TokenType = TokenTypes.MINUS then
          Shift(13)
        else if TokenType = TokenTypes.CPAREN then
          Shift(29)
        else
          begin
            TokenError := ErrOpCloseParen;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      29 : Reduce(16);
      80 : Reduce(100);
    end; { case }
  until Accepted or (TokenError <> 0);
  if TokenError <> 0 then
  begin
      if TokenError = ErrBadRange then
        Dec(Position, TokenLen);
      if Assigned(FOnParseError)
        then FOnParseError(Self, TokenError);
  end; { if }

  if MathError or (TokenError <> 0) then
  begin
    ParseError := True;
    ParseValue := 0;
    Exit;
  end; { if }
  ParseError := False;
  ParseValue := Stack[StackTop].Value;
end; { Parse }

procedure MathParser.Reduce(Reduction : Word);
{ Completes a reduction }
var
  Token1, Token2 : TokenRec;
begin

  case Reduction of
    1 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      CurrToken.Value := Token1.Value + Token2.Value;
    end;
    2 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      CurrToken.Value := Token2.Value - Token1.Value;
    end;
    4 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      CurrToken.Value := Token1.Value * Token2.Value;
    end;
    5 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      if Token1.Value = 0 then
        MathError := True
      else
        CurrToken.Value := Token2.Value / Token1.Value;
    end;

    { MOD operator }
    100 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      if Token1.Value = 0 then
        MathError := True
      else
        CurrToken.Value := int32(math.Round(Token2.Value)) mod int32(math.Round(Token1.Value));
    end;

    7 : begin
      Pop(var Token1);
      Pop(var Token2);
      Pop(var Token2);
      if Token2.Value <= 0 then
        MathError := True
      else if (Token1.Value * math.Log(Token2.Value) < -ExpLimit) or
              (Token1.Value * math.Log(Token2.Value) > ExpLimit) then
        MathError := True
      else
        CurrToken.Value := math.Exp(Token1.Value * math.log(Token2.Value));
    end;
    9 : begin
      Pop(var Token1);
      Pop(var Token2);
      CurrToken.Value := -Token1.Value;
    end;
    //11 : raise Exception('Invalid reduction');
    //13 : raise Exception('Invalid reduction');
    14 : begin
      Pop(var Token1);
      Pop(var CurrToken);
      Pop(var Token1);
    end;
    16 : begin
      Pop(var Token1);
      Pop(var CurrToken);
      Pop(var Token1);
      Pop(var Token1);

      if Token1.FuncName = 'ABS' then
        CurrToken.Value := math.Abs(CurrToken.Value)
      else if Token1.FuncName = 'ATAN' then
        CurrToken.Value := math.Atan(CurrToken.Value)
      else if Token1.FuncName = 'COS' then
      begin
         if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := math.Cos(CurrToken.Value)
      end 
      else if Token1.FuncName = 'EXP' then
      begin
        if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
          MathError := True
        else
          CurrToken.Value := math.Exp(CurrToken.Value);
      end
      else if Token1.FuncName = 'LN' then
      begin
        if CurrToken.Value <= 0 then
          MathError := True
        else
          CurrToken.Value := Math.Log(CurrToken.Value);
      end
      else if Token1.FuncName = 'ROUND' then
      begin
        if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
          MathError := True
        else
          CurrToken.Value := math.Round(CurrToken.Value);
      end
      else if Token1.FuncName = 'SIN' then
      begin
         if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := math.Sin(CurrToken.Value)
      end 
      else if Token1.FuncName = 'SQRT' then
      begin
        if CurrToken.Value < 0 then
          MathError := True
        else
          CurrToken.Value := math.Sqrt(CurrToken.Value);
      end
      else if Token1.FuncName = 'SQR' then
      begin
        if (CurrToken.Value < -1000000) or (CurrToken.Value > 1000000) then
          MathError := True
        else
          CurrToken.Value := (CurrToken.Value*CurrToken.Value);
      end
      else if Token1.FuncName = 'TRUNC' then
      begin
        if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
          MathError := True
        else
          CurrToken.Value := math.Truncate(CurrToken.Value);
      end;
    end;
    3, 6, 8, 10, 12, 15 : Pop(var CurrToken);
  end; { case }
  CurrToken.State := GotoState(Reduction);
  Push(CurrToken);
end; { Reduce }

procedure MathParser.Shift(State : Word);
{ Shifts a Token onto the stack }
begin
  CurrToken.State := State;
  Push(CurrToken);
  TokenType := NextToken;
end; { Shift }

constructor TExtendedWrapper;
begin
end;

end.

メソッドMathParseronGetVarの実装の詳細は次のとおりです。

method YourClass.MathParserGetVar(sender: Object; VarName: String; var Value: Extended; var VarFound: Boolean);
var
  theSig:TSignal;
begin
  theSig := FindSignal(VarName); //My variables are linked to external devices. Yours could simply two dimensional arraylist with variable and its value.
  if theSig <> nil then
  begin
    Value := theSig.AsReal;
    VarFound := true;
  end
  else
  begin
    VarFound := false;
  end;
end;

MathParserクラスの使用方法は次のとおりです。ちなみに、このクラスは複雑な表現を簡単に処理します。

  var  theparser := new Mathparser;
  with theparser do
  begin
    ParseString := '(COS((33*5))*TAN(X))+SQRT(100)';
    Parse;
    if not ParseError then
      Edit2.Text := string.Format('{0}',ParseValue)
    else
      Edit2.Text := '#Error';
  end;

プログラムで動作するようにMathparserを変更する必要があるかもしれませんが、それは非常に簡単です。

delphi - Delphi Prism: 複雑な式を評価するための TMathparser クラスの置き換え?

1 に答える 1

Related

Reference