IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Преобразование дерева-формулы
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


Всем добрый день. Прошу помочь со следующей задачей:

Необходимо описать процедуру, которая преобразует дерево-формулу, заменяя в нем все поддеревья вида ((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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


Ну тупо перебором.
Сначала напиши функцию, проверяющую деревья на равенство (рекурсия).
Потом просто тупо пишешь "если в вершине плюс, в потомках умножение и правые потомки потомков совпадают или левые потомки потомков совпадают, то делаем упрощение".


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


C проверкой дерева вроде бы справился, а вот преобразование и вывод на печать не получается.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


Ну для преобразования дерева +(*ab)(*cb) надо одно из b удалить (как дерево, то есть с детьми), a, b, c запомнить, уничтожить узлы с умножением (как узлы, детей не трогать), в главной вершине заменить + на *, правого потомка сослать на b, левого потомка создать с символом +, задать ему потомков a и c.
Короче, тупая ручная работа.
Когда заставят производные автоматом считать, будет ещё круче.


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


Дописал процедуру удаления дерева, и процедуру преобразования
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;


Только преобразованное дерево не выводится на печать.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


> 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;


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


Переделал:
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;


ничего не изменилось
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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

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

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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


Ну получается до ума надо доводить не процедуру удаления, а процедуру создания дерева.. Буду пытаться это сделать.

Добавлено через 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.

Сообщение отредактировано: redeezko -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


Может дело тут?

Procedure Delete(var root:tTree);



--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


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

Добавлено через 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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 4.05.2024 14:49
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name