码迷,mamicode.com
首页 > 其他好文 > 详细

一个简易的四则运算单元...

时间:2015-10-30 18:40:50      阅读:234      评论:0      收藏:0      [点我收藏+]

标签:

网上找的, 没有作者信息, 只能在这里感谢一下了, 支持标准写法的四则运算

 

unit Base.Calculate;

interface

uses
  System.SysUtils, System.Classes, System.Contnrs, System.Generics.Collections;

type
  TTokenType = (tkNumber, tkAdd, tkSub, tkMul, tkDiv, tkLBracket, tkRBracket);

  TToken = record
    Token: TTokenType;
    DValue: Double;
  end;
  PToken = ^TToken;

/// <summary>
///   解析表达式
/// </summary>
/// <param name="AInExpr">
///   表达式字符串
/// </param>
/// <param name="AInList">
///   解析列表输出
/// </param>
/// <returns>
///   返回值为解析错误的字符串位置(从1开始) 如果返回值为0表示表达式正确
/// </returns>
function ParseExpression(AInExpr: String; AInList: TList<TToken>): Integer;
/// <summary>
///   展开输出值为计算顺序描述字符
/// </summary>
/// <param name="AInList">
///   ParseExpression的输出列表
/// </param>
/// <returns>
///   计算顺序描述字符
/// </returns>
function InsideToSuffix(AInList: TList<TToken>): String;
/// <summary>
///   获得计算结果
/// </summary>
/// <param name="ASuExpr">
///   计算顺序描述字符
/// </param>
/// <returns>
///   计算结果
/// </returns>
function Evaluate(ASuExpr: String): Double;

(*
Demo:

var
  nList: TList<TToken>;
  nErrIndex: Integer;
begin
  nErrIndex := ParseExpression(edtInput.Text, nList);
  if nErrIndex = 0 then
    edtOutput.Test := FloatToStr(Evaluate(InsideToSuffix(nList)))
  else
  begin
    edtInput.SetFocus;
    edtInput.SelStart := nErrIndex - 1;
    edtInput.SelLength := 1;
  end;
end;
*)

implementation

(*
procedure Push(AStack: TStack; AData: String);
function Pop(AStack: TStack): String;
function Peek(AStack: TStack): String;
function IsEmpty(AStack: TStack): Boolean;
function CompareSymbol(SymA, SymB: String): Boolean;
*)

procedure Push(AStack: TStack; AData: String);
begin
  AStack.Push(StrNew(PChar(AData)));
end;

function Pop(AStack: TStack): String;
begin
  Result := StrPas(PChar(AStack.Pop));
end;

function Peek(AStack: TStack): String;
begin
  Result := StrPas(PChar(AStack.Peek));
end;

function IsEmpty(AStack: TStack): Boolean;
begin
  Result := AStack.Count = 0;
end;

function CompareSymbol(SymA, SymB: String): Boolean;
begin
  Result := True;
  Case SymA[1] of
    *, /:
      if SymB[1] in [*, /] then
        Result := False;
  end;
end;

function ParseExpression(AInExpr: String; AInList: TList<TToken>): Integer;

  procedure _ListAdd(const AToken: TToken);
  begin
    if AInList <> nil then
      AInList.Add(AToken);
  end;

  procedure _ListClear;
  begin
    if AInList <> nil then
      AInList.Clear;
  end;

var
  nToken: TToken;
  nTemp: String;
  nIsExists: Boolean;
  i, nLen, nBracket: Integer;
  nNextToken: set of TTokenType;
begin
  i := 1;
  Result := 0;
  nBracket := 0;
  nLen := Length(AInExpr);
  nNextToken := [tkNumber, tkLBracket];
  While i <= nLen do
  begin
    Case AInExpr[i] of
      0..9:
      begin
        nTemp := ‘‘;
        nIsExists := False;
        if not (tkNumber in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        While i <= nLen do
        begin
          Case AInExpr[i] of
            0..9:
              nTemp := nTemp + AInExpr[i];
            .:
              if nIsExists then
              begin
                Result := i;
                i := nLen;
                _ListClear;
                Break;
              end
              else
              begin
                nTemp := nTemp + AInExpr[i];
                nIsExists := True;
              end;
          else
            Dec(i);
            Break;
          end;
          Inc(i);
        end;
        if nTemp[Length(nTemp)] = . then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        nToken.Token := tkNumber;
        nToken.DValue := StrToFloat(nTemp);
        _ListAdd(nToken);
        nNextToken := [tkAdd, tkSub, tkMul, tkDiv, tkRBracket];
      end;
      +:
      begin
        if not (tkAdd in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        nToken.Token := tkAdd;
        _ListAdd(nToken);
        nNextToken := [tkNumber, tkLBracket];
      end;
      -:
      begin
        if not (tkSub in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        nToken.Token := tkSub;
        _ListAdd(nToken);
        nNextToken := [tkNumber, tkLBracket];
      end;
      *:
      begin
        if not (tkMul in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        nToken.Token := tkMul;
        _ListAdd(nToken);
        nNextToken := [tkNumber, tkLBracket];
      end;
      /:
      begin
        if not (tkDiv in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        nToken.Token := tkDiv;
        _ListAdd(nToken);
        nNextToken := [tkNumber, tkLBracket];
      end;
      (:
      begin
        if not (tkLBracket in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        Inc(nBracket);
        nToken.Token := tkLBracket;
        _ListAdd(nToken);
        nNextToken := [tkNumber, tkLBracket];
      end;
      ):
      begin
        if not (tkRBracket in nNextToken) then
        begin
          Result := i;
          _ListClear;
          Break;
        end;
        Dec(nBracket);
        nToken.Token := tkRBracket;
        _ListAdd(nToken);
        nNextToken := [tkAdd, tkSub, tkMul, tkDiv, tkRBracket];
      end;
       :;
    else
      Result := i;
      _ListClear;
      Break;
    end;
    Inc(i);
  end;
  if nBracket > 0 then
  begin
    Result := nLen;
    _ListClear;
  end;
end;

function InsideToSuffix(AInList: TList<TToken>): String;
var
  i: Integer;
  nStack: TStack;
  nToken: TToken;
  nTemp, nSymbol: String;
begin
  nTemp := ‘‘;
  nStack := TStack.Create;
  for i := 0 to AInList.Count - 1 do
  begin
    nToken := AInList.Items[i];
    Case nToken.Token of
      tkNumber:
        nTemp := nTemp + FloatToStr(nToken.DValue) +  ;
      tkAdd:
        if not IsEmpty(nStack) then
          if Peek(nStack) = ( then
            Push(nStack, +)
          else
          begin
            nSymbol := Pop(nStack);
            nTemp := nTemp + nSymbol +  ;
            Push(nStack, +);
          end
        else
          Push(nStack, +);
      tkSub:
        if not IsEmpty(nStack) then
          if Peek(nStack) = ( then
            Push(nStack, -)
          else
          begin
            nSymbol := Pop(nStack);
            nTemp := nTemp + nSymbol +  ;
            Push(nStack, -);
          end
        else
          Push(nStack, -);
      tkMul:
        if not IsEmpty(nStack) then
        begin
          nSymbol := Peek(nStack);
          if nSymbol = ( then
            Push(nStack, *)
          else if CompareSymbol(*, nSymbol) then
            Push(nStack, *)
          else
          begin
            nSymbol := Pop(nStack);
            nTemp := nTemp + nSymbol +  ;
            Push(nStack, *);
          end;
        end
        else
          Push(nStack, *);
      tkDiv:
        if not IsEmpty(nStack) then
        begin
          nSymbol := Peek(nStack);
          if nSymbol = ( then
            Push(nStack, /)
          else if CompareSymbol(/, nSymbol) then
            Push(nStack, /)
          else
          begin
            nSymbol := Pop(nStack);
            nTemp := nTemp + nSymbol +  ;
            Push(nStack, /);
          end;
        end
        else
          Push(nStack, /);
      tkLBracket:
        Push(nStack, ();
      tkRBracket:
        while nStack.Count > 0 do
        begin
          nSymbol := Pop(nStack);
          if nSymbol = ( then
            Break;
          nTemp := nTemp + nSymbol +  ;
        end;
    end;
  end;
  for i := 1 to nStack.Count do
  begin
    nSymbol := Pop(nStack);
    nTemp := nTemp + nSymbol +  ;
  end;
  nStack.Free;
  Result := Trim(nTemp);
end;

function Evaluate(ASuExpr: String): Double;
var
  nTemp: String;
  nStack: TStack;
  i, nLen: Integer;
  nTempA, nTempB, nResult: Double;
begin
  i := 1;
  nLen := Length(ASuExpr);
  nStack := TStack.Create;
  While i <= nLen do
  begin
    Case ASuExpr[i] of
      0..9:
      begin
        nTemp := ‘‘;
        While i <= nLen do
        begin
          if ASuExpr[i] in [0..9, .] then
            nTemp := nTemp + ASuExpr[i]
          else
          begin
            Dec(i);
            Break;
          end;
          Inc(i);
        end;
        Push(nStack, nTemp);
      end;
      +:
      begin
        nTempA := StrToFloat(Pop(nStack));
        nTempB := StrToFloat(Pop(nStack));
        nResult := nTempB + nTempA;
        Push(nStack, FloatToStr(nResult));
      end;
      -:
      begin
        nTempA := StrToFloat(Pop(nStack));
        nTempB := StrToFloat(Pop(nStack));
        nResult := nTempB - nTempA;
        Push(nStack, FloatToStr(nResult));
      end;
      *:
      begin
        nTempA := StrToFloat(Pop(nStack));
        nTempB := StrToFloat(Pop(nStack));
        nResult := nTempB * nTempA;
        Push(nStack, FloatToStr(nResult));
      end;
      /:
      begin
        nTempA := StrToFloat(Pop(nStack));
        nTempB := StrToFloat(Pop(nStack));
        nResult := nTempB / nTempA;
        Push(nStack, FloatToStr(nResult));
      end;
    end;
    Inc(i);
  end;
  Result := StrToFloat(Pop(nStack));
end;

end.

 

一个简易的四则运算单元...

标签:

原文地址:http://www.cnblogs.com/hs-kill/p/4923697.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!