Помощь - Поиск - Пользователи - Календарь
Полная версия: Копирование дерева через очередь(стек)
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi
Searcher
Условие:Дано произвольное дерево, в узлах которого запись из двух целых чисел. Создать новое
дерево, в узлах которого будет запись, состоящая из меньшего из двух чисел и его номера
(1 или 2).
Решить нерекурсивно (через стек или очередь).
Вот я кое-что сделал, но что-то не получается с процедурой копирования. Помогите, пожалуйста, разобраться.
Нажмите для просмотра прикрепленного файла
volvo
Поменяй свою реализацию CopyO вот на эту:
procedure TTree.CopyO(var T:TTree);
var
Q: TQueue;
tmp: TTree;

procedure ChangeRec(var rec:TInfo);
begin
if rec.first<=rec.second then rec.second:=1
else begin
rec.first:=rec.second;
rec.second:=2;
end;
end;

begin
q:=TQueue.Create;
q.Push(T);
while not q.isEmpty do begin
tmp := q.Pop;
if tmp.root <> nil then begin
q.Push(tmp.root.Left); q.Push(tmp.root.Right);
ChangeRec(tmp.root.info);
AddUpor(tmp.root.info);
end;
end;
end;
Понимаешь, что делается? Берешь из начала очереди элемент, и ставишь в конец очереди всех его потомков. Таким образом без рекурсии обрабатывается всё дерево.
Searcher
Цитата(volvo @ 21.01.2009 15:52) *

]Понимаешь, что делается? Берешь из начала очереди элемент, и ставишь в конец очереди всех его потомков. Таким образом без рекурсии обрабатывается всё дерево.

Ваша реализация работает несовсем как надо. Нужно чтобы ветвление полностью сохранялось как в исходном, а значения узлов менялись. В вашей реализации ветвление меняется.
volvo
Так...

0) реализация очереди никуда не годится. Она у тебя глючит по-страшному. Я сделал так:
type
TElem = TTree;

tqueueitem = class
item: telem;
next: tqueueitem;
constructor create(it: telem);
end;
TQueue=class
private
front, back: tQueueItem;
public
constructor Create;
procedure put(E: telem);
function get: telem;
function isempty: boolean;
end;
// ...
constructor tqueueitem.create(it: TTree);
begin
item := it;
next := nil;
end;

constructor TQueue.Create;
begin
front := nil; back := nil;
end;

procedure tqueue.put(E: TTree);
var p: tqueueitem;
begin
p := tqueueitem.create(E);
if isempty then begin
front := p; back := p;
end
else begin
back.next := p;
back := p;
end;
end;

function tqueue.get;
var p: tqueueitem;
begin
p := front;
front := front.next;
result := p.item;
p.Free;
end;

function TQueue.isEmpty:boolean;
begin
result := (front = nil);
end;

1) само заполнение дерева из строки можно сделать гораздо красивее:
procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
rec:Tinfo;
sl: tstringlist;
begin
Tree:=TTree.Create;
sl := tstringlist.Create;
try
sl.Delimiter := ' ';
sl.DelimitedText := StringReplace(Edit1.Text, ' ', ' ', [rfReplaceAll]);

for I := 0 to (sl.Count div 2) - 1 do begin
rec.first := strtoint(sl[2 * i]);
rec.second := strtoint(sl[2 * i + 1]);
tree.AddUpor(rec);
end;

finally
sl.Free;
end;

TreeView1.Items.Clear;
Tree.Output(TreeView1);
end;
Чувствуешь разницу?

2) немного поправим вывод дерева:
procedure TTree.Output(atw:TTreeView);
var j:integer;

procedure Print(troot: PNode; i: integer);
var
cur_elem: string;
begin
if troot = nil then exit;

cur_elem:='(' + inttostr(troot^.info.first) + ',' +
inttostr(troot^.info.second) + ')';
if i = -1 then atw.Items.Add (nil, cur_elem)
else atw.Items.AddChild(atw.Items[ i ], cur_elem);
i := atw.Items.Count - 1;

if (troot <> nil) and (troot^.left <> nil) // Вот эти проверки желательно делать всегда
then Print (troot^.left.root, i);

if (troot <> nil) and (troot^.right <> nil)
then Print (troot^.right.root, i);
end;

begin
if root <> nil then begin
j := -1;
if root <> nil then Print (root, j);
atw.FullExpand
end;
end;


3) и, собственно, основное, что ты спрашивал:
procedure TTree.CopyO(var T:TTree);
var
Q, qpr: TQueue;
tmp: TTree;

procedure ChangeRec(var rec:TInfo);
begin
if rec.first<=rec.second then rec.second:=1
else begin
rec.first:=rec.second;
rec.second:=2;
end;
end;

var
prev: Ttree;
isleft: boolean;
mytree: TTree;
begin
isleft := true;

q:=TQueue.Create; qpr := TQueue.Create;
q.put(T); qpr.Put(nil);
while not q.isEmpty do begin
tmp := q.get; prev := qpr.get;
if (tmp <> nil) and (tmp.root <> nil) then begin
q.Put(tmp.root.Left);
q.Put(tmp.root.Right);
ChangeRec(tmp.root.info);
end;

if prev = nil then begin // root node
mytree := ttree.Create;
new(myTree.root); mytree.root.info := tmp.root.info;
mytree.root.left := nil; mytree.root.Right := nil;

qpr.Put(mytree); qpr.Put(mytree);
end
else begin
if isleft then begin
prev.root.Left := TTree.Create;
new(prev.root.Left.root);
if (tmp <> nil) and (tmp.root <> nil) then prev.root.Left.root.info := tmp.root.info
else prev.root.Left.root := nil;

if (tmp <> nil) and (tmp.root <> nil) then begin
qpr.Put(prev.root.Left); qpr.Put(prev.root.Left);
end
end
else begin
prev.root.Right := TTree.Create;
new(prev.root.Right.root);
if (tmp <> nil) and (tmp.root <> nil) then prev.root.Right.root.info := tmp.root.info
else prev.root.Right.root := nil;

if (tmp <> nil) and (tmp.root <> nil) then begin
qpr.Put(prev.root.Right); qpr.Put(prev.root.Right);
end;
end;
isleft := not isleft;
end;

end;
root := mytree.root;
end;
(можно подсократить за счет добавления пары вложенных процедур, но я не думаю, что это облегчит понимание. Кроме того, надо не забывать освобождать очередь qpr, она не будет пустой после выполнения метода CopyO, добавь деструктор класса TQueue лучше всего).

Проверялось на строке
1 2 6 5 9 3 2 19 4 2 29 4 53 6 4 5 11 4 13 9
расхождений в ветвлениях не обнаружено. Тестируй...
Searcher
Большое спасибо. Разобрался.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.