Delphi-一个新算法的表达式求值的函数 |
|
e271828
一般會員 ![]() ![]() 發表:9 回覆:8 積分:3 註冊:2007-06-05 發送簡訊給我 |
Delphi-一个新算法的表达式求值的函数
我经过思考,自已做了一个表达式求值的函数,与标准算法不同,这是我闭门造车而成的,目的在于求简单。 一个BUG是小数点0.999999999。。。。。未自动消除为1。时间匆忙,来不及多说,让读者看了再说吧。 另辟溪径也许有利于开拓新思路吧。我这种方法叫逐层去括号法的表达式求值。 更新日期为2007.5.14.我的邮箱是myvbvc@tom.com,QQ:165442523. 程序没有用到递归,只用到循环。 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,StrUtils, Spin; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Button1: TButton; procedure Button1Click(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 firstaddsub(s:string;var sigh:char):integer ; var i:integer; begin result:=0; for i:=1 to length(s) do begin if s[i]=' ' then begin sigh:=' '; result:=i; exit; end; if (s[i]='-') and (s[i-1]<>'(') then begin sigh:='-'; result:=i; exit; end; end; end; function firstmultidiv(s:string;var sigh:char):integer ; var i:integer; begin result:=0; for i:=1 to length(s) do begin if s[i]='*' then begin sigh:='*'; result:=i; exit; end; if s[i]='/' then begin sigh:='/'; result:=i; exit; end; 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 nomultidiv(s:string):string ; var i,L,le,ri:integer; j,k:double ; sigh:char; begin while 1=1 do begin s:=nospace(s); result:=s; L:=length(s); i:=firstmultidiv(s,sigh); if (i=0) or (s[i]<>sigh) then exit; le:=leftsigh(s,i); j:=leftnum(s,i); k:=rightnum(s,i); ri:=rightsigh(s,i); //if ii if sigh='*' then if j*k>=0 then s:=leftstr(s,le-1) floattostr(j*k) rightstr(s,L-ri) else s:=leftstr(s,le-1) '(' floattostr(j*k) ')' rightstr(s,L-ri); if sigh='/' then if j/k>=0 then s:=leftstr(s,le-1) floattostr(j/k) rightstr(s,L-ri) else s:=leftstr(s,le-1) '(' floattostr(j/k) ')' rightstr(s,L-ri); end; result:=s; 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 noaddsub(s:string):string ; var i,L,le,ri:integer; j,k:double ; sigh:char; begin while 1=1 do begin s:=nospace(s); result:=s; L:=length(s); i:=firstaddsub(s,sigh); if (i=0) or (s[i]<>sigh) then exit; le:=leftsigh(s,i); j:=leftnum(s,i); k:=rightnum(s,i); ri:=rightsigh(s,i); if (sigh<>' ') and (sigh<>'-') then break; if sigh=' ' then if j k>=0 then s:=leftstr(s,le-1) floattostr(j k) rightstr(s,L-ri) else s:=leftstr(s,le-1) '(' floattostr(j k) ')' rightstr(s,L-ri); if sigh='-' then if j-k>=0 then s:=leftstr(s,le-1) floattostr(j-k) rightstr(s,L-ri) else s:=leftstr(s,le-1) '(' floattostr(j-k) ')' rightstr(s,L-ri); end; result:=s; 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:=nomultidiv(s); s:=noaddsub(s); result:=s; end; function myexpress(s:string):string; var c,j,L:integer; le,ri,al,substr,s0:string; tryit:double; begin while 1=1 do 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>c then begin substr:=copy(s,c 1,j-c-1); //le:=leftstr(s,c-1); //ri:= rightstr(s,L-j); le:=leftstr(s,c-1); le:=rightstr(le,length(le)); ri:= rightstr(s,L-j); ri:=leftstr(ri,length(ri)); //showmessage(substr); al:=alltoone(substr); //showmessage(le al ri); s:=le al ri; end else begin s:=alltoone(s0); break; end; end; result:=s; if (result[1]='(') and (result[length(result)]=')') then result:=copy(result,2,length(result)-2); end; procedure TForm1.Button1Click(Sender: TObject); begin Edit2.Text:=myexpress(edit1.text); end; end. |
e271828
一般會員 ![]() ![]() 發表:9 回覆:8 積分:3 註冊:2007-06-05 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |