Помощь - Поиск - Пользователи - Календарь
Полная версия: Преобразование дерева-формулы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
redeezko
Всем добрый день. Прошу помочь со следующей задачей:

Необходимо описать процедуру, которая преобразует дерево-формулу, заменяя в нем все поддеревья вида ((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;


А как найти необходимое для замены поддерево, а затем его заменить, я и не знаю..
TarasBer
Ну тупо перебором.
Сначала напиши функцию, проверяющую деревья на равенство (рекурсия).
Потом просто тупо пишешь "если в вершине плюс, в потомках умножение и правые потомки потомков совпадают или левые потомки потомков совпадают, то делаем упрощение".
redeezko
C проверкой дерева вроде бы справился, а вот преобразование и вывод на печать не получается.
TarasBer
Ну для преобразования дерева +(*ab)(*cb) надо одно из b удалить (как дерево, то есть с детьми), a, b, c запомнить, уничтожить узлы с умножением (как узлы, детей не трогать), в главной вершине заменить + на *, правого потомка сослать на b, левого потомка создать с символом +, задать ему потомков a и c.
Короче, тупая ручная работа.
Когда заставят производные автоматом считать, будет ещё круче.
redeezko
Дописал процедуру удаления дерева, и процедуру преобразования
Procedure Delete(root:tTree);
Begin
Delete(root^.Right);
Delete(root^.Left);
Dispose(root)
End;

Procedure Transformation;
Var a,b,c:char;
Begin
a:=root^.right^.left^.Info;
b:=root^.right^.right^.info;
c:=root^.left^.left^.info;
delete(root^.Left);
delete(root^.right);
root^.Info:='*';
root^.Right^.Info:=b;
root^.Left^.info:='+';
root^.left^.Right^.info:=a;
root^.Left^.left^.Info:=c
end;


Только преобразованное дерево не выводится на печать.
TarasBer
> delete(root^.Left);
delete(root^.right);

Я же сказал, их надо удалить, как узлы, а не как деревья. После такого удаления a, b, c тоже удаляются.
Замени на Dispose.

> Var a,b,c:char;

Запомни не инфо, а указатели на эти деревья.

var a: TTree;
...
a:=root^.right^.left;

И добавь удаление root^.right^.right (как дерева).

Добавлено через 1 мин.
Кстати, твоя процедура Delete виснет. Потому что у любой рекурсии должно быть условие выхода. В начало процедуры Delete допиши if root = nil then Exit;
а в конец допиши root := nil;
redeezko
Переделал:
Procedure Delete(root:tTree);
Begin
if root=nil then exit;
Delete(root^.Right);
Delete(root^.Left);
Dispose(root)
End;

Procedure Transformation;
Var a,b,c:tTree;
Begin
a:=root^.right^.left;
b:=root^.right^.right;
c:=root^.left^.left;
dispose(root^.Left);
dispose(root^.right);
delete(root^.Right^.right);
root^.Info:='*';
root^.Right:=b;
root^.Left^.Info:='+';
root^.left^.Right:=a;
root^.Left^.left:=c
end;



Но результат тот же самый. Делал трассировку. оказывается что то неверно с процедурой Delete. Программа доходит до строки Delete(root^.Right); и прерывается. Остальное все верно, так как если эту процедуру не выполнять в Transformation, то всё печатается правильно.

Добавлено через 3 мин.
дописал:
Procedure Delete(root:tTree);
Begin
if root=nil then exit;
Delete(root^.Right);
Delete(root^.Left);
Dispose(root);
root:=nil;
End;


ничего не изменилось
TarasBer
> Программа доходит до строки Delete(root^.Right); и прерывается.

Значит, у тебя ошибка при создании дерева - неиспользуемый потомок не инициализируется nilом.
А где именно - найти что-то не могу пока.

> Остальное все верно, так как если эту процедуру не выполнять в Transformation, то всё печатается правильно.

...и добрый дядя ГЦ всё подотрёт...
Ты уж доведи Delete до ума.

[offtop]
алгоритм разбора строки ужасен, но я с такого же начинал в своё время
можно вообще делать в 1 проход, на самом деле
http://algolist.manual.ru/syntax/
[/offtop]
redeezko
Ну получается до ума надо доводить не процедуру удаления, а процедуру создания дерева.. Буду пытаться это сделать.

Добавлено через 4 мин.
И спасибо за ссылку, разберусь на досуге. Но сейчас главное сделать эту задачу smile.gif

Добавлено через 3 мин.
Исправил процедуру formula, дописав две строки:
p
if n_pos<>0 then
begin
new(root);
root^.info:=s[n_pos];
root^.Left:=nil; {эта}
root^.Right:=nil; {и эта}
formula(root^.Left,copy(s,1,n_pos-1));
formula(root^.Right,copy(s,n_pos+1,length(s)-n_pos))
end



Но результата опять нет.. Хотя вроде бы теперь неипользуемые потомки должны быть Nil.
TarasBer
Может дело тут?

Procedure Delete(var root:tTree);

redeezko
Нет, не помогло.

Добавлено через 7 мин.
Сделал. Проблема оказалась совсем в другом smile.gif

dispose(root^.Left);
dispose(root^.right);
delete(root^.Right^.right);


При удалении узла, мы уже не можем перейти к потомкам, так как связь нарушена.


delete(root^.Right^.right);
dispose(root^.Left);
dispose(root^.right);

А вот так всё работает! Благодарю за помощь! smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.