关于计算(100分)

  • 主题发起人 主题发起人 晴雨
  • 开始时间 开始时间

晴雨

Unregistered / Unconfirmed
GUEST, unregistred user!
有一个字符串:56-6*8+(56+9) 如何将该字符串转化为运算公式
 
具体什么意思?有点糊涂
 
公式解析,如果要对所有式子都适用,好象比较麻烦的。
参考一下这里:
http://www.playicq.com/dispdoc.php?t=&id=1836
http://www.playicq.com/dispdoc.php?t=&id=1310
 
自己解析吧,找到 s in ['0'..'9','.']转为数字, s='+'转为加。。。。类推
 
用栈, 参考数据结构教程
 
采用堆栈
 
如果只是针对这一个字符串,应该很简单啊
procedure TForm1.Button5Click(Sender: TObject);
var
str:string;
s:integer;
begin
str:='56-6*8+(56+9)';
s:=strtoint(str[1])*10+strtoint(str[2])-strtoint(str[4]) * strtoint(str[6])+
((strtoint(str[9])*10+strtoint(str[10])+strtoint(str[12])));
showmessage(inttostr(s));
end;

 
我写了一个例子,是采用堆栈将中缀变成后缀的
unit Unit1;

interface

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

type
QStack=record
Datas:array[0..50] of string;
Top:integer;
end;
PQStack=^QStack;





type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
procedure InitiateQStack(qstype:PQStack);
Function PushQStack(qstype:PQStack;s:string):Boolean;
Function PopQStack(qstype:PQStack):string;
Function GetTopStack(qstype:PQStack):string;
Function NotEmptyStack(qstype:PQStack):Boolean;
Function Postfix(qstype:PQStack;str:string):Boolean;
Function Priority(x1,x2:string):string;


end;

var
Form1: TForm1;
strArray:array[1..100] of string;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.GetTopStack(qstype: PQStack): string;
begin
if qstype.Top<0 then result:=''
else
begin
result:=qstype.datas[qstype.top];
end;
end;

procedure TForm1.InitiateQStack(qstype: PQStack);
begin
qstype.Top:=-1;
end;

function TForm1.NotEmptyStack(qstype: PQStack): Boolean;
begin
if qstype.Top<0 then result:=false
else result:=true;
end;

function TForm1.PopQStack(qstype: PQStack): string;
begin
if qstype.Top<0 then result:=''
else
begin
result:=qstype.datas[qstype.top];
qstype.Top:=qstype.Top-1;
end;
end;

function TForm1.Postfix(qstype: PQStack; str: string): Boolean;
var
x1,x2:string;
j,i:integer;
save:string;

begin
j:=1;
i:=1;
new(qstype);
qstype.Datas[0]:='#';
qstype.Top:=0;
x2:=str[j];
x1:=GetTopStack(qstype);

while ((qstype.Top>-1) and (j<(length(str)+1))) do
begin
if ((x2<>'+') and (x2<>'-') and (x2<>'*') and (x2<>'/') and (x2<>'(') and (x2<>')') and (x2<>'#')) then
begin

save:=save+x2;
inc(j);
x2:=str[j];
// showmessage('<> '+'x1: '+x1+' x2: '+x2+' i: '+inttostr(i)+' '+' strarray: '+strarray+' Save: '+save);
end

else if Priority(x1,x2)='<' then
begin
strArray:=save;
save:='';
inc(i);
PushQStack(qstype,x2);
x1:=GetTopStack(qstype);
inc(j);
x2:=str[j];
// showmessage('< '+'x1: '+x1+' x2: '+x2+' i: '+inttostr(i)+' '+' strarray: '+strarray+' Save: '+save);
end

else if Priority(x1,x2)='>' then
begin

strArray:=save;
save:='';
inc(i);
strArray:=GetTopStack(qstype);
inc(i);
PopQStack(qstype);
x1:=GetTopStack(qstype);
// showmessage('> '+'x1: '+x1+' x2: '+x2+' i: '+inttostr(i)+' '+' strarray: '+strarray+' Save: '+save);
end

else if ((Priority(x1,x2)='=') and (x1='(') and (x2=')')) then
begin
PopQstack(qstype);
x1:=GetTopStack(qstype);
inc(j);
x2:=str[j];
end

else if ((Priority(x1,x2)='=') and (x1='#') and (x2='#')) then
begin
result:=true;
exit;
end

else if Priority(x1,x2)='' then
begin
result:=false;
break;
end;
end;

dispose(qstype);
end;





function TForm1.Priority(x1, x2: string): string;
begin
if (((x1='(') and (x2=')')) or ((x1='#') and (x2='#'))) then result:='='
else if (((x1=')') and (x2='(')) or ((x1='#') and (x2=')'))) then result:=''
else if (((x1='+') or (x1='-') or (x1='*') or (x1='/') or (x1=')')) and ((x2='+') or (x2='-') or (x2=')') or (x2='#'))) then result:='>'
else if ((x1='*') or (x1='/') or (x1=')')) and ((x2='*') or (x2='/')) then result:='>'
else result:='<';
end;


function TForm1.PushQStack(qstype: PQStack; s: string): Boolean;
begin
if (qstype.Top>49) then result:=false
else
begin
inc(qstype.Top);
qstype.Datas[qstype.Top]:=s;
result:=true;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
sl:string;
p:PQStack;
i:integer;
begin
for i:=1 to 100 do
begin
strarray:='';
end;
s:=edit1.Text;
s:=s+'#';
Postfix(p,s);
for i:=1 to 100 do
begin
sl:=sl+strarray;
end;
form1.Caption:=sl;


end;

end.
 
我试过了,好象都不行,还有没有其他办法。
我的程序是:在数据库中设一字段,让用户自己输入公式,如:56-6*8+(56+9),然后
在查询中自动计算该公式的答案。
 
Pascal 的数据结构中都有这种例程,自己去找一下。
 
数据结构的栈这一章中每本书都有着个粒子的
 
开发MIS系统时,报表设计中经常会碰到表达式解释器,完成用户自定义的公式运算。这种程序的设计需要有比较高的技巧,以下介绍一款用DELPHI4.0开发的程序[程序重在算法,语言特性很少,用其它语言的人也能读懂],只要按自已的要求稍加修改,即可做成组件或全局方法发部。它支持 "加[+]、减[-]、乘[*]、除[/]、商[$:两整数相除,结果的整数部分]、模[%]、括号[()]"四则混合运算,支持"与[&]、或[|]、异或[^]、左移[< ]、右移[ >]和非[!]"逻辑运算功能,同时它们可以出现在同一个表达式中,它们的优先级依次为括号、非、与或异或左右移、乘除商模、加减。如式:12.45+3*16 >2*(3+6*(3+2)-1)=12.45+3*4*32,计算结果为:396.45。程序包括两大部分功能:表达式拆解、因子计算,分别由两个类TBdsProc和TPUSHPOP完成。具体如下:

CDIKind=record
case id: Boolean of
True: (dval: Double);
False: (ival: Integer);
end;
CDKind:区别表达式中的整数和浮点数类型,
因为有些运算符不支持浮点数(如逻辑运算)。

ValKind = CDIKind;
TBdsProc = class
private
Fghpd : Integer;//识别并标记左右括号是否成对出现
function IsCalcFh(c: Char): boolean;
//判别一个字符是否运算符
function CopyRight(abds: String;start: Integer):
String;//截取字符串表达式
function BdsSs(var abds: String): ValKind;
//返回一个子表达式的值
function BdsYz(var abds: String): ValKind;
//表达式因子,如:15、(13+5)
function BdsItm(var abds: String): ValKind;
//读取表达式中的一个因子
public
function CalcValue(const bds: String): ValKind;
//返回计算结果
end;

TPUSHPOP = class
private
ffh: array [0..2] of Char;//符号数组
value: array [0..3] of CDIKind;//值数组
flevel: Byte;//因子个数
fisfh: Boolean;//识别等待输入值或运算符
fisnot: Boolean;//识别待计算数据项是否执行非运算
function Calcsj(av1,av2: CDIKind;fh: Char): CDIKind;
//执行两个数值的四则运算
function Calclg(av1,av2: CDIKind; fh: Char): CDIKind;
//执行两个数的逻辑运算
procedure Calccur;{当输入数据项满足四个数后
[依运算优先级层数求得,见下述算式解析原理]执行中间运算}
function IsLgFh(fh: Char): Boolean;
//一个符号是否逻辑运算符
function IsCcFH(fh: Char): Boolean;
// 一个符号乘除商模运算符
public
constructor Create;
procedure PushValue(avalue: CDIKind);//存入一个数据项
procedure PushFh(afh: Char);//存入一个符号
function CalcValue: CDIKind;//计算并返回值
end;

---- 表达式解析基本原理:

---- 1.表达式处理:

---- 表达式的一个个数据项组成,中间由运算符连接,每个数据项为一个分析基本分析单元。表达式中如果包含有改变运算优先级别的括号运算,先计出括号中式子的值,再把该值当一个数据项处理,这一点在程序设计中只要运用递归功就能实现。

---- 2.数据项计算处理

---- a >非运算:

---- 它为单目运算符,级别最高,在存入符号时做标记,存入数据时即时计算并去除标记。

---- b >表达式运算:

---- 设f1、f2、f3分别表示一二三级运算符,V1、V2、V3、V4分别表示顺序四个数,则极端表达式模型为R=V1 f1 V2 f2 V3 f3 V4 …,计算时顺序应为 R=…V4 f3 V3 f2 V2 f1 V1。为了简化运算,把其中运算级别最高的逻辑运算在存入数据时先计算完成, 初始化时设V1=0,第一个运算符设为'+'。则公式化为: R=…V4 f2(f1) V3 f2(f1) V2 f1 V1。这样,当V2与V3间的运算符级别为f2时,V4与V3间的运算符级别< =f2,则:V2 =(V2与V3计算值),V3后的值和运算符前移;若V2与V3间的运算级别为f1,可先算V1与V2,V2以后的值和运算符前移。则计算后的表达式为:R=V3 f2(f2) V2 f1 V1刚好满足循环取数条件。

---- 3.实现:

---- 程序比较长(TBdsProc和TPUSHPOP的源代码合计长度为400多行),完整代码见附件,以下对一些重要实现方法做介绍:

---- < 1 >表达式拆解:由方法BdsSs和BdsYz完成表达式拆解和因子处理

function TBdsProc.BdsSs(var abds: String): ValKind;
var
c: Char;
lpp: TPushPop;
begin
lpp := TPushPop.Create;//建立数据计算对象
while abds< >'' do
begin
c := abds[1];
if IsCalcFh(c) then//是否运算符
begin
lpp.PushFh(c);//保存运算符
abds := CopyRight(abds,2);
end
else
begin
if c=')' then
begin
Dec(Fghpd);//括号匹配
abds := CopyRight(abds,2);
if Fghpd < 0 then
Raise Exception.Create('括号不配对');
Result := lpp.CalcValue;
//返回括号中的子项值,进行下一步计算
lpp.Free;
Exit;
end
else
begin
if c='(' then
Inc(Fghpd);//做括号层数标识
lpp.PushValue(BdsYz(abds));//取下一项的值。
end;
end;
end;
if Fghpd< >0 then
Raise Exception.Create('括号不配对');
Result := lpp.CalcValue;//返回最终运算值
lpp.Free;
end;

function TBdsProc.BdsYZ(var abds: String): ValKind;
begin
if abds< >'' then
begin
if abds[1]='(' then
begin
abds := CopyRight(abds,2);
Result := BdsSs(abds);//递归调用,求括号中的值
end
else
Result := BdsItm(abds);{读一个数据项,
如果包括函数定义,可以在该方法中定义接口或连接}
end;
end;
若表达式要支持函数功能,只要定义系统支持的函数,
在取行表达式因子BdsItm中加入连接函数定义即可,如下:
…..
else if (c< ='Z') and (c >='A') then
begin
bhs := 取出函数名及参数
Result := … //调用函数处理 (函数定义)
abds := 下一项
end
….
< 2 > 数据计算:主要包PushValue,PushFh,
Calccur分别完成存入数、符号、中间计算
procedure TPUSHPOP.PushValue(avalue: CDIKind);
begin
if fisfh=True then
Raise Exception.Create('缺少运算符');
if fisnot then//进行非运算
begin
if avalue.id then
Raise Exception.Create('浮点数不能做非运算');
avalue.ival := not avalue.ival;
fisnot := False;
end;
if IsLgFh(ffh[flevel]) then//运行逻辑运算
begin
value[flevel] := Calclg(value[flevel],
avalue,ffh[flevel]);
//与当前值做逻辑运算
end
else
begin
Inc(flevel);//存数位置指针加1
value[flevel] := avalue;//存入值
if flevel >2 then//数据个数达到4,进行中间运算
Calccur;
end;
fisfh := True;//输入符号可见
end;

procedure TPUSHPOP.PushFh(afh: Char);
begin
if (fisfh=false) then//非运算是一级
begin
if (afh='!') and (not fisnot) then//标识非运算
begin
fisnot := True;
Exit;
end
else
Raise Exception.Create('运算符重复');
End
Else
begin
ffh[flevel] := afh;//存入运算符
fisfh := False; 输入值可见
end;
end;

procedure TPUSHPOP.Calccur;
begin
if IsCcFh(ffh[1]) then//二级运算符
begin
value[1] := Calcsj(value[1],value[2],ffh[1]);
//计算2和3项的值
ffh[1] := ffh[2];//后序运符和值前移
value[2] := value[3];
end
else//一级运算符
begin
value[0] := Calcsj(value[0],value[1],ffh[0]);
//计算1和2项的值
value[1] := value[2];{ 后序运符和值前移,
2和3项的值不计算是为了保持第一个运算符为一级运算符}
value[2] := value[3];
ffh[0] := ffh[1];
ffh[1] := ffh[2];
end;
Dec(flevel);//存数位置指针减1
end;

 
不错~~~~[8D]
 
能给我一个例子吗?
 

Similar threads

后退
顶部