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

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

我经过思考,自已做了一个表达式求值的函数,与标准算法不同,这是我闭门造车而成的,目的在于求简单。我这个函数有两个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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有  導航