Title: Convert a string to a mathematical expression and get its result.Updated!
Question: How to convert a string to a mathematical expression and get its result.
Answer:
I have updated the previous code enabling you to use function such as sin,cos,tan,cot,log,ln etc
Here is the code
unit MathComponent;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,math;
type
TOperandtype=(ttradians,ttdegrees,ttgradients);
TMathtype=(mtnil,mtoperator,mtlbracket,mtrbracket,mtoperand,mtfunction);
TMathSubtype=(msnone,mstrignometric);
TMathOperator=(monone,moadd,mosub,modiv,momul,mopow,momod,modivint);
TMathFunction=(mfnone,mfsinh,mfcosh,mftanh,mfcosech,mfsech,mfcoth,mfsin,mfcos,mftan,mfcot,mfsec,mfcosec,mflog,mfln,mfsub,mfadd);
type
pmathchar = ^Tmathchar;
TMathChar = record
case mathtype: Tmathtype of
mtoperand:(data:extended);
mtoperator:(op:TMathOperator);
mtfunction:(func:TMathfunction;subtype:(mstnone,msttrignometric));
end;
type
TMathControl = class(TComponent)
private
input,output,stack:array of tmathchar;
fmathstring:string;
ftrignometrictype:Toperandtype;
fExpressionValid:boolean;
procedure removespace;
function isvalidchar(c:char):boolean;
function getresult:extended;
function checkbrackets:boolean;
function calculate(operand1,operand2,operator:Tmathchar):extended;overload;
function calculate(operand1,operator:Tmathchar):extended;overload;
function getoperator(pos:integer;var len:integer;var amathoperator:TMathOperator):boolean;
function getoperand(pos:integer;var len:integer;var value:extended):boolean;
function getmathfunc(pos:integer;var len:integer;var amathfunc:TmathFunction):boolean;
function processstring:boolean;
procedure convertinfixtopostfix;
function isdigit(c:char):boolean;
function getprecedence(mop:TMathchar):integer;
protected
procedure loaded;override;
published
property MathExpression:string read fmathstring write fmathstring;
property MathResult:extended read getresult;
property ExpressionValid:boolean read fExpressionvalid;
property Trignometrictype:Toperandtype read ftrignometrictype write ftrignometrictype;
end;
procedure Register;
implementation
function tmathcontrol.calculate(operand1,operator:Tmathchar):extended;
begin
result:=0;
if (operator.subtype=msttrignometric) then
begin
if ftrignometrictype=ttdegrees then
operand1.data:=operand1.data*(pi/180);
if ftrignometrictype=ttgradients then
operand1.data:=GradToRad(operand1.data);
end;
case operator.func of
mfsub:result:=-operand1.data;
mfadd:result:=operand1.data;
mfsin:result:=sin(operand1.data);
mfcos:result:=cos(operand1.data);
mfcot:result:=1/tan(operand1.data);
mfcosec:result:=1/sin(operand1.data);
mfsec:result:=1/cos(operand1.data);
mftan:result:=tan(operand1.data);
mflog:result:=log10(operand1.data);
mfln:result:=ln(operand1.data);
end;
end;
function tmathcontrol.getmathfunc(pos:integer;var len:integer;var amathfunc:TmathFunction):boolean;
var
tmp:string;
i:integer;
begin
amathfunc:=mfnone;
result:=false;
tmp:='';
if (fmathstring[pos]='+') then
begin
amathfunc:=mfadd;
len:=1;
result:=true;
end;
if (fmathstring[pos]='-') then
begin
amathfunc:=mfsub;
len:=1;
result:=true;
end;
if (fmathstring[pos]='s') then
begin
for i:=pos to pos+3 do
tmp:=tmp+fmathstring[i];
if strcomp(pchar(tmp),'sin(') = 0 then
begin
amathfunc:=mfsin;
len:=3;
result:=true;
end
else if strcomp(pchar(tmp),'sec(') = 0 then
begin
amathfunc:=mfsec;
len:=3;
result:=true;
end;
end;
if (fmathstring[pos]='c') then
begin
for i:=pos to pos+5 do
tmp:=tmp+fmathstring[i];
if strlcomp(pchar(tmp),'cos(',4) = 0 then
begin
amathfunc:=mfcos;
len:=3;
result:=true;
end
else if strlcomp(pchar(tmp),'cot(',4) = 0 then
begin
amathfunc:=mfcot;
len:=3;
result:=true;
end
else if strlcomp(pchar(tmp),'cosec(',6) = 0 then
begin
amathfunc:=mfcosec;
len:=3;
result:=true;
end
end;
if (fmathstring[pos]='t') then
begin
for i:=pos to pos+3 do
tmp:=tmp+fmathstring[i];
if strlcomp(pchar(tmp),'tan(',4) = 0 then
begin
amathfunc:=mflog;
len:=3;
result:=true;
end;
end;
if (fmathstring[pos]='l') then
begin
for i:=pos to pos+3 do
tmp:=tmp+fmathstring[i];
if strlcomp(pchar(tmp),'log(',4) = 0 then
begin
amathfunc:=mflog;
len:=3;
result:=true;
end
else if strlcomp(pchar(tmp),'ln(',3) = 0 then
begin
amathfunc:=mfln;
len:=3;
result:=true;
end
end;
end;
procedure tmathcontrol.loaded;
begin
inherited;
fexpressionvalid:=processstring;
end;
procedure tmathcontrol.removespace;
var
i:integer;
tmp:string;
begin
tmp:='';
for i:=1 to length(fmathstring) do
if fmathstring[i]' ' then
tmp:=tmp+fmathstring[i];
fmathstring:=tmp;
end;
function tmathcontrol.isvalidchar(c:char):boolean;
begin
result:=true;
if (not(isdigit(c))) and (not(c in ['(',')','t','l','c','m','d','s','*','/','+','-','^'])) then
result:=false;
end;
function tmathcontrol.checkbrackets:boolean;
var
i:integer;
bracketchk:integer;
begin
result:=true;
bracketchk:=0;
i:=1;
if length(fmathstring) = 0 then
result:=false;
while i begin
if fmathstring[i]='(' then
bracketchk:=bracketchk+1
else if fmathstring[i]=')' then
bracketchk:=bracketchk-1;
i:=i+1;
end;
if bracketchk0 then
result:=false;
end;
function Tmathcontrol.calculate(operand1,operand2,operator:Tmathchar):extended;
begin
result:=0;
case operator.op of
moadd:
result:=operand1.data + operand2.data;
mosub:
result:=operand1.data - operand2.data;
momul:
result:=operand1.data * operand2.data;
modiv:
if (operand1.data0) and (operand2.data0) then
result:=operand1.data / operand2.data
else
result:=0;
mopow: result:=power(operand1.data,operand2.data);
modivint:
if (operand1.data0) and (operand2.data0) then
result:= round(operand1.data) div round(operand2.data)
else
result:=0;
momod:
if (operand1.data=0.5) and (operand2.data=0.5) then
result:=round(operand1.data) mod round(operand2.data)
else
result:=0;
end;
end;
function Tmathcontrol.getresult:extended;
var
i:integer;
tmp1,tmp2,tmp3:tmathchar;
begin
fExpressionValid:=processstring;
if fExpressionValid = false then
begin
result:=0;
exit;
end;
convertinfixtopostfix;
setlength(stack,0);
for i:=0 to length(output)-1 do
begin
if output[i].mathtype=mtoperand then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=output[i];
end
else if output[i].mathtype=mtoperator then
begin
tmp1:=stack[length(stack)-1];
tmp2:=stack[length(stack)-2];
setlength(stack,length(stack)-2);
tmp3.mathtype:=mtoperand;
tmp3.data:=calculate(tmp2,tmp1,output[i]);
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=tmp3;
end
else if output[i].mathtype=mtfunction then
begin
tmp1:=stack[length(stack)-1];
setlength(stack,length(stack)-1);
tmp2.mathtype:=mtoperand;
tmp2.data:=calculate(tmp1,output[i]);
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=tmp2;
end;
end;
result:=stack[0].data;
setlength(stack,0);
setlength(input,0);
setlength(output,0);
end;
function Tmathcontrol.getoperator(pos:integer;var len:integer;var amathoperator:TMathOperator):boolean;
var
tmp:string;
i:integer;
begin
tmp:='';
result:=false;
if fmathstring[pos]='+' then
begin
amathoperator:=moadd;
len:=1;
result:=true;
end
else if fmathstring[pos]='*' then
begin
amathoperator:=momul;
len:=1;
result:=true;
end
else if fmathstring[pos]='/' then
begin
amathoperator:=modiv;
len:=1;
result:=true;
end
else if fmathstring[pos]='-' then
begin
amathoperator:=mosub;
len:=1;
result:=true;
end
else if fmathstring[pos]='^' then
begin
amathoperator:=mopow;
len:=1;
result:=true;
end
else if fmathstring[pos]='d' then
begin
for i:= pos to pos+2 do
tmp:=tmp+fmathstring[i];
if strcomp(pchar(tmp),'div')=0 then
begin
amathoperator:=modivint;
len:=3;
result:=true;
end;
end
else if fmathstring[pos]='m' then
begin
for i:= pos to pos+2 do
tmp:=tmp+fmathstring[i];
if strcomp(pchar(tmp),'mod')=0 then
begin
amathoperator:=momod;
len:=3;
result:=true;
end;
end;
end;
function Tmathcontrol.getoperand(pos:integer;var len:integer;var value:extended):boolean;
var
i,j:integer;
tmpnum:string;
dotflag:boolean;
begin
j:=1;
result:=true;
dotflag:=false;
for i:=pos to length(fmathstring)-1 do
begin
if isdigit(fmathstring[i]) then
begin
if (fmathstring[i]='.') and (dotflag=true) then
begin
result:=false;
break;
end
else if (fmathstring[i] ='.') and (dotflag=false) then
dotflag:=true;
tmpnum:=tmpnum+fmathstring[i];
j:=j+1;
end
else
break;
end;
if result=true then
begin
value:=strtofloat(tmpnum);
len:=j-1;
end;
end;
function Tmathcontrol.processstring:boolean;
var
i:integer;
mov:integer;
tmpfunc:tmathfunction;
tmpop:tmathoperator;
numoperators:integer;
numoperands:integer;
begin
i:=0;
mov:=0;
numoperators:=0;
numoperands:=0;
setlength(output,0);
setlength(input,0);
setlength(stack,0);
removespace;
result:=true;
if checkbrackets = false then
begin
result:=false;
exit;
end;
fmathstring:='('+fmathstring+')';
while i begin
if not(isvalidchar(fmathstring[i+1])) then
begin
result:=false;
break;
end;
if fmathstring[i+1]='(' then
begin
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtlbracket;
i:=i+1;
end
else if fmathstring[i+1]=')' then
begin
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtrbracket;
i:=i+1;
end
else if getoperator(i+1,mov,tmpop) then
begin
if (tmpopmoadd) and (tmpopmosub) then
begin
if i=0 then//first character cannot be an operator
begin // other than a '+' or '-'.
result:=false;
break;
end;
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtoperator;
input[length(input)-1].op:=tmpop;
i:=i+mov;
numoperators:=numoperators+1;
end
else if (tmpop=mosub) or (tmpop=moadd) then
begin
if (i=0) or (input[length(input)-1].mathtype=mtoperator) or (input[length(input)-1].mathtype=mtlbracket) then
begin //makes use of fact the if the first part of if expression is true then
//remaining parts are not evaluated thus preventing a
//exception from occuring.
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtfunction;
getmathfunc(i+1,mov,tmpfunc);
input[length(input)-1].func:=tmpfunc;
i:=i+mov;
end
else
begin
setlength(input,length(input)+1);
numoperators:=numoperators+1;
input[length(input)-1].mathtype:=mtoperator;
input[length(input)-1].op:=tmpop;
i:=i+1;
end;
end;
end
else if isdigit(fmathstring[i+1]) then
begin
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtoperand;
if getoperand(i+1,mov,input[length(input)-1].data) = false then
begin
result:=false;
break;
end;
i:=i+mov;
numoperands:=numoperands+1;
end
else
begin
getmathfunc(i+1,mov,tmpfunc);
if tmpfuncmfnone then
begin
setlength(input,length(input)+1);
input[length(input)-1].mathtype:=mtfunction;
input[length(input)-1].func:=tmpfunc;
if tmpfunc in [mfsin,mfcos,mftan,mfcot,mfcosec,mfsec] then
input[length(input)-1].subtype:=msttrignometric
else
input[length(input)-1].subtype:=mstnone;
i:=i+mov;
end
else
begin
result:=false;
break;
end;
end;
end;
if numoperands-numoperators1 then
result:=false;
end;
function Tmathcontrol.isdigit(c:char):boolean;
begin
result:=false;
if ((integer(c) 47) and (integer(c) result:=true;
end;
function Tmathcontrol.getprecedence(mop:TMathchar):integer;
begin
result:=-1;
if mop.mathtype= mtoperator then
begin
case mop.op of
moadd:result:=1;
mosub:result:=1;
momul:result:=2;
modiv:result:=2;
modivint:result:=2;
momod:result:=2;
mopow:result:=3;
end
end
else if mop.mathtype=mtfunction then
result:=4;
end;
procedure Tmathcontrol.convertinfixtopostfix;
var
i,j,prec:integer;
begin
for i:=0 to length(input)-1 do
begin
if input[i].mathtype=mtoperand then
begin
setlength(output,length(output)+1);
output[length(output)-1]:=input[i];
end
else if input[i].mathtype=mtlbracket then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end
else if (input[i].mathtype=mtoperator) then
begin
prec:=getprecedence(input[i]);
j:=length(stack)-1;
if j=0 then
begin
while(getprecedence(stack[j])=prec) and (j=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end;
end
else if input[i].mathtype=mtfunction then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end
else if input[i].mathtype=mtrbracket then
begin
j:=length(stack)-1;
if j=0 then
begin
while(stack[j].mathtypemtlbracket) and (j=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
if j=0 then
setlength(stack,length(stack)-1);
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMathControl]);
end;
end.