Delphi-一个新算法的表达式求值的函数 ( 积分: 0 )

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-1do
wnto 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=')') 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:=firstJdo
wnto 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 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='+' then
begin
sigh:='+';
result:=i;
exit;
end;
if (s='-') 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='*' then
begin
sigh:='*';
result:=i;
exit;
end;
if s='/' 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=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='-') 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 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 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-1do
wnto 1do
if s[t]='(' then
begin
result:=strtofloat(copy(s,t+1,i-2-t));
exit;
end;
end
else
begin
for t:=i-1do
wnto 1do
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 Ldo
if s[t]=')' then
begin
result:=strtofloat(copy(s,i+2,t-i-2));
exit;
end;
end
else
begin
for t:=i+1 to Ldo
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-1do
wnto 1do
if s[t]='(' then
begin
result:=t;
exit;
end;
end
else
begin
for t:=i-1do
wnto 1do
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 Ldo
if s[t]=')' then
begin
result:=t;
exit;
end;
end
else
begin
for t:=i+1 to Ldo
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=1do
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstmultidiv(s,sigh);
if (i=0) or (s<>sigh) then
exit;
le:=leftsigh(s,i);
j:=leftnum(s,i);
k:=rightnum(s,i);
ri:=rightsigh(s,i);
//if ii<L then
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 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<>'/') 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=1do
begin
s:=nospace(s);
result:=s;
L:=length(s);
i:=firstaddsub(s,sigh);
if (i=0) or (s<>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<>'-') 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=1do
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.

连个缩进都没有，看着真累。

//楼主，高！
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 - 1do
wnto 1do
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 Ldo
begin
if (s = ')') 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 := firstJdo
wnto 1do
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 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 = '+' then
begin
sigh := '+';
result := i;
exit;
end;
if (s = '-') 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 = '*' then
begin
sigh := '*';
result := i;
exit;
end;
if s = '/' 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 = 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 = '-') 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 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 in ['+', '-', '*', '/'] then
begin
result := i;
exit;
end;
result := length(s);
end;

function leftnum(s: string;
i: integer):do
uble;
var
t, L: integer;
begin
L := length(s);
//*************没有使用
if s[i - 1] = ')' then
begin
for t := i - 1do
wnto 1do
if s[t] = '(' then
begin
result := strtofloat(copy(s, t + 1, i - 2 - t));
exit;
end;
end
else
begin
for t := i - 1do
wnto 1do
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):do
uble;
var
t, L: integer;
begin
L := length(s);
if s[i + 1] = '(' then
begin
for t := i + 2 to Ldo
if s[t] = ')' then
begin
result := strtofloat(copy(s, i + 2, t - i - 2));
exit;
end;
end
else
begin
for t := i + 1 to Ldo
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 - 1do
wnto 1do
if s[t] = '(' then
begin
result := t;
exit;
end;
end
else
begin
for t := i - 1do
wnto 1do
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 Ldo
if s[t] = ')' then
begin
result := t;
exit;
end;
end
else
begin
for t := i + 1 to Ldo
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:do
uble;
sigh: char;
begin
while 1 = 1do
begin
s := nospace(s);
result := s;
L := length(s);
i := firstmultidiv(s, sigh);
if (i = 0) or (s <> sigh) then
exit;
le := leftsigh(s, i);
j := leftnum(s, i);
k := rightnum(s, i);
ri := rightsigh(s, i);
//if ii<L then
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 nodiv(s: string): string;
var
i, L, le, ri: integer;
j, k:do
uble;
begin
s := nospace(s);
result := s;
L := length(s);
i := firstsignex(s, '/');
if (i = 0) or (s <> '/') 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:do
uble;
sigh: char;
begin
while 1 = 1do
begin
s := nospace(s);
result := s;
L := length(s);
i := firstaddsub(s, sigh);
if (i = 0) or (s <> 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:do
uble;
begin
s := nospace(s);
result := s;
L := length(s);
i := firstMinussignEX(s);
if (i = 0) or (s <> '-') 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:do
uble;
//*************没有使用
begin
while 1 = 1do
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.

现在什么算法都不是问题，可不可以做语法检查呢，如用户输入 2 / 0- 1 + 1 这样的式子，要查出错误，还要指明错误位置。

老兄你有无试过我的这个函数的正确呢？你到哪里找得到DELPHI的表达式求值函数呢？

为何无人回复？？？

呵呵，精神可嘉
只不过，翻翻以前的帖子，表达式求值的代码已经有了——第三方控件中也有可以算表达
式的。和前人的比较一下吧，如果没有什么创新，就当自己练手了，如果有创新，那不错，
不过还是要参考一下别人的功能——毕竟类似排错以及变量代换这样的功能还是很实用的。

DELPHI的表达式求值函数，网上一大堆。

我在网上找不到，找到的是不能用的，不是这样不顺就是那样不顺，不如自已写个新的

不会吧，网上多如牛毛，能用却不多，这是真的，这样的软件，总的来说就是递归再递归，
没什么其它好搞的

没有，我的新算法没有用到递归！！！！！！！

真不知道，你是怎么实现算术优先以及括号的嵌套优先的。

我源代码已公开了，还有什么不知道的呢？？？
这是完全正确的源代码，不是吹水的。不是流野的。

递归和循环是同一样的东西，区别在于，递归是未知深度的，而循环一般是已知深度的，
当可以预先计算出深度之后，就不需要用递归，改用循环也是可以做到相同效果的，另
外，由于break的使用，循环也可以是未知深度的。

老兄为何说“//************可能返回不明确的值”？？？？？？
没有啊，我返回的都是明确有用的值，何出此言？？？？？？？

是编译器“说的”