Копирование дерева через очередь(стек), Описание и процедуры в классах Опции

[Searcher]

Условие:Дано произвольное дерево, в узлах которого запись из двух целых чисел. Создать новое
дерево, в узлах которого будет запись, состоящая из меньшего из двух чисел и его номера
(1 или 2).
Решить нерекурсивно (через стек или очередь).
Вот я кое-что сделал, но что-то не получается с процедурой копирования. Помогите, пожалуйста, разобраться.
 __________________.rar ( 12.62 килобайт ) Кол-во скачиваний: 406


Сообщение отредактировано: Searcher - 21.01.2009 18:17

[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]

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

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

Сообщение отредактировано: Searcher - 21.01.2009 20:06

[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]

Большое спасибо. Разобрался.