Solved

Expression Tree/Binary Tree algorythm??

Posted on 1997-05-16
1
293 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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.
In this video I am going to show you how to back up and restore Office 365 mailboxes using CodeTwo Backup for Office 365. Learn more about the tool used in this video here: http://www.codetwo.com/backup-for-office-365/ (http://www.codetwo.com/ba…

813 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

12 Experts available now in Live!

Get 1:1 Help Now