Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (*
- Moduł do obliczania wyrażeń matematycznych za pomocą tzw."stacji rozrządowej"
- By Patryk Wychowaniec (patryk432@onet.eu)
- Wersja 0.4
- *)
- Unit ExpressionUnit;
- Interface
- Uses Classes, Dialogs, SysUtils, Math, Windows;
- Const ERROR_OK = 0;
- ERROR_TOO_MANY_BRACKETS = 1;
- ERROR_TOO_FEW_BRACKETS = 2;
- ERROR_INVALID_FUNCTION = 3;
- ERROR_INVALID_FUNC_PARAM = 4;
- ERROR_WRONG_OPERATORS = 5;
- Type TParam = Array of Extended;
- Type TExecute = Function (Param: TParam): Extended;
- Type TFunction = Record
- Name : String;
- Param : Integer;
- Execute: TExecute;
- End;
- Type TExpressionParser = Class
- Private
- List : TStringList;
- Functions: Array of TFunction;
- Function ParseFunction(Num: Integer): Extended;
- Function PopInt: Extended;
- Function PeekInt: Extended;
- Procedure PushInt(Int: Extended);
- Function PopStr: String;
- Function PeekStr: String;
- Procedure PushStr(Str: String);
- Procedure ClearError;
- Procedure SetError(Code, Info: Integer; Str: String);
- Function GetFunctionNum(Str: String): Integer;
- Function isFunction(Str: String): Boolean;
- Public
- ErrorCode, ErrorInfo: Integer;
- ErrorString : String;
- RPN : String;
- Constructor Create;
- Function ExprToRPN(Expr: String): String;
- Function EvalRPN: Extended;
- Function EvalExpr(Expr: String): Extended;
- Procedure AddFunction(Name: String; Param: Integer; Execute: TExecute);
- End;
- Implementation
- Const Numbers = ['0'..'9', '.'];
- Operations = ['+', '-', '*', '/', '%', '^', '>', '<'];
- OperStr = '+-*/%^';
- NumbStr = '0123456789';
- Accepted = ['a'..'z','A'..'Z'];
- (* ====== Domyślne dostępne funkcje ====== *)
- Function f_SQRT(Param: TParam): Extended;
- Begin
- Result := sqrt(Param[0]);
- End;
- Function f_SIN(Param: TParam): Extended;
- Begin
- Result := sin(Param[0]);
- End;
- Function f_COS(Param: TParam): Extended;
- Begin
- Result := cos(Param[0]);
- End;
- Function f_TAN(Param: TParam): Extended;
- Begin
- Result := tan(Param[0]);
- End;
- Function f_ASIN(Param: TParam): Extended;
- Begin
- Result := arcsin(Param[0]);
- End;
- Function f_ACOS(Param: TParam): Extended;
- Begin
- Result := arccos(Param[0]);
- End;
- Function f_ATAN(Param: TParam): Extended;
- Begin
- Result := arctan(Param[0]);
- End;
- Function f_MIN(Param: TParam): Extended;
- Begin
- Result := min(Param[0], Param[1]);
- End;
- Function f_MAX(Param: TParam): Extended;
- Begin
- Result := max(Param[0], Param[1]);
- End;
- Function f_NWW(Param: TParam): Extended;
- Function NWW(A, B: Integer): Integer;
- Var Dz: Integer;
- Begin
- Dz := 1;
- While (Dz*A mod B <> 0) Do
- Inc(Dz);
- Result := Dz*A;
- End;
- Begin
- Result := NWW(round(Param[0]), round(Param[1]));
- End;
- Function f_NWD(Param: TParam): Extended;
- Function NWD(A, B: Integer): Integer;
- Var Param: TParam;
- Begin
- SetLength(Param, 2);
- Param[0] := A;
- Param[1] := B;
- Result := (A*B) div round(f_NWW(Param));
- End;
- Begin
- Result := NWD(round(Param[0]), round(Param[1]));
- End;
- Function f_SQR(Param: TParam): Extended;
- Begin
- Result := sqr(Param[0]);
- End;
- Function f_ROUND(Param: TParam): Extended;
- Begin
- Result := round(Param[0]);
- End;
- Function f_PI(Param: TParam): Extended;
- Begin
- Result := PI;
- End;
- Function f_ABS(Param: TParam): Extended;
- Begin
- Result := abs(Param[0]);
- End;
- (* ====== Do parsera ====== *)
- Function GetOrder(E: String): Integer;
- Const Order: Array[0..2] of Array[0..1] of Char =
- (
- ('+', '-'),
- ('*', '/'),
- ('^', '^')
- );
- Var I, Q: Integer;
- Begin
- Result := -1;
- For I := Low(Order) To High(Order) Do
- For Q := Low(Order[I]) To High(Order[I]) Do
- if (Order[I][Q] = E) Then
- Begin
- Result := I;
- Exit;
- End;
- End;
- Function isNumber(Str: String): Boolean;
- Const Numbers = ['0'..'9', '.'];
- Var I: Integer;
- Begin
- Result := False;
- if (Length(Str) = 0) Then
- Exit;
- Result := True;
- For I := 1 To Length(Str) Do
- if not (Str[I] in Numbers) Then
- Result := False;
- End;
- (* ===== PARSER ===== *)
- Constructor TExpressionParser.Create;
- Begin
- List := TStringList.Create;
- //sin,cos,tan,asin,acos,atan,min,max,nww,nwd,sqr,round,pi,abs
- AddFunction('sqrt' , 1, @f_SQRT);
- AddFunction('sin' , 1, @f_SIN);
- AddFunction('cos' , 1, @f_COS);
- AddFunction('asin' , 1, @f_ASIN);
- AddFunction('acos' , 1, @f_ACOS);
- AddFunction('atan' , 1, @f_ATAN);
- AddFunction('min' , 2, @f_MIN);
- AddFunction('max' , 2, @f_MAX);
- AddFunction('nww' , 2, @f_NWW);
- AddFunction('nwd' , 2, @f_NWD);
- AddFunction('sqr' , 1, @f_SQR);
- AddFunction('round', 1, @f_ROUND);
- AddFunction('pi' , 0, @f_PI);
- AddFunction('abs' , 1, @f_ABS);
- End;
- Function TExpressionParser.GetFunctionNum(Str: String): Integer;
- Var I: Integer;
- Begin
- Result := -1;
- Str := LowerCase(Str);
- For I := Low(Functions) To High(Functions) Do
- if (Functions[I].Name = Str) Then
- Begin
- Result := I;
- Exit;
- End;
- End;
- Function TExpressionParser.isFunction(Str: String): Boolean;
- Begin
- Result := GetFunctionNum(Str) <> -1;
- End;
- Function TExpressionParser.PopInt: Extended;
- Begin
- Result := 0;
- if (List.Count = 0) Then
- Exit;
- Result := PeekInt;
- List.Delete(List.Count-1);
- End;
- Function TExpressionParser.PeekInt: Extended;
- Begin
- Result := 0;
- if (List.Count = 0) Then
- Exit;
- Result := StrToFloat(List[List.Count-1]);
- End;
- Function TExpressionParser.PopStr: String;
- Begin
- if (List.Count = 0) Then
- Exit;
- Result := PeekStr;
- List.Delete(List.Count-1);
- End;
- Function TExpressionParser.PeekStr: String;
- Begin
- Result := '';
- if (List.Count = 0) Then
- Exit;
- Result := List[List.Count-1];
- End;
- Procedure TExpressionParser.PushInt(Int: Extended);
- Begin
- List.Add(FloatToStr(Int));
- End;
- Procedure TExpressionParser.PushStr(Str: String);
- Begin
- List.Add(Str);
- End;
- Function TExpressionParser.ParseFunction(Num: Integer): Extended;
- Var Param: TParam;
- I : Integer;
- Begin
- Result := 0;
- if (Num = -1) Then
- Exit;
- SetLength(Param, Functions[Num].Param);
- For I := 0 To Functions[Num].Param-1 Do
- Begin
- if (List.Count = 0) Then
- Begin
- SetError(ERROR_INVALID_FUNC_PARAM, Functions[Num].Param, Functions[Num].Name);
- Exit;
- End;
- Param[I] := PopInt;
- End;
- Result := Functions[Num].Execute(Param);
- End;
- Function TExpressionParser.ExprToRPN(Expr: String): String;
- Var Pos, I : Integer;
- Ex : Char;
- Str : String;
- Tmp : String;
- Func : String;
- Step : String;
- Bracket: Integer;
- Function ReadNumber: Extended;
- Var Num: String;
- Begin
- Num := '';
- While (Expr[Pos] in Numbers) Do
- Begin
- Num := Num+Expr[Pos];
- Inc(Pos);
- End;
- Result := StrToFloat(Num);
- End;
- Begin
- ClearError;
- DecimalSeparator := '.';
- ErrorCode := 0;
- List.Clear;
- Expr := Trim(Expr);
- if (Expr = '') Then
- Expr := '0';
- if (Expr[1] = '-') Then
- Insert('0', Expr, 1);
- Expr := StringReplace(Expr, '(-', '(0-', [rfReplaceAll]);
- For I := 1 To Length(NumbStr) Do
- Expr := StringReplace(Expr, NumbStr[I]+'(', NumbStr[I]+'*(', [rfReplaceAll]);
- For I := 1 To Length(OperStr) Do
- Expr := StringReplace(Expr, OperStr[I]+'*', OperStr[I], [rfReplaceAll]);
- if (Expr[1] = '*') Then
- Delete(Expr, 1, 1);
- Result := '';
- Pos := 1;
- Step := Expr;
- Bracket := 0;
- Func := '';
- Tmp := '';
- While (true) Do
- Begin
- if (Expr[Pos] in Numbers) Then
- Result := Result+FloatToStr(ReadNumber)+' ';
- if (Expr[Pos] in Operations) Then
- Begin
- if (Expr[Pos-1] in Operations) Then
- Begin
- SetError(ERROR_WRONG_OPERATORS, Pos, Expr[Pos-2]+Expr[Pos-1]+Expr[Pos]+Expr[Pos+1]);
- Exit;
- End;
- Ex := Expr[Pos];
- if (PeekStr <> #0) Then
- if (GetOrder(Ex) <= GetOrder(PeekStr)) Then
- Repeat
- Str := PeekStr;
- if (GetOrder(Ex) <= GetOrder(Str)) Then
- Begin
- Str := PopStr;
- Result := Result+Str+' ';
- End;
- Until (List.Count = 0) or (GetOrder(Str) < GetOrder(Ex));
- PushStr(Ex);
- End;
- if (Expr[Pos] in Accepted) Then
- Func := Func+Expr[Pos];
- if (Expr[Pos] = '(') Then
- Begin
- if (Func <> '') Then
- Begin
- PushStr(Func);
- Func := '';
- End;
- PushStr('(');
- Inc(Bracket);
- End;
- if (Expr[Pos] = ')') Then
- Begin
- if (Bracket > 0) Then
- Begin
- Repeat
- Str := PopStr;
- if (Str <> '(') Then
- Result := Result+Str+' ';
- Until (List.Count = 0) or (Str = '(');
- if (isFunction(PeekStr)) Then
- Begin
- Tmp := '';
- Result := Result+PopStr+' ';
- End;
- End;
- Dec(Bracket);
- End;
- if (Pos >= Length(Expr)) Then
- Break;
- Inc(Pos);
- End;
- ErrorInfo := abs(Bracket);
- if (Bracket > 0) Then
- ErrorCode := ERROR_TOO_MANY_BRACKETS;
- if (Bracket < 0) Then
- ErrorCode := ERROR_TOO_FEW_BRACKETS;
- if (ErrorCode <> 0) Then
- Exit;
- Repeat
- Result := Result+PopStr+' ';
- Until (List.Count = 0);
- RPN := Result;
- End;
- Function TExpressionParser.EvalRPN: Extended;
- Var Pos : Integer;
- Ex : Char;
- Tmp : String;
- Func : String;
- FuncNum: Integer;
- A, B : Extended;
- Begin
- ClearError;
- RPN := Trim(RPN)+' ';
- DecimalSeparator := '.';
- Result := 0;
- if (RPN = '') Then
- Exit;
- List.Clear;
- Pos := 1;
- Tmp := '';
- Func := '';
- While (true) Do
- Begin
- Ex := RPN[Pos];
- if (Ex in Numbers) Then
- Begin
- Tmp := Tmp+Ex;
- End Else
- if (Ex in Accepted) Then
- Begin
- Func := Func+Ex;
- End Else
- Begin
- if (isNumber(Tmp)) Then
- PushInt(StrToFloat(Tmp));
- FuncNum := -1;
- if (Func <> '') Then
- if (not isFunction(Func)) Then
- Begin
- SetError(ERROR_INVALID_FUNCTION, 0, Func);
- Exit;
- End Else
- FuncNum := GetFunctionNum(Func);
- if (Ex in Operations) Then
- Begin
- B := PopInt;
- A := PopInt;
- Case Ex Of
- '+': PushInt(A+B);
- '-': PushInt(A-B);
- '*': PushInt(A*B);
- '/': PushInt(A/B);
- '%': PushInt(A-B*Floor(A/B));
- '^': PushInt(Power(A, B));
- End;
- End Else
- if (FuncNum > -1) Then
- Begin
- PushInt(ParseFunction(FuncNum));
- if (ErrorCode <> 0) Then
- Begin
- ErrorString := Functions[FuncNum].Name;
- Exit;
- End;
- End;
- Tmp := '';
- Func := '';
- End;
- Inc(Pos);
- if (Pos > Length(RPN)) Then
- Break;
- End;
- Result := PopInt;
- End;
- Function TExpressionParser.EvalExpr(Expr: String): Extended;
- Var RPNTemp: String;
- Begin
- RPNTemp := RPN;
- RPN := ExprToRPN(Expr);
- Result := EvalRPN;
- RPN := RPNTemp;
- End;
- Procedure TExpressionParser.ClearError;
- Begin
- SetError(ERROR_OK, 0, '');
- End;
- Procedure TExpressionParser.SetError(Code, Info: Integer; Str: String);
- Begin
- ErrorCode := Code;
- ErrorInfo := Info;
- ErrorString := Str;
- End;
- Procedure TExpressionParser.AddFunction(Name: String; Param: Integer; Execute: TExecute);
- Var I: Integer;
- Begin
- SetLength(Functions, High(Functions)+2);
- I := High(Functions);
- Functions[I].Name := LowerCase(Name);
- Functions[I].Param := Param;
- Functions[I].Execute := Execute;
- End;
- End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement