Solved

Expression Tree/Binary Tree algorythm??

Posted on 1997-05-16
1
295 Views
Last Modified: 2010-04-04
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.
0
Comment
Question by:blitz051697
1 Comment
 
LVL 2

Accepted Solution

by:
alona041797 earned 100 total points
ID: 1336372
{
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;
      bad:boolean;
      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
          bad:=true;
          runerror(255);
          exit;
        end;
        inc(i);
      until s.empty or (i>length(ex));
      if not s.empty then begin
        bad:=true;
        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;
    bad:=false;
    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
        if bad then 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/
}
0

Featured Post

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

679 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