Помощь - Поиск - Пользователи - Календарь
Полная версия: бинарные деревья, не рекурсивная проверка на равенство
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
compiler
Добрый день!
Вот есть такая задачка:
Цитата
10. Создайте программой два числовых двоичных дерева. Опишите рекурсивно и нерекурсивно логическую функцию, входными параметрами которой являются два дерева, проверяющую на равенство эти деревья. В программе используйте подпрограммы.

рекурсивный вариант у меня получился такой:
function equal(const tree0, tree1 :TTree ):boolean;
{ pre-order }
begin
if tree0 = tree1 then equal:=true else
if (tree0 = nil) and (tree1 <> nil) then equal:=false else
if (tree1 = nil) and (tree0 <> nil) then equal:=false else
equal:=(( tree0^.data = tree1^.data) and
equal(tree0^.left, tree1^.left) and
equal(tree0^.right, tree1^.right));
end; { equal }
, а вот нерекурсивную функцию как то не получается... поиском нашел похожую задачу ( Help Me! ) , но не понял код...
помогите пожалуйста...
в атаче моя программа целиком.
заранее благодарен.
volvo
Вот тут есть алгоритм нерекурсивного обхода в ширину: 4.5 Обходы ордерева в глубину и в ширину (с использованием очереди)... Дальше справишься?
compiler
Цитата(volvo @ 1.06.2008 16:05) *
Вот тут есть алгоритм нерекурсивного обхода в ширину: 4.5 Обходы ордерева в глубину и в ширину (с использованием очереди)... Дальше справишься?
спасибо, посмотрю.. о результатах отпишусь)
upd
а рекурсивная проверка правильно написана?
volvo
Сравни: деревья
wink.gif
compiler
Цитата(volvo @ 1.06.2008 17:01) *
Сравни: деревья wink.gif
Да.. У тебя конечно получилось красивее со сравнением с nil-ом) yes2.gif . А имеет ли смысл проверять проверять не совпадют ли у них адреса?
upd
с алгоритмом нерекурсивной проверки уже вроде разобрался, сейчас попробую "это") реализовать.
volvo
Цитата
А имеет ли смысл проверять проверять не совпадют ли у них адреса?
Хм... Ну, во-первых, адреса-то совпадать и не будут, ты ж идешь не по одному и тому же дереву, а по разным, созданным по-отдельности.

Я уж не говорю ничего о том, что наверняка сравнивать значения указателей можно только с нулем, но никак не друг с другом (я про Турбо Паскаль, мы вроде в его разделе)...
compiler
Цитата
Я уж не говорю ничего о том, что наверняка сравнивать значения указателей можно только с нулем, но никак не друг с другом (я про Турбо Паскаль, мы вроде в его разделе)...
упс.. осечка вышла.. прошу прощения..

Что-то написал, но как-то коряво оно все..
function q(const tree0, tree1 : TTree ):boolean;
var
S0, S1 : LIFO;
p0, p1 : TTree;
b : boolean;
begin
b:=true;

stack.init(S0);
stack.init(S1);

p0:=tree0;
p1:=tree1;

push(S0, p0);
push(S1, p1);

while b and not(isEmpty(S1) and isEmpty(S0) ) do begin
p0:=pop(S0);
p1:=pop(S1);
if p0^.data = p1^.data then begin
if ((p0^.left = nil) xor (p1^.left = nil)) then b:=false else
if (p0^.left <> nil) and (p1^.left <> nil) then begin
push(S1, p1^.left); push(S0, p0^.left);
end;

if b then if ((p0^.right = nil) xor (p1^.right = nil)) then b:=false else
if (p0^.right <> nil) and (p1^.right <> nil)then begin
push(S1, p1^.right); push(S0, p0^.right);
end;
end else b:=false;
end;
q:=b and isEmpty(S1) and isEmpty(S0);
stack.free(S0);
stack.free(S1);
end; { q }
вроде какие-то тесты проходит... но наверняка можно лучше....
в атаче вся программа(main.pas) и модуль(stack.pas), они реализованны еще хуже, так как писались для тестирования этой функции...
volvo
Во-первых, почему стек, а не очередь? Я ж говорил про обход в ширину...

А во-вторых, ну, кто ж тебя заставлял делать одни и те же действия 2 раза? Смотри:

Чуть-чуть меняем описание типа TTree (добавляем в него вариантные поля, чтоб можно было обращаться и по имени - Left/Right, и по индексу - where[False]/where[True]):
  TTree = ^element;
element = record
data: integer;
case boolean of
false: (left, right : TTree);
{ where[false] => left, where[true] => right }
true: (where: array[boolean] of TTree);
end;

, и теперь твоя функция сравнения элементарно переписывается вот так (функциональность полностью сохранена):
function q(const tree0, tree1: TTree): boolean;

var
S0, S1 : LIFO;
p0, p1 : TTree;

function f(index: boolean): boolean;
begin
f := true;
if (p0^.where[index] = nil) xor (p1^.where[index] = nil) then f := false
else
if (p0^.where[index] <> nil) and (p1^.where[index] <> nil) then
begin
push(S1, p1^.where[index]); push(S0, p0^.where[index]);
end;
end;

var
b: boolean;

begin
b := true;
stack.init(S0); p0:=tree0;
stack.init(S1); p1:=tree1;

push(S0, p0);
push(S1, p1);

while b and not(isEmpty(S1) and isEmpty(S0)) do begin
p0 := pop(S0);
p1 := pop(S1);

if p0^.data = p1^.data then begin
b := f(false); { left child }

if b then
b := f(true); { right child }
end
else b :=false;

end;

q := b and isEmpty(S1) and isEmpty(S0);
stack.free(S0);
stack.free(S1);
end; { q }

При желании можно еще "ужать", но я бы не стал этого делать - читабельность ухудшится.
compiler
Цитата(volvo @ 1.06.2008 20:54) *
Во-первых, почему стек, а не очередь? Я ж говорил про обход в ширину...
просто, там было как-то понятней описание..
Цитата(volvo @ 1.06.2008 20:54) *
Смотри: ...
Вот, а я думал что уже более мение в синтаксисе паскаля разбираюсь.. сейчас поужинаю и буду смотреть мануалы..

спасибо!


volvo
Цитата
там было как-то понятней описание..
blink.gif По-моему, с очередью как раз гораздо понятней... Да и реализуется просто (набирал прямо здесь, не проверяя, но по-моему не ошибся нигде, подразумеваются стандартные процедуры работы с очередью Put/Get, за тем исключением, что Put должна реализовываться так, что переданное ей значение NIL в очередь не добавляется...):

function equal(const tree0, tree1: TTree): boolean;
var
p0, p1 : TTree;
q0, q1: tqueue;
begin
equal := false;

queue.init(q0); put(q0, tree0);
queue.init(q1); put(q1, tree1);

while not is_empty(q0) do begin

p0 := get(q0); put(q0, p0^.left); put(q0, p0^.right);
if is_empty(q1) then exit;
p1 := get(q1); put(q1, p1^.left); put(q1, p1^.right);

if p0^.data <> p1^.data then exit;

end;
equal := is_empty(q1);

done(q0); done(q1);
end;
compiler
Цитата(volvo @ 1.06.2008 22:26) *
blink.gif По-моему, с очередью как раз гораздо понятней... Да и реализуется просто ...
ну.. согласен, но только после того как увидел реализацию)
спасибо

зы
а где всё таки можно посмотреть про записи, а то не могу найти необходимого?
volvo
Попробуй здесь: Записи с вариантной частью
compiler
Цитата(volvo @ 2.06.2008 14:42) *
посмотрим..
where can i buy stromectol in th
Kamagra Jelly Manufacturers
ordering hydroxychloroquine onli
Pharmacy Canadian
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.