Дерево арифметических выражений, Преобразование строки в дерево и упрощение Опции

[cinic]

Требуется преобразовать выражение-строку в выражение-дерево, упростить дерево-выражение, раскрыть скобки по данным условиям и вывести полученное выражение на печать.

Соответственно, условия:
(a+-b)*c=(a*c)+-(b*c)
с*(a+-b)=c*a+-c*b
L(a*b)=(La+Lb)
L(a/b)=La-Lb
E(a+b)=Ea*Eb
E(a-b)=Ea/Eb
C(a+-b)=(Ca*Cb)-+(Sa*Sb)
S(a+-b)=(Sa*Sb)+-(Ca*Cb)
и так далее

Ув. гуру, подскажите, как реализовать непосредственно сокращение дерева? Зарание спасибо.

[cinic]

Прошу прощения за беспокойство , но программу я написал, вроде работает. На всякий случай, вот то, что у меня получилось:

" (Показать/Скрыть)

program ttree;
type
   tree=^sp;
   sp=record
         info:char;
         left,right:tree;
   end;

procedure copy(var t:tree; p:tree);
var k:tree;
begin
   if p=nil then t:=nil
   else begin
      new(k);
      t:=k;
      k^.info:=p^.info;
      copy(t^.left,p^.left);
      copy(t^.right,p^.right);
   end;
end;

procedure t(var f:text; var tr:tree);
var x:char;
begin
   if not eof(f) then begin
      read(f,x);
      new(tr);
      if (x in ['0'..'9','a'..'z']) and not (x in ['c','l','e','s']) then begin
         tr^.info:=x;
         tr^.left:=nil; tr^.right:=nil;
      end
      else if x='(' then begin
        t(f,tr^.left);
        read(f,x);
        tr^.info:=x;
        t(f,tr^.right);
        read(f,x);
      end
      else begin
      tr^.info:=x;
      read(f,x);
      t(f,tr^.left);
      read(f,x);
      tr^.right:=nil;
      end;
   end;
end;

procedure modifytree(var root:tree);
var
   k,q,b,p,d:tree;
   i:integer;
   a:array[1..4] of tree;
begin
   if root<>nil then
      case root^.info of
      'l':begin k:=root^.left;
         if k^.info in ['*','/'] then begin
            if k^.info='*' then root^.info:='+'
            else root^.info:='-';
            new(q);
            root^.right:=q;
            q^.info:='l';
            q^.right:=nil;
            q^.left:=k^.right;
            k^.right:=nil;
         end;
      end;
      'e':begin k:=root^.left;
         if k^.info in ['+','-'] then begin
            if k^.info='+' then root^.info:='*'
            else root^.info:='/';
            new(q);
            root^.right:=q;
            q^.info:='e';
            q^.right:=nil;
            q^.left:=k^.right;
            k^.right:=nil;
         end;
      end;
      'c':begin
         k:=root^.left;
         if k^.info in ['+','-'] then begin
            if k^.info='+' then root^.info:='-'
            else root^.info:='+';
            for i:=1 to 4 do begin
               new(a[i]);
               if i<3 then a[i]^.info:='c'
               else a[i]^.info:='s';
               a[i]^.right:=nil;
            end;
            copy(p,k^.left);
            copy(d,k^.right);
            a[1]^.left:=k^.left;
            a[2]^.left:=k^.right;
            a[3]^.left:=p;
            a[4]^.left:=d;
            k^.info:='*';
            new(b);
            root^.right:=b;
            b^.info:='*';
            k^.left:=a[1]; k^.right:=a[2];
            b^.left:=a[3]; b^.right:=a[4];
         end;
      end;
      's':begin
         k:=root^.left;
         if k^.info in ['+','-'] then begin
            if k^.info='+' then root^.info:='+'
            else root^.info:='-';
            for i:=1 to 4 do begin
               new(a[i]);
               if i in [2,3]  then a[i]^.info:='c'
               else a[i]^.info:='s';
               a[i]^.right:=nil;
            end;
            copy(p,k^.left);
            copy(d,k^.right);
            a[1]^.left:=k^.left;
            a[2]^.left:=k^.right;
            a[3]^.left:=p;
            a[4]^.left:=d;
            k^.info:='*';
            new(b);
            root^.right:=b;
            b^.info:='*';
            k^.left:=a[1];
            k^.right:=a[2];
            b^.left:=a[3];
            b^.right:=a[4];
         end;
      end;
      '*': if not (root^.right^.info in ['+','-']) and (root^.left^.info in ['+','-']) then begin
         k:=root^.left;
         p:=root^.right;
         root^.info:=k^.info;
         copy(d,p);
         new(b);
         b^.info:='*';
         b^.left:=k^.right;
         b^.right:=p;
         root^.right:=b;
         k^.info:='*';
         k^.right:=d;
      end
      else if not (root^.left^.info in ['+','-']) and (root^.right^.info in ['+','-']) then begin
         k:=root^.left;
         p:=root^.right;
         root^.info:=p^.info;
         copy(d,k);
         new(b);
         b^.info:='*';
         b^.left:=p^.right;
         b^.right:=k;
         root^.left:=b;
         p^.info:='*';
         p^.right:=d;
      end;
   end;
end;

procedure obxod(root:tree);
begin
   if root<>nil then begin
      if root^.info in ['s','c','e','l','*'] then modifytree(root);
      obxod(root^.left);
      obxod(root^.right);
   end;
end;

function pods4et(root:tree):real;
begin
   case root^.info of
      '0'..'9':pods4et:=ord(root^.info)-ord('0');
      'l':pods4et:=ln(pods4et(root^.left));
      'e':pods4et:=exp(pods4et(root^.left));
      's':pods4et:=sin(pods4et(root^.left));
      'c':pods4et:=cos(pods4et(root^.left));
      '+':pods4et:=pods4et(root^.left)+pods4et(root^.right);
      '-':pods4et:=pods4et(root^.left)-pods4et(root^.right);
      '*':pods4et:=pods4et(root^.left)*pods4et(root^.right);
      '/':pods4et:=pods4et(root^.left)/pods4et(root^.right);
   end;
end;

procedure w(root:tree);
begin
   if root<>nil then begin
      case root^.info of
         '0'..'9':write(root^.info);
         'c','e','s','l': begin
            write(root^.info,'(');
            w(root^.left);
            write(')');
         end
      else begin
         write('(');
         w(root^.left);
         write(root^.info);
         w(root^.right);
         write(')');
      end;
      end;
   end;
end;

var
   p,root,s,b:tree;
   f:text;

begin
   assign(f,'in_file.txt');
   reset(f);
   T(f,p);
   root:=p;
   obxod(p);
   writeln('preobrazowannoe wirajenie');
   w(p);
   writeln;
   write(pods4et(p):6:3);
   readln;
   close(f);
end.