Необходимо описать процедуру, которая преобразует дерево-формулу, заменяя в нем все поддеревья вида ((a*b)+-(c*b)) на ((a+-c)*b). Тип элементов дерева: char, т.е в формуле могут содержаться буквы(переменные)
Например:
дана формула ((5*а)+(3*а)), дерево, ей соответствующее:
--------а
----*
--------3
+
--------а
----*
--------5
На выходе должна получиться формула ((5+3)*а), и дерево:
----а
*
--------3
----+
--------5
Пока что у меня получилось написать только создание и вывод на печать этого дерева:
unit unit_tree;
interface
type tTree=^Node;
Node=Record
Info:Char;
Left,Right:tTree
end;
Procedure print_tree(root:tTree; h:integer);
{Печать дерева}
Procedure formula (var root:tTree; s:string);
{Создание дерева-формулы}
Procedure copy_tree (var root1:tTree; root:tTree);
// Procedure proizv(root:tTree; var root1:tTree);
implementation
const
Operations=['-','+','*'];
procedure print_tree;
var
i:integer;
begin
if root<>nil then
begin
print_tree (root^.Right,h+1);
for i:=1 to h do write(' ');
writeln(root^.Info);
print_tree(root^.Left,h+1)
end
end;
procedure copy_tree;
begin
if root<>nil then
begin
new (root1);
root1^.info:=root^.info;
copy_tree(root1^.Left,root^.Left);
copy_tree(root1^.Right,root^.Right)
end
else root1:=nil
end;
function prior (a:char):byte;
{Приоритет арифметической операции}
begin
case a of
'+','-': prior:=1;
'*': prior:=2
end
end;
procedure Delete_Brackets (var s:string);
{Удаление крайних скобок }
var
i,n:integer;
begin
if s[1]='(' then
begin
n:=0;
i:=2;
while (n>=0) and (i<length(s)) do
begin
if s[i]='(' then inc(n)
else if s[i]=')' then dec(n);
inc(i)
end;
if n=0 then
begin
delete(s,1,1);
delete(s,length(s),1)
end
end
end;
function Find_Root (var s:string):integer;
{Поиск позиции "корня" для каждого поддерева}
var
pr,i,n:integer;
begin
Delete_Brackets(s);
pr:=3;
Find_Root:=0;
i:=length(s);
while (i>1) and (pr>1) do
if s[i]=')' then
begin
n:=1;
while n<>0 do
begin
dec(i);
if s[i]=')' then inc(n)
else if s[i]='(' then dec(n)
end;
dec(i)
end
else
if (s[i] in Operations) and (prior(s[i])<pr) then
begin
Find_Root:=i;
pr:=prior(s[i]);
dec(i)
end
else dec(i)
end;
procedure formula;
var
n_pos:integer;
begin
n_pos:=Find_Root(s);
if n_pos<>0 then
begin
new(root);
root^.info:=s[n_pos];
formula(root^.Left,copy(s,1,n_pos-1));
formula(root^.Right,copy(s,n_pos+1,length(s)-n_pos))
end
else
begin
new(root);
root^.info:=s[1];
root^.Left:=nil;
root^.Right:=nil
end
end;
А как найти необходимое для замены поддерево, а затем его заменить, я и не знаю..
Сообщение отредактировано: redeezko -