Показать сообщение отдельно
  #1  
Старый 08.07.2010, 18:22
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,560
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию Библиотека синтаксического анализатора

Библиотека синтаксического анализатора.
Учитываются скобки, считаются функции sin(), cos(), exp(), a^b, есть константа pi, работает с действительными числами, для написания дробной части можно использовать как "." так и ",".

Код:
unit MyLib;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, Math;

  function IsPoint (s:string):string;
  function IsDigit(Ch:Char):Boolean;
  function IsX(ch:char):boolean;
  function IsSign(Ch:Char):Boolean;
  function IsSeparator(Ch:Char):Boolean;
  function Factor(const S:string;var P:Integer):Extended;
  function IsExponent(Ch:Char):Boolean;
  function Number(const S:string;var P:Integer):Extended;
  function Base(const S:string;var P:Integer):Extended;
  function IsOperator(Ch:Char):Boolean;
  function IsOperator1(Ch:Char):Boolean;
  function IsOperator2(Ch:Char):Boolean;
  function Calculate(const S:string):Extended;
  function LatsCalculate (const x1,y1:real; s:string; var b:boolean):Extended;


type ESyntaxError=class(Exception);

var x,y:real;
    division:boolean;

implementation

// Проверка символа на соответствие
function IsDigit(Ch:Char):Boolean;
 begin
  Result:=(Ch in ['0'..'9']) or (ch='x');
 end;

function IsX(ch:char):boolean;
begin
 result:= (upcase(ch)='X');
end;

Function IsY (ch:char):boolean;
begin
 result:= upcase (ch)='Y';
end;
// Проверка символа на соответствие
function IsSign(Ch:Char):Boolean;
 begin
  Result:=(Ch='+') or (Ch='-')
 end;

// Проверка символа на соответствие
function IsSeparator(Ch:Char):Boolean;
 begin
  Result:=Ch=',';
 end;

function IsPoint (s:string):string;
var i:integer;
begin
 for i:=1 to length(s) do
  if s[i]='.' then s[i]:=',';
  Result:=s;
end;



// Проверка символа на соответствие
function IsExponent(Ch:Char):Boolean;
 begin
  Result:=(Ch='E') or (Ch='e')
 end;


   function Number(const S:string;var P:Integer):Extended;
 var InitPos:Integer;
  begin
   // InitPos нам понадобиться для выделения подстроки,
   // которая будет передана в StrToFloat
   InitPos:=P;
   if (P<=Length(S)) and IsSign(S[P]) then
   Inc(P);
   if (not IsX(s[p]) )and not IsY(s[p]) then begin

   // После символа может быть переменная
   if (P>Length(S)) or not IsDigit(S[P]) then
    raise ESyntaxError.Create('Ожидается цифра в позиции '+IntToStr(P));
   repeat
    Inc(P)
   until (P>Length(S)) or not IsDigit(S[P]);
   if (P<=Length(S)) and IsSeparator(S[P]) then
    begin
     Inc(P);
     if (P>Length(S)) or not IsDigit(S[P]) then
      raise ESyntaxError.Create('Ожидается цифра в позиции '+IntToStr(P));
     repeat
      Inc(P)
     until (P>Length(S)) or not IsDigit(S[P]);
    end;
   if (P<=Length(S)) and IsExponent(S[P]) then
    begin
     Inc(P);
     if P>Length(S) then
      raise ESyntaxError.Create('Неожиданный конец строки');
     if IsSign(S[P]) then
      Inc(P);
     if (P>Length(S)) or not IsDigit(S[P]) then
      raise ESyntaxError.Create('Ожидается цифра в позиции '+IntToStr(P));
     repeat
      Inc(P)
     until (P>Length(S)) or not IsDigit(S[P]);
    end;
   Result:=StrToFloat(Copy(S,InitPos,P-InitPos)) end
  else if IsX (s[p]) then begin Result:=x; inc(p); end
  else if IsY (s[p]) then begin result:=y; inc(p);   end
  else raise ESyntaxError.Create('Некорректный символ в позиции '+IntToStr(P));
  end;

// Проверка символа на соответствие
function IsOperator(Ch:Char):Boolean;
 begin
  Result:=Ch in ['+','-','*','/']
 end;

// Проверка строки на соответствие
// и вычисление выражения
 // Проверка символа на соответствие
function IsOperator1(Ch:Char):Boolean;
 begin
  Result:=Ch in ['+','-']
 end;

// Проверка символа на соответствие
function IsOperator2(Ch:Char):Boolean;
 begin
  Result:=Ch in ['*','/']
 end;

 function Expr(const S:string;var P:Integer):Extended;
 forward;


function Term(const S:string;var P:Integer):real;
 var OpSymb:Char;
 res:real;
  begin
   division:=false;
   Result:=Factor(S,P);
   while (P<=Length(S)) and IsOperator2(S[P]) do
    begin
     OpSymb:=S[P];
     Inc(P);
     res:=Factor(S,P);
     if opsymb='*' then Result:=Result*res;
     if (opsymb='/') and (res<>0) then Result:=Result/res
     else if (opsymb='/') and (res=0) then begin  result:=1000; division:=true;  end;
    end
  end;

// Выделение подстроки, соответствующей ,
// и её вычисление
function Expr(const S:string;var P:Integer):Extended;
 var OpSymb:Char;
  begin
   Result:=Term(S,P);
   while (P<=Length(S)) and IsOperator1(S[P]) do
    begin
     OpSymb:=S[P];
     Inc(P);
     case OpSymb of
      '+':Result:=Result+Term(S,P);
      '-':Result:=Result-Term(S,P)
     end
    end
  end;

// Вычисление выражения


// Вычисление функции, имя которой передаётся через FuncName
function Func(const FuncName,S:string;var P:Integer):Extended;
 var Arg:Extended;
  begin
   // Вычисляем аргумент
   Arg:=Expr(S,P);
   division:=false;
   // Сравниваем имя функции с одним из допустимых
   if AnsiCompareText(FuncName,'sin')=0 then
     Result:=Sin(Arg)
   else if AnsiCompareText(FuncName,'cos')=0 then
    Result:=Cos(Arg)
   else if (AnsiCompareText(FuncName,'ln')=0) and (arg>0) then
    Result:=Ln(Arg)
   else if (AnsiCompareText (FuncName, 'ln')=0) and (arg<=0) then
   begin
   division:=true;
   result:=0; end
   else
    raise ESyntaxError.Create('Неизвестная функция '+FuncName)
  end;

// Выделение из строки идентификатора и определение,
// является ли он переменной или функцией
function Identifier(const S:string;var P:Integer):Extended;
 var InitP:Integer;
     IDStr,VarValue:string;
  begin
   // Запоминаем начало идентификатора
   InitP:=P;
   // Первый символ был проверен ещё в функции Base.
   // Сразу переходим к следующему
   Inc(P);
   while (P<=Length(S)) and (S[P] in ['A'..'Z','a'..'z','_','0'..'9']) do
    Inc(P);
   // Выделяем идентификатор из строки
   IDStr:=Copy(S,InitP,P-InitP);
   // Если за ним стоит открывающая скобка - это функция
   if (P<=Length(S)) and (S[P]='(') then
    begin
     Inc(P);
     Result:=Func(IDStr,S,P);
     // Проверяем, что скобка закрыта
     if (P>Length(S)) or (S[P]<>')') then
      raise ESyntaxError.Create('Ожидается ")" в позиции '+IntToStr(P));
     Inc(P)
    end
   // если скобки нет - переменная
   else
    begin
      if AnsiCompareText(IDStr,'x')=0 then result:=x else
      if AnsiCompareText(IDStr,'y')=0 then result:=y else
      if AnsiCompareText(IDStr,'pi')=0 then result:=pi else
       raise ESyntaxError.Create('Некорректный символ в позиции: '+IntToStr(P));
    end
  end;

// Выделение подстроки, соответствующей ,
// и её вычисление
function Base(const S:string;var P:Integer):Extended;
 begin
  if P>Length(S) then
   raise ESyntaxError.Create('Неожиданный конец строки');
  // По первому символу подстроки определяем,
  // какое это основание
  case S[P] of
   '(': // выражение в скобках
    begin
     Inc(P);
     Result:=Expr(S,P);
     // Проверяем, что скобка закрыта
     if (P>Length(S)) or (S[P]<>')') then
      raise ESyntaxError.Create('Ожидается ")" в позиции '+IntToStr(P));
     Inc(P)
    end;
   '0'..'9': // Числовая константа
    Result:=Number(S,P);
   'A'..'Z','a'..'z','_': // Идентификатор (переменная или функция)
    Result:=Identifier(S,P)
   else
    raise ESyntaxError.Create('Некорректный символ в позиции '+IntToStr(P))
  end
 end;

// Выделение подстроки, соответствующей ,
// и её вычисление
function Factor(const S:string;var P:Integer):Extended;
 begin
  if P>Length(S) then
   raise ESyntaxError.Create('Неожиданный конец строки');
  // По первому символу подстроки определяем,
  // какой это множитель
  case S[P] of
   '+': // унарный "+"
    begin
     Inc(P);
     Result:=Factor(S,P)
    end;
   '-': // унарный "-"
    begin
     Inc(P);
     Result:=-Factor(S,P)
    end
   else
    begin
     Result:=Base(S,P);
     if (P<=Length(S)) and (S[P]='^') then
      begin
       Inc(P);
       Result:=Power(Result,Factor(S,P))
      end
    end
  end
 end;

function Calculate(const S:string):Extended;
 var P:Integer;
  begin
   P:=1;
   Result:=Expr(S,P);
   if P<=Length(S) then
    raise ESyntaxError.Create('Некорректный символ в позиции '+IntToStr(P))
  end;

function LatsCalculate (const x1,y1:real; s:string; var b:boolean):Extended;
begin
b:=false;
x:=x1;
y:=y1;
Result:=Calculate(S);
b:=division;
end;

end.

Автор: Zerony (sanyok.04@mail.ru)
Источник: www.softengines.ru
Вложения
Тип файла: zip MyLib.zip (2.2 Кбайт, 23 просмотров)
Ответить с цитированием