我使用z_parser做数学公式解析，但是他power(2,10)和log(2,10)出来的值都是0，为什么呢？ ( 积分: 200 )

  • 主题发起人 主题发起人 336764
  • 开始时间 开始时间
3

336764

Unregistered / Unconfirmed
GUEST, unregistred user!
使用的pas 是 z_parser.pas 下载地址：
http://www.39g.com/code/kjk/vcl/2006/11/32818194444.htm

使用 方法：
procedure TForm1.Button1Click(Sender: TObject);
var
value:string;
x,y:Double;
temp: string;
begin
x:=StrToFloat(edit4.Text);
y:=strtofloat(edit3.Text);
//value:=EvaluateTostr(edit2.Text);
temp:= edit2.Text;
temp:= StringReplace(temp,'x',FloatToStr(x),[rfReplaceAll,rfIgnoreCase]);
temp:= StringReplace(temp,'y',FloatToStr(y),[rfReplaceAll,rfIgnoreCase]);
value:=EvaluateTostr(temp);
edit1.Text:= value;
end;
=============================
计算基本简单的数学公式都正确，但是计算log和power这种就不正确，是我的写法不正确吗？

log10(100) 或 log(100)
power(2,100) 或pow(2,100)
算出来的结果都是0

如果写错，算出来的结果是：error


































































=============================================


z_parser 2006年的版本：

代码: 
unit Z_parser;
{==========================================================}
{功能：                                                    }
{1.+-*/^操作符得组合运算                                   }
{2.函数:sin,cos,tan,arctan,ln,log,exp,sqrtmax,min          }
{函数可进行扩展                                            }
{修改时间：2006.7.27                                       }
{用法：直接引用 EvaluateTostr，EvaluateToFloat 即可        }
{==========================================================}
interface

uses sysutils,stdctrls,classes,math,dialogs;

type
EparserError=class(Exception);
Rparameters= record
 x,y,z:extended;
end;

Const parameter:Rparameters=(x:1;y:1;z:1);

function getlowestopp(s0:string):integer; //取优先级最低的操作符
function EvaluateToFloat(s0:string):extended; //计算得float
function EvaluateTostr(s0:string):string; //计算得string;
Function GetEvaluationError:string;
function add(const s1:extended):extended; //测试增加函数（测试用）！！！！
implementation

//定义操作符号
const
sopps:string=('+-*/^'); //基本操作符
var EvaluationError:string;

function add(const s1:extended):extended;
begin
  result:=s1+s1;
end;
function evaluate(s0:string):extended;forward;

{====================================================}
{检查括号是否匹配，最终变量I得值便是闭括号位置       }
{====================================================}
procedure matchbracket(var i:integer;s0:string);
   var j,len:integer;
begin
      j:=1;len:=length(s0);
      repeat inc(i);
             if i>len then raise EparserError.Create('缺少 '')''');
             if s0[i]='(' then inc(j);
             if s0[i]=')' then dec(j);
             if j<0 then raise EparserError.Create('缺少 ''(''');
      until j=0;
end;

{====================================================}
{检查括号是否匹配                                    }
{====================================================}
function CanMatchBracket(str:string):boolean;
var i,j,len:integer;
begin
   result:=false;
   j:=0;
   len:=length(str);
   for i:=0 to len do
   begin
     if str[i]='(' then inc(j);
     if str[i]=')' then dec(j);
   end;
   if j=0 then result:=true;
end;

{====================================================}
{获取参数值                                          }
{====================================================}
function getvalue(s0:string):extended;
begin
if length(s0)<1 then raise EparserError.Create('语法错误！');
if length(s0)=1 then result:=strtofloat(s0)
 else
  case s0[1] of
       'x':result:=parameter.x;
       'y':result:=parameter.y;
       'z':result:=parameter.z;
       else result:=strtofloat(s0);
  end;
end;

{====================================================}
{检查括号是否能进行计算                              }
{====================================================}
function CanEvaluated(s:string):boolean;
var k:double;
begin
    try
      k:=evaluate(s);
      result:=true;
    except
      result:=false;
    end;
end;

{====================================================}
{函数相关计算                                        }
{====================================================}
function specialF(p1:integer;s0:string):extended;
var
  operstr,prestr,laststr,tempstr:string;
  dmax,dmin,arg:extended;
  aa:array of string;
  bb:array of double;
  i,len:integer;
begin
   operstr:=copy(s0,1,p1-1);
   if s0[length(s0)]<>')' then EparserError.CreateFmt('语法不正确 %s',[s0]);

   S0:=copy(s0,p1+1,length(s0)-p1-1);

   i:= pos(',',S0);
   if i<>0 then
     begin
         //利用aa[i]来提取参数
       setlength(aa,0);
       while i<>0 do
         begin
           prestr:=copy(s0,0,i-1);
           laststr:=copy(s0,i+1,length(s0));
           if  CanMatchBracket(prestr) and  CanMatchBracket(laststr) then
           begin
              len:=length(aa);
              setlength(aa,len+1);
              aa[len]:=prestr;
              setlength(bb,len+1);
              bb[len]:=evaluate(aa[len]);
              s0:=laststr;
              i:= pos(',',S0);
              tempstr:=laststr;
           end else
           begin
              I:=pos(',',laststr);
              if i<>0 then i:=i+1+length(prestr) else break;
           end;
      end;
       //最后一个的提取
        len:=length(aa);
        setlength(aa,len+1);
        aa[len]:=tempstr;
        setlength(bb,len+1);
        bb[len]:=evaluate(aa[len]);
      //参数提取完毕，正式计算
      if  operstr ='max' then
      begin
        result:=bb[0];
        for i:=0 to len do
        begin
          if bb[i]>result then result:=bb[i];
        end;
      end;

      if  operstr ='min' then
      begin
        result:=bb[0];
        for i:=0 to len do
        begin
          if bb[i]<result then result:=bb[i];
        end;
      end;

     end else
     //没有参数情况下的计算
     begin
        if S0<>'' then arg:=evaluate(S0);
             if operstr ='sin'     then result:=sin(arg)
        else if operstr ='cos'     then result:=cos(arg)
        else if operstr ='tan'     then result:=sin(arg)/cos(arg)
        else if operstr ='arctan' then result:=arctan(arg)
        else if operstr ='log'    then result:=ln(arg)/ln(10)
        else if operstr ='ln'     then result:=ln(arg)
        else if operstr ='exp'    then result:=exp(arg)
        else if operstr ='sqrt'   then result:=sqrt(arg)   //开方
        else if operstr ='add'    then result:=add(arg)
        else if operstr ='square'   then result:=power(arg,2) //平方
        {这里可以添加新的函数}
        {enter additional functions here}
        else raise EparserError.CreateFmt('未知函数名 %s',[s0]);
     end;
end;

{====================================================}
{简单得四则运算                                      }
{====================================================}
function calculate(p1:integer;s0:string):extended;
   var v1,v2:extended;
begin
   v1:=evaluate(copy(s0,1,p1-1));
   v2:=evaluate(copy(s0,p1+1,length(s0)-p1));
   case s0[p1] of
        '+': result:=v1+v2;
        '-': result:=v1-v2;
        '/': result:=v1/v2;
        '*': result:=v1*v2;
        '^': result:=exp(v2*ln(v1));
        else raise EparserError.CreateFmt('非法操作符 %s',[s0]);
        end;
end;

{====================================================}
{获取表达式中优先级最低的操作符                      }
{====================================================}
function getlowestopp(s0:string):integer;
var i,j,op,temp:integer;
begin
  i:=1;
  op:=6;
  result:=0;
  repeat
  if s0[i] in ['+','-','*','/','^','('] then
   begin
    if s0[i]='(' then
     begin
      matchbracket(i,s0);
      continue;
     end
    else      
      begin
        for j:=1 to 5 do
          temp:=pos(s0[i],sopps);
          if op>=temp then
           begin
             op:=temp;
             Result:=i;
           end;
      end;
    end;
    inc(i);
  until i=length(s0)+1;
end;

{====================================================}
{表达式解析计算程序                                  }
{====================================================}
function evaluate(s0:string):extended;
var
   p1,p2,q1:integer;
begin
   //如果首行为负号
   if pos('-',s0)=1 then s0:='0'+s0;
   p1:=pos('(',s0);
   p2:=p1;
   //检查括号是否匹配
   if p2>0 then matchbracket(p2,s0);
   //如果第一个就是'（'那么把前后的括号去掉，继续计算；
   if (p1=1) and (p2=length(s0)) then
     begin
       delete(s0,p2,1);
       delete(s0,1,1);
       result:=evaluate(s0);
     end ;

   //在第一个不是括号情况下的运算=（普通计算+函数符号计算）
   //取得优先级最低一个运算符号
   q1:=getlowestopp(s0);
   //p1=0且q1=0，那么最后的计算值显示
   if (p1+q1=0) then
      begin
       result:=strtofloat(s0);
       exit;
      end;
   //运算符号存在
   if q1<>0 then result:=calculate(q1,s0) //运算符号不存在，但是括号存在
    else if length(s0)>p2 then
       result:=calculate(p2+1,s0)
    else result:=specialF(p1,s0);
end;

{====================================================}
{清除表达式无用符号                                  }
{====================================================}
procedure cleanup(var s0:string);
var i:integer;
begin
     s0:=lowercase(s0);
     //清理空格
     i:=pos(' ',s0);
     while i>0 do
     begin
      delete(s0,i,1);
      i:=pos(' ',s0);
     end;
     //清理TAB
     i:=pos(#10,s0);
     while i>0 do
     begin
      delete(s0,i,1);
      i:=pos(#10,s0);
     end;
     //清理回车
     i:=pos(#13,s0);
     while i>0 do
     begin
      delete(s0,i,1);
      i:=pos(#13,s0);
     end;
end;


function evaluateToFloat(s0:string):extended;
begin
  TRY
     evaluationerror:='';
     cleanup(s0);
     result:=evaluate(s0);
  EXCEPT
     on e:exception do begin
        evaluationerror:=e.message;
        result:=0;
     end;
  END;
end;

function evaluateTostr(s0:string):string;
begin
  TRY
     evaluationerror:='';
     cleanup(s0);
     result:=floattostr(evaluate(s0));
  EXCEPT
     on e:exception do begin
       evaluationerror:=e.message;
       result:='错误';
     end;
  END;
end;

Function GetEvaluationError:string;
begin
result:=evaluationerror;
end;

end.


谢谢。。
 
呵呵，又是这个问题。
这个分多回答问题就有劲，还可帮你调试调试，哈哈

我重新写了个调用代码。
简单运算中'^'就是power啊，
简单运算需要两个操作数，而其他的运算只需要一个操作数即可，
所以对于简单运算，用edit3，edit4输入数字，edit2输入+,-,*,/,^即可
对于非简单运算，用edit3输入数字，eidt2输入'sin,cos,tan,arctan,log,ln,exp,sqrt'即可，不需要用edit4了。
已试过ok，
(对于用户非法输入的控制我就没写了)

procedure TForm1.Button1Click(Sender: TObject);
var
value:string;
temp: string;
aStrings: TStrings;
begin
if Trim(Edit2.Text)[1] in ['+','-','*','/','^'] then
temp:= Edit3.Text+ trim(Edit2.Text) + Edit4.Text;

aStrings:= TStringList.Create;
aStrings.Delimiter:= ',';
try
aStrings.DelimitedText:= 'sin,cos,tan,arctan,log,ln,exp,sqrt';
if aStrings.IndexOf(LowerCase(trim(Edit2.Text)))<>-1 then
temp:= LowerCase(trim(Edit2.Text))+'('+Edit3.Text+')';

value:=EvaluateTostr(temp);
edit1.Text:= value;
finally
aStrings.Free;
end;
end;
 
可能我没说清楚
x:=StrToFloat(edit4.Text);
y:=strtofloat(edit3.Text);
temp:= edit2.Text;

edit4.txt和edit3.txt是变量单独的数值，如： 1500或 9.396，可以分别替换x,y
edit2是公式： 如：ln(x)/ln(10)+power(10,y*x+0.3928^5*x)
等公式，公式肯定要比这更复杂。而非简单的^能解决。因为公式中太多的power和log，所以一个一个再去还原是麻烦事。

z_parser本身支持log和power，但是为什么我输入，他不错， 结果却为0，我很奇怪。

我想知道的是。如何让输入power(2,10)和 2^10得到同样的结果（这两个是等价的吧？）

诸如此类，其它公式函数，如log等 ，都是同理。

谢谢 。
 
搞定你的问题。运行ok

首先说明下
1 其单元没有提供power函数的功能，也不能求log2(x)，即不能求不是以10为底的对数，都需自己添加完善
2 log10(x)应该这样调用 log(x) 或 log(10,x)(必须加括号)
log2(x)应该这样调用 log(2,x);

修改代码如下：
procedure TForm1.FormCreate(Sender: TObject);
begin
{initial value}
edit3.Text:= '0';
Edit4.Text:= '0';
end;
在以前的单元中把function specialF(p1:integer;s0:string):extended;函数中加这行
{这是我新加的}
if operstr ='power' then
Result:= Power(bb[0],bb[1]);
if operstr ='log' then
Result:= logN(bb[0],bb[1]);

即：
function specialF(p1:integer;s0:string):extended;
var
operstr,prestr,laststr,tempstr:string;
dmax,dmin,arg:extended;
aa:array of string;
bb:array of double;
i,len:integer;
begin
operstr:=copy(s0,1,p1-1);
if s0[length(s0)]<>')' then EparserError.CreateFmt('incorrect syntax %s',[s0]);

S0:=copy(s0,p1+1,length(s0)-p1-1);

i:= pos(',',S0);
if i<>0 then
begin
//利用aa来提取参数
setlength(aa,0);
while i<>0 do
begin
prestr:=copy(s0,0,i-1);
laststr:=copy(s0,i+1,length(s0));
if CanMatchBracket(prestr) and CanMatchBracket(laststr) then
begin
len:=length(aa);
setlength(aa,len+1);
aa[len]:=prestr;
setlength(bb,len+1);
bb[len]:=evaluate(aa[len]);
s0:=laststr;
i:= pos(',',S0);
tempstr:=laststr;
end else
begin
I:=pos(',',laststr);
if i<>0 then i:=i+1+length(prestr) else break;
end;
end;
//最后一个的提取
len:=length(aa);
setlength(aa,len+1);
aa[len]:=tempstr;
setlength(bb,len+1);
bb[len]:=evaluate(aa[len]);
//参数提取完毕，正式计算
if operstr ='max' then
begin
result:=bb[0];
for i:=0 to len do
begin
if bb>result then result:=bb;
end;
end;

if operstr ='min' then
begin
result:=bb[0];
for i:=0 to len do
begin
if bb<result then result:=bb;
end;
end;

if operstr='if' then
begin
end;

{lisongmagic新加的，仅需修改此处}
if operstr ='power' then
Result:= Power(bb[0],bb[1]);
if operstr ='log' then
Result:= logN(bb[0],bb[1]);

end else
//没有参数情况下的计算
begin
if S0<>'' then arg:=evaluate(S0);
if operstr ='sin' then result:=sin(arg)
else if operstr ='cos' then result:=cos(arg)
else if operstr ='tan' then result:=sin(arg)/cos(arg)
else if operstr ='arctan' then result:=arctan(arg)
else if operstr ='log' then result:=ln(arg)/ln(10)
else if operstr ='ln' then result:=ln(arg)
else if operstr ='exp' then result:=exp(arg)
else if operstr ='sqrt' then result:=sqrt(arg)

{这里可以添加新的函数}
{enter additional functions here}
else raise EparserError.CreateFmt('unknown function %s',[s0]);
end;
end;
 
您必须登录或注册才可回复。

Similar threads

I
建议收录
回复
0
查看
639
import
I
I
一个IE工具单元
回复
0
查看
842
import
I
I
类似计算加减乘除二十四的算法
回复
0
查看
798
import
I
I
一些编码的解码
回复
0
查看
698
import
I
I
四则运算代数式转换为浮点数
回复
0
查看
684
import
I
后退
顶部