WEB开发网
开发学院软件开发Delphi 一个新算法的表达式求值的函数 阅读

一个新算法的表达式求值的函数

 2006-02-04 13:42:16 来源:WEB开发网   
核心提示: 我经过思考,自已做了一个表达式求值的函数,一个新算法的表达式求值的函数,与标准算法不同,这是我闭门造车而成的,来不及多说,让读者看了再说吧,目的在于求简单,我这个函数有两个BUG
 

我经过思考,自已做了一个表达式求值的函数,与标准算法不同,这是我闭门造车而成的,目的在于求简单。我这个函数有两个BUG,我目前已懒得改,当然是可以改的,一个是小数点0.999999999。。。。。未自动消除为1,二是本来乘法与除法是同级的,我这是成了乘法高级过除法。时间匆忙,来不及多说,让读者看了再说吧。另辟溪径也许有利于开拓新思路吧。我的邮箱是myvbvc@tom.com

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,StrUtils, Spin;

type
  TForm1 = class(TForm)
   Edit1: TEdit;
   Edit2: TEdit;
   Button1: TButton;
   Button2: TButton;
   SpinEdit1: TSpinEdit;
   PRocedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
  private
   { Private declarations }
  public
   { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function  nospace(s:string):string;
begin
result:= stringreplace(s,' ','',[rfReplaceAll]);
end;
function  is123(c:char):boolean;
begin
if  c  in ['0'..'9','.']
then  result:=true
else  result:=false;

end;
function isminus(s:string;i:integer):boolean ;
var
t:integer;
begin

 for t:=i-1 downto 1  do
 begin
  if s[t]=')'  then
  begin
  result:=false;
  break;
  end;
  if (s[t]='(') and (s[t+1]='-') then
  begin
   result:=true;
   break;
  end;
  if (not is123(s[t])) and ( not ((s[t]='-') and(s[t-1]='(')))  then
  begin
  result:=false;
  break;
  end;
 end;
end;

function firstJ(s:string):integer ;
var
i,L:integer;
begin
result:=0;
 L:=length(s);
 for i:=1  to L  do
 begin
  if (s[i]=')')  and (not isminus(s,i))  then
  begin
  result:=i;
  break;
  end;

 end;
end;
function firstC(s:string;firstJ:integer):integer ;
var
t:integer;
begin
 for t:=firstJ downto 1  do
 begin
  if (s[t]='(') and (s[t+1]<>'-') then
  begin
   result:=t;
   break;
  end;

 end;
end;
function firstsign(s:string):integer ;
var
i:integer;
begin
result:=0;
  for  i:=1  to length(s) do
   if  s[i]  in ['+','-','*','/']  then
   begin
   result:=i;
   exit;
   end;
end;
function firstsignEX(s:string;sigh:char):integer ;
var
i:integer;
begin
result:=0;
  for  i:=1  to length(s) do
   if  s[i]=sigh  then
   begin
   result:=i;
   exit;
   end;
end;
function firstMinussignEX(s:string):integer ;
var
i:integer;
begin
result:=0;
  for  i:=1  to length(s) do
   if  (s[i]='-') and (s[i-1]<>'(')  then
   begin
   result:=i;
   exit;
   end;
end;
function secondsign(s:string):integer ;
var
i,j:integer;
begin
  j:=firstsign(s);

  for i:=j+1  to length(s) do
   if  s[i]  in ['+','-','*','/']  then
   begin
   result:=i;
   exit;
   end;
  result:=length(s);
end;
function secondsignEX(s:string;sigh:char):integer ;
var
i,j:integer;
begin
  j:=firstsignex(s,sigh);

  for i:=j+1  to length(s) do
   if  s[i]  in ['+','-','*','/']  then
   begin
   result:=i;
   exit;
   end;
  result:=length(s);
end;
function leftnum(s:string;i:integer):double  ;
var
t,L:integer;
begin
L:=length(s);
if s[i-1]=')'  then
begin
  for t:=i-1 downto 1 do
  if  s[t]='('  then
  begin
  result:=strtofloat(copy(s,t+1,i-2-t));
  exit;
  end;
end
else
begin
  for t:=i-1 downto 1 do
  begin
   if  not is123(s[t])  then
   begin
    result:=strtofloat(copy(s,t+1,i-1-t));
    exit;
   end;
   if  t=1  then  result:=strtofloat(leftstr(s,i-1));
  end;
end;


end;
function rightnum(s:string;i:integer):double  ;
var
t,L:integer;
begin
L:=length(s);
if s[i+1]='('  then
begin
  for t:=i+2 to L do
  if  s[t]=')'  then
  begin
  result:=strtofloat(copy(s,i+2,t-i-2));
  exit;
  end;
end
else
begin
  for t:=i+1 to L do
  begin
   if  not is123(s[t])  then
   begin
    result:=strtofloat(copy(s,i+1,t-i-1));
    exit;
   end;
   if  t=L  then  result:=strtofloat(rightstr(s,L-i));
  end;
end;
end;
/////////////////////////////////
function leftsigh(s:string;i:integer):integer  ;
var
t,L:integer;
begin
L:=length(s);
if s[i-1]=')'  then
begin
  for t:=i-1 downto 1 do
  if  s[t]='('  then
  begin
  result:=t;
  exit;
  end;
end
else
begin
  for t:=i-1 downto 1 do
  begin
   if  not is123(s[t])  then
   begin
    result:=t+1;
    exit;
   end;
   if  t=1  then  result:=1;
  end;
end;


end;
function rightsigh(s:string;i:integer):integer  ;
var
t,L:integer;
begin
L:=length(s);
if s[i+1]='('  then
begin
  for t:=i+2 to L do
  if  s[t]=')'  then
  begin
  result:=t;
  exit;
  end;
end
else
begin
  for t:=i+1 to L do
  begin
   if  not is123(s[t])  then
   begin
    result:=t-1;
    exit;
   end;
   if  t=L  then  result:=L;
  end;
end;
end;
////////////////////////////////////

function nomulti(s:string):string ;
var
i,L,le,ri:integer;
j,k:double ;
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstsignex(s,'*');
if (i=0) or (s[i]<>'*')  then exit;
le:=leftsigh(s,i);
j:=leftnum(s,i);
k:=rightnum(s,i);
ri:=rightsigh(s,i);
file://if ii<L then
if j*k>=0  then
result:=nomulti(leftstr(s,le-1)+floattostr(j*k)+rightstr(s,L-ri))
else
result:=nomulti(leftstr(s,le-1)+'('+floattostr(j*k)+')'+rightstr(s,L-ri))

end;
function nodiv(s:string):string ;
var
i,L,le,ri:integer;
j,k:double ;
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstsignex(s,'/');
if (i=0) or (s[i]<>'/')  then exit;
le:=leftsigh(s,i);
j:=leftnum(s,i);
k:=rightnum(s,i);
ri:=rightsigh(s,i);
if j/k>=0 then
result:=nodiv(leftstr(s,le-1)+floattostr(j/k)+rightstr(s,L-ri))
else
result:=nodiv(leftstr(s,le-1)+'('+floattostr(j/k)+')'+rightstr(s,L-ri))

end;
function noadd(s:string):string ;
var
i,L,le,ri:integer;
j,k:double ;
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstsignex(s,'+');
if (i=0) or (s[i]<>'+')  then exit;
le:=leftsigh(s,i);
j:=leftnum(s,i);
k:=rightnum(s,i);
ri:=rightsigh(s,i);
if j+k>=0 then
result:=noadd(leftstr(s,le-1)+floattostr(j+k)+rightstr(s,L-ri))
else
result:=noadd(leftstr(s,le-1)+'('+floattostr(j+k)+')'+rightstr(s,L-ri))

end;
function nosub(s:string):string ;
var
i,L,le,ri:integer;
j,k:double ;
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstMinussignEX(s);
if (i=0) or (s[i]<>'-')  then exit;
le:=leftsigh(s,i);
j:=leftnum(s,i);
k:=rightnum(s,i);
ri:=rightsigh(s,i);
if j-k>=0 then
result:=nosub(leftstr(s,le-1)+floattostr(j-k)+rightstr(s,L-ri))
else
result:=nosub(leftstr(s,le-1)+'('+floattostr(j-k)+')'+rightstr(s,L-ri))

end;
function alltoone(s:string):string ;
begin
 s:=nomulti(s);
 s:=nodiv(s);
 s:=noadd(s);
 s:=nosub(s);
 result:=s;
end;


function  myexpress(s:string):string;
var
c,j,L:integer;
le,ri,al,substr,s0:string;
tryit:double;
begin
s:=nospace(s);
s0:=s;
L:=length(s);
if (s[1]<>'(') or (s[L]<>')')  then
s:='('+s+')';
if (s[1]='(') and (s[L]=')') and((s[2]='-')  or (isminus(s,L)))  then
s:='('+s+')';
L:=length(s);
j:=firstJ(s);
c:=firstc(s,j);
if (j<L) and (c>1) and (j>c) then
begin
substr:=copy(s,c+1,j-c-1);
file://le:=leftstr(s,c-1);
file://ri:= rightstr(s,L-j);
le:=leftstr(s,c-1);
le:=rightstr(le,length(le)-1);
ri:= rightstr(s,L-j);
ri:=leftstr(ri,length(ri)-1);
file://showmessage(substr);
al:=alltoone(substr);
file://showmessage(le+al+ri);
result:=myexpress(le+al+ri);
end
else
result:=alltoone(s0);

end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text:=myexpress(edit1.text);
end;

end.

Tags:一个 算法 表达式

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接