Solved

A function to calculate

Posted on 2002-07-11
11
237 Views
Last Modified: 2010-04-04
I would like to seek help for a function to calculate.  Assume you have a edit box and a button.  

Example Data : 15/5+6*9/3-8+(5-2)/3
When button is clicked, an answer of the calculation should be out.

The problem is I can't figure function(s) to write and to determine an answer from such complicated long length of mathematics.

Please help!
0
Comment
Question by:ivylnm
11 Comments
 

Expert Comment

by:Ahmed1
ID: 7148206
hi ivylnm
    to calculate such a complecated math you need a (forumla parser), here is a powerfull one.
i found it some where on the web last year.
try it.
good luck

==========================================================
unit evalcomp;
 {
 Allowed operations:

x <> y ; Logical operations return 1 if true and 0 if false.
x <= y
x >= y
x > y
x < y
x = y
x + y
x - y
x eor y ( exclusive or )
x or y
x * y
x / y
x and y
x mod y
x div y
x ^ y ( power )
x shl y
x shr y
not (x)
sinc (x)
sinh (x)
cosh (x)
tanh (x)
coth (x)
sin (x)
cos (x)
tan (x)
cot (x)
sqrt (x)
sqr (x)
arcsinh (x)
arccosh (x)
arctanh (x)
arccoth (x)
arcsin (x)
arccos (x)
arctan (x)
arccot (x)
heavy (x) ; 1 for positive numbers, 0 else
sgn (x) ; 1 for positive, -1 for negative, 0 for 0
frac (x)
exp (x)
abs (x)
trunc (x)
ln (x)
odd (x)
pred (x)
succ (x)
round (x)
int (x)
fac (x) ; x*(x-1)*(x-2)*...*3*2*1
rnd ; Random number in [0,1]
rnd (x) ; Random number in [0,x]
pi
e
}

interface

type fun= function(x,y:real):real;
     evalvec= ^evalobj;
     evalobj= object
              f1,f2:evalvec;
              f1x,f2y:real;
              f3:fun;
              function eval:real;
              function eval1d(x:real):real;
              function eval2d(x,y:real):real;
              function eval3d(x,y,z:real):real;
              constructor init(st:string);
              destructor done;
              end;
var  evalx,evaly,evalz:real;

implementation

var analysetmp:fun;

function search (text,code:string; var pos:integer):boolean;
var i,count:integer;
    flag:boolean;
    newtext:string;
begin
  if length(text)<length(code) then begin search:=false; exit; end;
  flag:=false;
  pos:=length(text)-length(code)+1;
  repeat
    if code=copy(text,pos,length(code))
      then flag:=true
      else dec(pos);
    if flag
      then
       begin
        count:=0;
        for i:= pos+1 to length(text) do
         begin
          if copy(text,i,1) = '(' then inc(count);
          if copy(text,i,1) = ')' then dec(count);
         end;
        if count<>0
         then
          begin
           dec(pos);
           flag:=false;
          end;
       end;
  until (flag=true) or (pos=0);
  search:=flag;
end;

function myid(x,y:real):real;
begin
 myid:=x;
end;

function myunequal(x,y:real):real;
begin
 if x<>y then
  myunequal:=1
 else
  myunequal:=0;
end;

function mylessequal(x,y:real):real;
begin
 if x<=y then
  mylessequal:=1
 else
  mylessequal:=0;
end;

function mygreaterequal(x,y:real):real;
begin
 if x>=y then
  mygreaterequal:=1
 else
  mygreaterequal:=0;
end;

function mygreater(x,y:real):real;
begin
 if x>y then
  mygreater:=1
 else
  mygreater:=0;
end;

function myless(x,y:real):real;
begin
 if x<y then
  myless:=1
 else
  myless:=0;
end;

function myequal(x,y:real):real;
begin
 if x=y then
  myequal:=1
 else
  myequal:=0;
end;

function myadd(x,y:real):real;
begin
  myadd:=x+y;
end;

function mysub(x,y:real):real;
begin
  mysub:=x-y;
end;

function myeor(x,y:real):real;
begin
  myeor:=trunc(x) xor trunc(y);
end;

function myor(x,y:real):real;
begin
  myor:=trunc(x) or trunc(y);
end;

function mymult(x,y:real):real;
begin
  mymult:=x*y;
end;

function mydivid(x,y:real):real;
begin
  mydivid:=x/y;
end;

function myand(x,y:real):real;
begin
  myand:=trunc(x) and trunc(y);
end;

function mymod(x,y:real):real;
begin
  mymod:=trunc(x) mod trunc(y);
end;

function mydiv(x,y:real):real;
begin
  mydiv:=trunc(x) div trunc(y);
end;

function mypower(x,y:real):real;
begin
 if x=0 then
  mypower:=0
 else
  if x>0 then
   mypower:=exp(y*ln(x))
  else
   if trunc(y)<>y  then
    begin
    writeln (' Fehler in x^y ');
    halt;
    end
   else
    if odd(trunc(y))=true then
     mypower:=-exp(y*ln(-x))
    else
     mypower:=exp(y*ln(-x))
end;

function myshl(x,y:real):real;
begin
  myshl:=trunc(x) shl trunc(y);
end;

function myshr(x,y:real):real;
begin
  myshr:=trunc(x) shr trunc(y);
end;

function mynot(x,y:real):real;
begin
  mynot:=not trunc(x);
end;

function mysinc(x,y:real):real;
begin
if x=0 then
 mysinc:=1
else
 mysinc:=sin(x)/x
end;

function mysinh(x,y:real):real;
begin
mysinh:=0.5*(exp(x)-exp(-x))
end;

function mycosh(x,y:real):real;
begin
mycosh:=0.5*(exp(x)+exp(-x))
end;

function mytanh(x,y:real):real;
begin
mytanh:=mysinh(x,0)/mycosh(x,0)
end;

function mycoth(x,y:real):real;
begin
mycoth:=mycosh(x,0)/mysinh(x,0)
end;

function mysin(x,y:real):real;
begin
mysin:=sin(x)
end;

function mycos(x,y:real):real;
begin
mycos:=cos(x)
end;

function mytan(x,y:real):real;
begin
mytan:=sin(x)/cos(x)
end;

function mycot(x,y:real):real;
begin
mycot:=cos(x)/sin(x)
end;

function mysqrt(x,y:real):real;
begin
mysqrt:=sqrt(x)
end;

function mysqr(x,y:real):real;
begin
mysqr:=sqr(x)
end;

function myarcsinh(x,y:real):real;
begin
myarcsinh:=ln(x+sqrt(sqr(x)+1))
end;

function mysgn(x,y:real):real;
begin
if x=0 then
 mysgn:=0
else
 mysgn:=x/abs(x)
end;

function myarccosh(x,y:real):real;
begin
myarccosh:=ln(x+mysgn(x,0)*sqrt(sqr(x)-1))
end;

function myarctanh(x,y:real):real;
begin
myarctanh:=ln((1+x)/(1-x))/2
end;

function myarccoth(x,y:real):real;
begin
myarccoth:=ln((1-x)/(1+x))/2
end;

function myarcsin(x,y:real):real;
begin
if x=1 then
 myarcsin:=pi/2
else
 myarcsin:=arctan(x/sqrt(1-sqr(x)))
end;

function myarccos(x,y:real):real;
begin
myarccos:=pi/2-myarcsin(x,0)
end;

function myarctan(x,y:real):real;
begin
myarctan:=arctan(x);
end;

function myarccot(x,y:real):real;
begin
     myarccot:=pi/2-arctan(x)
end;

function myheavy(x,y:real):real;
begin
     myheavy:=mygreater(x,0)
end;

function myfrac(x,y:real):real;
begin
     myfrac:=frac(x)
end;

function myexp(x,y:real):real;
begin
     myexp:=exp(x)
end;

function myabs(x,y:real):real;
begin
     myabs:=abs(x)
end;

function mytrunc(x,y:real):real;
begin
     mytrunc:=trunc(x)
end;

function myln(x,y:real):real;
begin
     myln:=ln(x)
end;

function myodd(x,y:real):real;
begin
if odd(trunc(x)) then
 myodd:=1
else
 myodd:=0;
end;

function mypred(x,y:real):real;
begin
mypred:=pred(trunc(x));
end;

function mysucc(x,y:real):real;
begin
mysucc:=succ(trunc(x));
end;

function myround(x,y:real):real;
begin
myround:=round(x);
end;

function myint(x,y:real):real;
begin
myint:=int(x);
end;

function myfac(x,y:real):real;
var n : integer;
    r : real;
begin
if x<0 then begin writeln(' Fehler in Fakultt '); halt; end;
if x = 0 then myfac := 1
else
 begin
 r := 1;
 for n := 1 to trunc ( x ) do
  r := r * n;
 myfac:= r;
 end;
end;

function myrnd(x,y:real):real;
begin
myrnd:=random;
end;

function myrandom(x,y:real):real;
begin
myrandom:=random(trunc(x));
end;

function myevalx(x,y:real):real;
begin
myevalx:=evalx;
end;

function myevaly(x,y:real):real;
begin
myevaly:=evaly;
end;

function myevalz(x,y:real):real;
begin
myevalz:=evalz;
end;

procedure analyse (st:string; var st2,st3:string);
label start;
    var pos:integer;
    value:real;
    newterm,term:string;
begin
term:=st;
start:
  if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
  newterm:='';
  for pos:= 1 to length(term) do
    if copy(term,pos,1)<>' ' then newterm:=newterm+copy(term,pos,1);
  term:=newterm;
  if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
  val(term,value,pos);
  if pos=0 then begin
                  analysetmp:=myid;
                  st2:=term;
                  st3:='';
                  exit;
                end;
  if search(term,'<>',pos) then begin
       analysetmp:=myunequal;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+2,length(term)-pos-1);
       exit;
       end;
  if search(term,'<=',pos) then begin
       analysetmp:=mylessequal;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+2,length(term)-pos-1);
       exit;
       end;
  if search(term,'>=',pos) then begin
       analysetmp:=mygreaterequal;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+2,length(term)-pos-1);
       exit;
       end;
  if search(term,'>',pos) then begin
       analysetmp:=mygreater;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'<',pos) then begin
       analysetmp:=myless;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'=',pos) then begin
       analysetmp:=myequal;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'+',pos) then begin
       analysetmp:=myadd;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'-',pos) then begin
       analysetmp:=mysub;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'eor',pos) then begin
       analysetmp:=myeor;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if search(term,'or',pos) then begin
       analysetmp:=myor;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+2,length(term)-pos-1);
       exit;
       end;
  if search(term,'*',pos) then begin
       analysetmp:=mymult;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'/',pos) then begin
       analysetmp:=mydivid;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'and',pos) then begin
       analysetmp:=myand;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if search(term,'mod',pos) then begin
       analysetmp:=mymod;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if search(term,'div',pos) then begin
       analysetmp:=mydiv;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if search(term,'^',pos) then begin
       analysetmp:=mypower;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+1,length(term)-pos);
       exit;
       end;
  if search(term,'shl',pos) then begin
       analysetmp:=myshl;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if search(term,'shr',pos) then begin
       analysetmp:=myshr;
       st2:=copy(term,1,pos-1);
       st3:=copy(term,pos+3,length(term)-pos-2);
       exit;
       end;
  if copy(term,1,1)='(' then begin
          term:=copy(term,2,length(term)-2);
          goto start;
          end;
  if copy(term,1,3)='not' then begin
          analysetmp:=mynot;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='sinc' then begin
          analysetmp:=mysinc;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='sinh' then begin
          analysetmp:=mysinh;

          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='cosh' then begin
          analysetmp:=mycosh;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='tanh' then begin
          analysetmp:=mytanh;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='coth' then begin
          analysetmp:=mycoth;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='sin' then begin
          analysetmp:=mysin;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='cos' then begin
          analysetmp:=mycos;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='tan' then begin
          analysetmp:=mytan;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='cot' then begin
          analysetmp:=mycot;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='sqrt' then begin
          analysetmp:=mysqrt;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='sqr' then begin
          analysetmp:=mysqr;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,7)='arcsinh' then begin
          analysetmp:=myarcsinh;
          st2:=copy(term,8,length(term)-7);
          st3:='';
          exit;
          end;
  if copy(term,1,7)='arccosh' then begin
          analysetmp:=myarccosh;
          st2:=copy(term,8,length(term)-7);
          st3:='';
          exit;
          end;
  if copy(term,1,7)='arctanh' then begin
          analysetmp:=myarctanh;
          st2:=copy(term,8,length(term)-7);
          st3:='';
          exit;
          end;
  if copy(term,1,7)='arccoth' then begin
          analysetmp:=myarccoth;
          st2:=copy(term,8,length(term)-7);
          st3:='';
          exit;
          end;
  if copy(term,1,6)='arcsin' then begin
          analysetmp:=myarcsin;
          st2:=copy(term,7,length(term)-6);
          st3:='';
          exit;
          end;
  if copy(term,1,6)='arccos' then begin
          analysetmp:=myarccos;
          st2:=copy(term,7,length(term)-6);
          st3:='';
          exit;
          end;
  if copy(term,1,6)='arctan' then begin
          analysetmp:=myarctan;
          st2:=copy(term,7,length(term)-6);
          st3:='';
          exit;
          end;
  if copy(term,1,6)='arccot' then begin
          analysetmp:=myarccot;
          st2:=copy(term,7,length(term)-6);
          st3:='';
          exit;
          end;
  if copy(term,1,5)='heavy' then begin
          analysetmp:=myheavy;
          st2:=copy(term,6,length(term)-5);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='sgn' then begin
          analysetmp:=mysgn;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='frac' then begin
          analysetmp:=myfrac;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='exp' then begin
          analysetmp:=myexp;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='abs' then begin
          analysetmp:=myabs;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,5)='trunc' then begin
          analysetmp:=mytrunc;
          st2:=copy(term,6,length(term)-5);
          st3:='';
          exit;
          end;
  if copy(term,1,2)='ln' then begin
          analysetmp:=myln;
          st2:=copy(term,3,length(term)-2);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='odd' then begin
          analysetmp:=myodd;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='pred' then begin
          analysetmp:=mypred;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,4)='succ' then begin
          analysetmp:=mysucc;
          st2:=copy(term,5,length(term)-4);
          st3:='';
          exit;
          end;
  if copy(term,1,5)='round' then begin
          analysetmp:=myround;
          st2:=copy(term,6,length(term)-5);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='int' then begin
          analysetmp:=myint;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if copy(term,1,3)='fac' then begin
          analysetmp:=myfac;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if term='rnd' then begin
          analysetmp:=myrnd;
          st2:='';
          st3:='';
          exit;
          end;
  if copy(term,1,3)='rnd' then begin
          analysetmp:=myrandom;
          st2:=copy(term,4,length(term)-3);
          st3:='';
          exit;
          end;
  if term='x' then begin
          analysetmp:=myevalx;
          st2:='';
          st3:='';
          exit;
          end;
  if term='y' then begin
          analysetmp:=myevaly;
          st2:='';
          st3:='';
          exit;
          end;
  if term='z' then begin
          analysetmp:=myevalz;
          st2:='';
          st3:='';
          exit;
          end;
  if (term='pi') then begin
          analysetmp:=myid;
          str(pi,st2);
          st3:='';
          exit;
          end;
  if term='e' then begin
          analysetmp:=myid;
          str(exp(1),st2);
          st3:='';
          exit;
          end;
  writeln(' WARNING : UNDECODABLE FORMULA ');
  analysetmp:=myid;
  st2:='';
  st3:='';
end;

function evalobj.eval:real;
var tmpx,tmpy:real;
begin
 if f1=nil then
  tmpx:=f1x
 else
  tmpx:=f1^.eval;
 if f2=nil then
  tmpy:=f2y
 else
  tmpy:=f2^.eval;
 eval:=f3(tmpx,tmpy);
end;

function evalobj.eval1d(x:real):real;
begin
evalx:=x;
evaly:=0;
evalz:=0;
eval1d:=eval;
end;

function evalobj.eval2d(x,y:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=0;
eval2d:=eval;
end;

function evalobj.eval3d(x,y,z:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=z;
eval3d:=eval;
end;

constructor evalobj.init(st:string);
var st2,st3:string;
    error:integer;
begin
f1:=nil;
f2:=nil;
analyse(st,st2,st3);
f3:=analysetmp;
val(st2,f1x,error);
if st2='' then
begin
 f1x:=0;
 error:=0;
end;
if error<>0 then
 new (f1,init(st2));
val(st3,f2y,error);
if st3='' then
begin
 f2y:=0;
 error:=0;
end;
if error<>0 then
 new (f2,init(st3));
end;

destructor evalobj.done;
begin
if f1<>nil then
 dispose(f1,done);
if f2<>nil then
 dispose(f2,done);
end;

end.
==========================================================
0
 
LVL 1

Expert Comment

by:Omycron
ID: 7149119
Is this a homework?
0
 
LVL 1

Expert Comment

by:Omycron
ID: 7149277
Try this code, if you understand it you can add functionality for other mathematical functions easily.
(now +,-,*,/,^(exponential))

I used a stack (LIFO) for saving the data needed.
The Pop operation should return Data and delete the Item.
Using a different stack it could look like:

"
MyStack.push(FloatToStr(Power(Operand2,Operand1)));
"

The IsEmpty function should be also implemented some way.
The Power function is in the unit math.


_________________________________________________

function nextItem(var Equation : String) : String;
var
index : integer;
begin

index := 1;

while (Equation[index] in ['0'..'9']) do
begin
inc(index);
end;

if index > 1 then begin dec(index); end;
result := copy(Equation,0,index);
delete(Equation, 1,index);
end;


function prio(var Operator : Char) : Integer;
begin

case Operator of
'+','-' : result := 1;
'*','/' : result := 2;
'^'     : result := 3;
else
result := 0;
end;

end;


function InfixPostfix(Equation : String) : String;
var
Token : String;
begin

push(MyStack,'(');
Equation := Equation + ')';
while IsEmpty(MyStack) = False do
begin
Token := nextItem(Equation);
case PChar(Token)^ of

'0'..'9' :
       begin
        result := result + Token + ' ';
       end;
'+','-','*','/','^' :
       begin
         while prio(PChar(MyStack.Data)^) >= prio(PChar(Token)^) do
         begin
         result := result + pop(MyStack) + ' ';
         end;
         push(MyStack,Token);
       end;
'(' :
       begin
        push(MyStack,Token);
       end;
')' :
       begin
        while MyStack.Data <> '(' do
        begin
        result := result + pop(MyStack) + ' ';
        end;
        pop(MyStack);
       end;
end;
end;
end;


function CalculatePostfix(Equation : String) : Extended;
var
Token : String;
Operand1, Operand2 : Extended;
begin

Equation := Equation + ')';
Token := nextItem(Equation);
while Token <> ')' do
begin

case PChar(Token)^ of
'0'..'9' :
 begin
 push(MyStack,Token);
 end;
'+':
 begin
 push(MyStack,FloatToStr(StrToFloat(pop(MyStack)) + StrToFloat(pop(MyStack))));
 end;
'-':
 begin
 Operand1 := StrToFloat(pop(MyStack));
 Operand2 := StrToFloat(pop(MyStack));
 push(MyStack,FloatToStr(Operand2 - Operand1 ));
 end;
'*':
 begin
 push(MyStack,FloatToStr(StrToFloat(pop(MyStack)) * StrToFloat(pop(MyStack))));
 end;
'/':
 begin
 Operand1 := StrToFloat(pop(MyStack));
 Operand2 := StrToFloat(pop(MyStack));
 push(MyStack,FloatToStr(Operand2 / Operand1));
 end;
'^':
 begin
 Operand1 := StrToFloat(pop(MyStack));
 Operand2 := StrToFloat(pop(MyStack));
 push(MyStack,FloatToStr(Power(Operand2,Operand1)));
 end;

end;
Token := nextItem(Equation);
end;
result := StrToFloat(pop(MyStack));
end;



end.


______________________________________



call it this way:

Label1.Caption := Floattostr(calculatepostfix(infixpostfix(edit1.Text)));

______________________________________


I think this version is more useful for you than the other code found by Ahmed1, because it is not so overloaded.

Greeds
Omycron
0
 
LVL 6

Expert Comment

by:zebada
ID: 7150943
There is an expression parser, evaluator that will do what you want called "expr" - under the Delphi section.

http://www.blacky.co.nz/free/index.htm
0
 
LVL 14

Expert Comment

by:DragonSlayer
ID: 7151002
Or you could add a scripting control to your form and then let the control evaluate the expression
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 1

Expert Comment

by:Omycron
ID: 7151157
For your term my solution seems to be the best way.
Just try it
0
 

Author Comment

by:ivylnm
ID: 7153543
Dear Omycron, I am trying to implement your codes.  But I find errors when compiling.

[Error] OTCalculator.pas(44): Undeclared identifier: 'push'

What libraries I need to include? I have written only these into the unit.

uses Contnrs, math, Windows;

 Please guide.
0
 
LVL 1

Expert Comment

by:Omycron
ID: 7154182
Hi ivylnm,
I have used a self written stack based on a self written list. These units have not been taken from the standard libary but I will give you an example how to implement the functions with standard units.
0
 
LVL 1

Accepted Solution

by:
Omycron earned 100 total points
ID: 7154415
Man I really hpoe this is not a homework ;-), though take this:

unit InfixToPostfix;

interface
uses
SysUtils,Classes,Math,Contnrs;

function nextItem(var Equation : String) : String;
function InfixPostfix(Equation : String) : String;
function CalculatePostfix(Equation : String) : Extended;

var
MyStack : TStringList;

implementation


function nextItem(var Equation : String) : String;
var
index : integer;
begin

index := 1;

while (Equation[index] in ['0'..'9']) do
begin
inc(index);
end;

if index > 1 then begin dec(index); end;
result := copy(Equation,0,index);
delete(Equation, 1,index);
end;


function prio(var Operator : Char) : Integer;
begin

case Operator of
'+','-' : result := 1;
'*','/' : result := 2;
'^'     : result := 3;
else
result := 0;
end;

end;


function InfixPostfix(Equation : String) : String;
var
Token, Temp : String;
begin
Mystack := TStringlist.Create;


MyStack.Add('(');
Equation := Equation + ')';
while MyStack.Count <> 0 do
begin
Token := nextItem(Equation);
case PChar(Token)^ of

'0'..'9' :
       begin
        result := result + Token + ' ';
       end;
'+','-','*','/','^' :
       begin



         while prio(PChar(MyStack.Strings[MyStack.Count-1])^) >= prio(PChar(Token)^) do
         begin
         result := result + MyStack.Strings[MyStack.Count-1] + ' ';
         MyStack.Delete(MyStack.Count-1);
         end;
         MyStack.add(Token);
       end;
'(' :
       begin
        MyStack.add(Token);
       end;
')' :
       begin
        while MyStack.Strings[MyStack.Count-1]  <> '(' do
        begin
        result := result + MyStack.Strings[MyStack.Count-1] + ' ';
        MyStack.Delete(MyStack.Count-1);
        end;
        MyStack.Delete(MyStack.Count-1);
       end;
end;
end;
end;


function CalculatePostfix(Equation : String) : Extended;
var
Token,Temp : String;
Operand1, Operand2 : Extended;
begin

Equation := Equation + ')';
Token := nextItem(Equation);
while Token <> ')' do
begin

case PChar(Token)^ of
'0'..'9' :
 begin
 MyStack.add(Token);
 end;
'+':
 begin
 Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 MyStack.add(FloatToStr(Operand1+Operand2));
 end;
'-':
 begin
 Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 MyStack.add(FloatToStr(Operand2 - Operand1));
 end;
'*':
 begin
 Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 MyStack.add(FloatToStr(Operand2 * Operand1));
 end;
'/':
 begin
 Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 MyStack.add(FloatToStr(Operand2 / Operand1));
 end;
'^':
 begin
 Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
 MyStack.Delete(MyStack.Count-1);
 MyStack.add(FloatToStr(Power(Operand2,Operand1)));
 end;

end;
Token := nextItem(Equation);
end;
result := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;


end.


--------------------------------

It is still called MyStack but actually it is a Stringlist but this is not important for the program.
I hope this will help you.

Greeds
Omycron
0
 

Author Comment

by:ivylnm
ID: 7155913
Omycron,  rest assured that it is not homework ya.  Thanks for help.
0
 

Author Comment

by:ivylnm
ID: 7156452
Thanks so much for helping me ~
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now