Solved

Expression Tree/Binary Tree algorythm??

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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

760 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

26 Experts available now in Live!

Get 1:1 Help Now