We help IT Professionals succeed at work.

# Expression Tree/Binary Tree algorythm??

on
Medium Priority
316 Views
I am writing a program that requres that I perform expression evalations.  For example, ((X = Y) AND (D>Y)) Where X,Y, and D are all variables or contants that a user enters.  I know I need to create a tree in order to handle the nesting.  I'm looking for any algorthyms in Delphi.

BTW, the expression will always evaluate to true or false.

thansk
Any suggestions.
Comment
Watch Question

## View Solution Only

Commented:
{
Here is a pascal program (plus test code) for logical operations and variables, just change the code.

Next, there is my EVAL unit, which by now only works with non-logical output. By connecting them together you could make what you want.
}
uses crt;

type vars = object
data: array[1..20] of boolean;
n:byte;
constructor init(num:byte);
constructor cmb(cno:longint; num:byte);
procedure print;
end;

constructor vars.init;
begin
n:=num;
end;

constructor vars.cmb;
var i:byte;
begin
init(num);
for i:=1 to n do data[i]:=boolean((cno and (1 shl (n-i))) shr (n-i));
end;

procedure vars.print;
var i:byte;
begin
for i:=1 to n do if data[i] then write('1³') else write('0³');
end;

type eptr = ^expression;
expression = object
function eval(v:vars):boolean; virtual;
function print:string; virtual;
{function whoami:byte; virtual;
function gete1:eptr; virtual;
function gete2:eptr; virtual;}
destructor done; virtual;
end;

function expression.eval;
begin
eval:=false;
end;

function expression.print;
begin
end;

destructor expression.done;
begin
end;

type gand = object(expression)
exp1,exp2:eptr;
function eval(v:vars):boolean; virtual;
function print:string; virtual;
constructor init(e1,e2:eptr);
destructor done; virtual;
end;

constructor gand.init;
begin
exp1:=e1; exp2:=e2;
end;

function gand.eval;
begin
eval:=exp1^.eval(v) and exp2^.eval(v);
end;

function gand.print;
begin
print:=(exp1^.print+'*'+exp2^.print);
end;

destructor gand.done;
begin
dispose(exp1,done); dispose(exp2,done);
end;

function mkand(exp1,exp2:eptr):eptr;
var e:^gand;
begin
new(e,init(exp1,exp2));
mkand:=e;
end;

type gor = object(expression)
exp1,exp2:eptr;
function eval(v:vars):boolean; virtual;
function print:string; virtual;
constructor init(e1,e2:eptr);
destructor done; virtual;
end;

constructor gor.init;
begin
exp1:=e1; exp2:=e2;
end;

function gor.eval;
begin
eval:=exp1^.eval(v) or exp2^.eval(v);
end;

function gor.print;
begin
print:=('('+exp1^.print+'+'+exp2^.print+')');
end;

destructor gor.done;
begin
dispose(exp1,done); dispose(exp2,done);
end;

function mkor(exp1,exp2:eptr):eptr;
var e:^gor;
begin
new(e,init(exp1,exp2));
mkor:=e;
end;

type gnot = object(expression)
exp:eptr;
function eval(v:vars):boolean; virtual;
function print:string; virtual;
constructor init(ex:eptr);
destructor done; virtual;
end;

constructor gnot.init;
begin
exp:=ex;
end;

function gnot.eval;
begin
eval:=not exp^.eval(v);
end;

function gnot.print;
begin
print:=('!('+exp^.print+')');
end;

destructor gnot.done;
begin
dispose(exp,done);
end;

function mknot(exp:eptr):eptr;
var e:^gnot;
begin
new(e,init(exp));
mknot:=e;
end;

type evar = object(expression)
n:byte;
function eval(v:vars):boolean; virtual;
function print:string; virtual;
constructor init(n1:byte);
destructor done; virtual;
end;

constructor evar.init;
begin
n:=n1;
end;

function evar.eval;
begin
eval:=v.data[n];
end;

function evar.print;
begin
print:=char(64+n);
end;

destructor evar.done;
begin
end;

function mkvar(n:byte):eptr;
var e:^evar;
begin
new(e,init(n));
mkvar:=e;
end;

type econst = object(expression)
c:boolean;
function eval(v:vars):boolean; virtual;
function print:string; virtual;
constructor init(c1:boolean);
destructor done; virtual;
end;

constructor econst.init;
begin
c:=c1;
end;

function econst.eval;
begin
eval:=c;
end;

function econst.print;
begin
if c then print:='1' else print:='0';
end;

destructor econst.done;
begin
end;

function mkconst(c:boolean):eptr;
var e:^econst;
begin
new(e,init(c));
mkconst:=e;
end;

var i:longint;
v:vars;
e:eptr;

begin
e:=mkand(mkor(mkvar(1),mknot(mkand(mkvar(2),mkvar(3)))),mknot(mkvar(4)));
clrscr;
for i:=0 to 15 do begin
v.cmb(i,4);
v.print;
write('**');
if e^.eval(v) then writeln('1') else writeln('0');
end;
writeln('F = ',e^.print);
end.

{------------------------------------------------------------------------------------------------------------------------------------------------------------CUT-HERE------------CUT-HERE--------------------------------------------------------------------------------------------------------------------------------------}

unit aeval;
{\$N+}{\$E+}
interface
function eval(ex:string):extended;

function pow(base,ex:extended):extended;

function azzeret(n:extended):extended;

function varn(n:word):string;

function varv(n:word):extended;

implementation
uses wstack;

{var vars:array[char] of extended;}
var nvars:word;
var vars:array[1..1000] of record
name:string[10];
data:extended
end;

function varn;
begin
varn:=vars[n].name;
end;

function varv;
begin
varv:=vars[n].data;
end;

function pow(base,ex:extended):extended;
begin
pow:=exp(ln(base)*ex);
end;

function azzeret(n:extended):extended;
var i:byte;
r:extended;
begin
if (n<>int(n)) or (n<0) then runerror(207);
r:=1;
for i:=2 to round(n) do begin
r:=r*i;
end;
azzeret:=r;
end;

procedure ereset;
var c:char;
begin
nvars:=2;
vars[1].name:='e';
vars[1].data:=exp(1);
vars[2].name:='pi';
vars[2].data:=pi;
{   for c:=#0 to #255 do vars[c]:=0;
vars['e']:=exp(1);
vars['1']:=1;
vars['2']:=2;
vars['3']:=3;
vars['4']:=4;
vars['5']:=5;
vars['6']:=6;
vars['7']:=7;
vars['8']:=8;
vars['9']:=9;
vars['0']:=0;}
end;

function setval(lv:string;rv:extended):extended;
var q:boolean;
w:word;
begin
q:=false;
for w:=1 to nvars do if vars[w].name=lv then begin
q:=true;
break;
end;
if not q then begin
inc(nvars);
w:=nvars;
vars[w].name:=lv;
end;
vars[w].data:=rv;
setval:=rv;
end;

function getval(s:string):extended;
var q:boolean;
w:word;
r:extended;
c:integer;

begin
q:=false;
for w:=1 to nvars do if vars[w].name=s then begin
getval:=vars[w].data;
q:=true;
end;
if not q then begin
val(s,r,c);
if c>0 then begin
getval:=0;
exit;
end;
getval:=r;
end;
end;

function eval(ex:string):extended;
var i,j:byte;
min:byte;
mpos:byte;
r:extended;
c:integer;
ex1,ex2:string;
w:word;
q:boolean;

const nop=8;

const openp='([{`';
const closp=')]}''';
oper:array[1..nop] of set of char = ([','],['='],['+'],['-'],['*'],['/'],['&'],['\$','^']);

procedure jumppara;
var s:stack;
begin
s.init;
repeat
if pos(ex[i],openp)>0 then s.push(pos(ex[i],openp));
if pos(ex[i],closp)>0 then if s.pop<>pos(ex[i],closp) then begin
runerror(255);
exit;
end;
inc(i);
until s.empty or (i>length(ex));
if not s.empty then begin
runerror(255);
exit;
end;
end;

begin
if ex='reset' then begin
ereset;
eval:=0;
exit;
end;
if ex='#' then begin
eval:=nvars;
exit;
end;
i:=2;
while i<=length(ex) do begin if ex[i]='-' then
if not (ex[i-1] in ['+','(','[','{','"','`']) then begin
ex:=copy(ex,1,i-1)+'+'+copy(ex,i,999);
inc(i);
end;
inc(i);
end;
i:=2;
while i<=length(ex) do begin if ex[i]='/' then
if not (ex[i-1] in ['*','(','[','{','"','`']) then begin
ex:=copy(ex,1,i-1)+'*'+copy(ex,i,999);
inc(i);
end;
inc(i);
end;
if copy(ex,length(ex)-1,2)='++' then begin
r:=eval(copy(ex,1,length(ex)-2));
setval(copy(ex,1,length(ex)-2),r+1);
eval:=r;
exit;
end;
if copy(ex,1,2)='++' then begin
r:=eval(copy(ex,3,999))+1;
setval(copy(ex,3,999),r);
eval:=r;
exit;
end;
if copy(ex,length(ex)-1,2)='--' then begin
r:=eval(copy(ex,1,length(ex)-2));
setval(copy(ex,1,length(ex)-2),r-1);
eval:=r;
exit;
end;
if copy(ex,1,2)='--' then begin
r:=eval(copy(ex,3,999))-1;
setval(copy(ex,3,999),r);
eval:=r;
exit;
end;
mpos:=0; min:=99;
for i:=1 to length(ex) do begin
if pos(ex[i],openp)>0 then jumppara;
if i>length(ex) then begin
i:=length(ex);
end else begin
eval:=0;
exit;
end;
for j:=1 to nop do
if (ex[i] in oper[j]) and (j<min) then begin
min:=j; mpos:=i;
end;
end;
end;
if mpos=0 then begin
if ex[length(ex)]='!' then
eval:=azzeret(eval(copy(ex,1,length(ex)-1)))
else if ex[1]='`' then
eval:=getval(copy(ex,2,length(ex)-2))
else if pos(ex[1],openp)>0 then
eval:=eval(copy(ex,2,length(ex)-2))
else if copy(ex,1,3)='sin' then
eval:=sin(eval(copy(ex,4,999)))
else if copy(ex,1,3)='cos' then
eval:=cos(eval(copy(ex,4,999)))
else if copy(ex,1,3)='tan' then
eval:=sin(eval(copy(ex,4,999)))/cos(eval(copy(ex,4,999)))
else if copy(ex,1,3)='cot' then
eval:=cos(eval(copy(ex,4,999)))/sin(eval(copy(ex,4,999)))
else if copy(ex,1,2)='ln' then
eval:=ln(eval(copy(ex,3,999)))
else if copy(ex,1,3)='log' then
eval:=ln(eval(copy(ex,4,999)))/ln(10)
else begin
eval:=getval(ex);
end;
end else begin
if ex[1]='+' then
eval:=eval(copy(ex,2,999))
else if mpos>1 then begin
ex1:=copy(ex,1,mpos-1);
ex2:=copy(ex,mpos+1,999);
case ex[mpos] of
'\$':eval:=pow(eval(ex1),eval(ex2));
'^':eval:=pow(eval(ex1),eval(ex2));
'*':eval:=eval(ex1)*eval(ex2);
'/':eval:=eval(ex1)*eval('/'+ex2);
'+':eval:=eval(ex1)+eval(ex2);
'-':eval:=eval(ex1)+eval('-'+ex2);
'&':eval:=ln(eval(ex2))/ln(eval(ex1));
',':begin r:=eval(ex1); eval:=eval(ex2); end;
'=':eval:=setval(ex1,eval(ex2));
end;
end else if ex[1]='-' then
eval:=-eval(copy(ex,2,999))
else if ex[1]='/' then
eval:=1/eval(copy(ex,2,999));
end;
end;

begin
ereset;
end.

{ALL CODE POSTED IS (c)1997 Alon Altman <alon.a@usa.net> and should not be used for commecial or shareware products.
http://members.tripod.com/~Alon_A/
}

Not the solution you were looking for? Getting a personalized solution is easy.

##### Thanks for using Experts Exchange.

• View three pieces of content (articles, solutions, posts, and videos)
• Ask the experts questions (counted toward content limit)
• Customize your dashboard and profile