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

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

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

 
 Ответить  Открыть новую тему 
> Левопрошитое дерево, проблемы
Jill
сообщение 1.08.2006 13:16
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 105
Пол: Женский
Реальное имя: Юлия

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


Основной принцип: левый - потомок, правый - брат.
Описание дерева:
 type
    PTree=^TTree;
    TTree=record
      LL:PTree;    {левый указатель - на потомка если True, на предка если False}
      RL:PTree;    {правый указатель - на братьев}
      Key:string;  {ключ}
      Sign:boolean; {признак существования потомков}
    end; 

Если вершины нет, то создаем ее:
 if root=NIL then begin
    new(root);
    root^.LL:=root;   {сам на себя - предков нет}
    root^.RL:=NIL;    {нет братьев}
    root^.Key:='root';
    root^.Sign:=false; {нет потомков}

Добавление... Вроде существует два варианта - либо это первый потомок, либо нет. Не выходит реализовать это условие unsure.gif
 procedure AddElem(chto:string; kuda:PTree);
begin
    new(node);
    if kuda^.Sign=false then begin
      kuda^.LL:=node;    {на сына }
      kuda^.Sign:=true;  {у kuda появился потомок}
      node^.RL:=NIL;     {у node нет братьев}
      node^.LL:=kuda;    {на отца}
      node^.Key:=chto;
      node^.Sign:=false;  {у node нет потомков}
      end
    else begin  
      node:=kuda^.LL;    {находим первого сына}
      while node^.RL<>NIL do
        begin node:=node^.RL; end;  {продвигаемся по правой ветви}
        node^.RL:=NIL;
        node^.LL:=kuda;
        node^.Key:=chto;
        node^.Sign:=false;  
      end;
end;
.
Подскажите, плз, как с этим разобраться...

Сообщение отредактировано: volvo - 3.11.2006 19:49
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 1.08.2006 16:09
Сообщение #2


Гость






Смотри, как я попробовал бы сделать:
type
  PTree=^TTree;
  TTree=record
    LL: PTree;
    RL: PTree;
    Key:string;
    Sign:boolean;
  end;

procedure Create(var root: PTree);
begin
  if root = nil then begin
    new(root);
    with root^ do begin
      LL := nil;     { <-- нет родителя - зачем присваивать себя? Работай с Nil }
      RL := nil;
      Key := 'root';
      Sign := false; { <-- нет потомков }
    end;
  end;
end;

{ Здесь: kuda описывается, как Var параметр, т.к. внутри процедуры он изменяется }
procedure AddElem(chto: string; var kuda: PTree);
var p, node: PTree;
begin
  new(node); { <-- Забрали память под новый элемент }
  if kuda^.Sign = false then begin
    { Если у элемента, к которому надо добавить новый, нет потомков }

    node^.RL := NIL; { у только что созданного элемента в любом случае нет братьев }
    node^.LL := kuda; { заполняем поле предка }
    node^.Key:=chto;
    node^.Sign:=false; { потомков у нового элемента тоже нет }

    kuda^.LL := node; { а вот у kuda появился потомок: здесь запоминаем его адрес }
    kuda^.Sign:=true; { и устанавливаем признак существования потомка }
  end
  else begin
    {
      В этом случае - у элемента, которому надо добавить новый
      уже есть потомки, так что добавляемых элемент будет братом
      последнего из них
    }

    { ищем этого брата, для чего используем новую переменную P }
    p := kuda^.LL; { это первый, "старший" из братьев }
    while p^.RL <> nil do
      p := p^.RL;
    { теперь в P хранится адрес "младшего" брата, к нему добавим еще одного }

    node^.RL:=NIL; { "младших братьев" пока нет }
    node^.LL:=kuda; { устанавливаем предка }
    node^.Key:=chto; 
    node^.Sign:=false; { потомков, естественно, тоже пока нет }

    p^.RL := node; { а вот теперь изменяем RL у БЫВШЕГО "младшего" брата }
  end;
end;
 К началу страницы 
+ Ответить 
Jill
сообщение 2.08.2006 11:34
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 105
Пол: Женский
Реальное имя: Юлия

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


Еще раз спасибо за подробные комменты smile.gif

Дописала пару процедур обработки - поиска и изменения элемента. Вроде работает, но затыкается при попытке пройтись "в глубину". Не могу понять, в чем дело... unsure.gif
function FindNode(T:PTree;ToFind:string):PTree;
begin
    If T=NIL Then Exit;
    if T^.Key=ToFind then begin FindNode:=T; exit end
      else FindNode:=NIL;
    if T^.Sign then FindNode(T^.LL,ToFind);
    if T^.RL<>NIL then FindNode(T^.RL,ToFind);
end;

procedure ChangeNode(p:PTree;ToChange:string);
var pp: PTree;
  begin
    if FindNode(p,ToChange)<>NIL then begin
    pp:=FindNode(p,ToChange);
    pp^.Key:='node7'; end
end;

Процедура вывода вроде без ошибок:
Procedure PrintDown(T:PTree;st:string);
begin
   If T = nil Then Exit;
   writeln(st+T^.key);
   if T^.Sign then PrintDown(T^.LL,St+st);
   if T^.RL<>NIL then PrintDown(T^.RL,St);
end;


Сообщение отредактировано: volvo - 3.11.2006 19:49
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 2.08.2006 17:19
Сообщение #4


Гость






Jill, ты программку-то свою приведи, как именно ты пытаешься работать с этими процедурами/функциями?

(сразу, не проверяя, могу сказать, что функция FindNode не очень мне нравится, т.к. не в каждой точке выхода она возвращает значение, а это плохо)
 К началу страницы 
+ Ответить 
Jill
сообщение 2.08.2006 17:43
Сообщение #5


Пионер
**

Группа: Пользователи
Сообщений: 105
Пол: Женский
Реальное имя: Юлия

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


Дело в том, что мне необходимо оформить работу в делфях. Как работают процедуры в паскальных набросках примитивны - просто вызов и что из этого получится. Функция FindNode необходима для поиска элемента, который надо изменить (ChangeNode) или для поиска элемента, подлежащего удалению.
Код вот (повторюсь, главная программа - примитивна - мне нужно понять):
" (Показать/Скрыть)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 2.08.2006 18:13
Сообщение #6


Гость






Как я и предполагал, функция FindNode оказалась проблемной... Я немного ее изменил, вот в таком виде она вроде работает:
function FindNode(T: PTree; ToFind: string): PTree;
var p: PTree;
begin
  FindNode := nil;
  if T = nil then exit;

  if T^.Key = ToFind then begin
    FindNode := T; exit
  end;

  if T^.Sign then begin

    p := FindNode(T^.LL, ToFind);
    FindNode := p;

    if p <> nil then exit

  end;

  FindNode := FindNode(T^.RL, ToFind);
end;


Ну, и ChangeNode заодно тоже подправить (совершенно незачем вызывать одну и ту же функцию дважды. Это, кстати, в некоторых случаях может привести к ошибкам)...
procedure ChangeNode(p: PTree; ToChange: string);
var pp: PTree;
begin
  pp := FindNode(p, ToChange);
  if pp <> nil then begin
    pp^.Key:='node7';
  end
end;
 К началу страницы 
+ Ответить 
Jill
сообщение 3.08.2006 12:11
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 105
Пол: Женский
Реальное имя: Юлия

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


Ок, с этим разобралась. Спасибо :-)
Очередные заковырки - удаление...
Удаление всего дерева расписала:
procedure DeleteTree(T:PTree);
Begin
    If T=nil Then Exit;
    if T^.Sign then DeleteTree(T^.LL);
    if T^.RL<>NIL then DeleteTree(T^.RL);
    Dispose(T);
end; 

Удаление выбранного узла (при условии, что у него нет сыновей) попыталась, но не работает sad.gif Где неверно?
 procedure DeleteNode(T:PTree;ToDel:string);
var pred,posl,pp:PTree;
begin
     pp:=FindNode(T,ToDel);      {pp указывает на выбранный узел}
      if pp<>NIL then begin       {если узел найден, то...}
       if (pp^.RL<>NIL)and(pp^.LL^.LL<>pp)then {если узел - "средний" брат}
         begin
           pred:=pp^.LL^.LL;         {находим "старшего" брата найденного узла}
             while pred^.RL<>pp do
             pred:=pred^.RL;         {продвигаемся по правой ветви пока не нашли предшествующий узел}
             posl:=pp^.RL;         {определяем последующий узел}
             pred^.RL:=posl;       {перераспределяем связи}
            dispose(pp);            {удаляем выбранный}
         end
       else
        if pp^.RL=NIL then   {если узел - "младший" брат}
         dispose(pp)
       else
        if (pp^.RL<>NIL)and(pp^.LL^.LL=pp) then   {если узел - "старший" брат}
          begin
           pred:=pp^.LL;    {отец выбранного узла}
           posl:=pp^.RL;    {следующий за выбранным брат}
           pred^.LL:=posl;  {перераспределяем связи}
           dispose(pp);
          end;
       end;
end; 

И еще. Как связать эти две процедуры, чтобы удалить узел, у которого есть сыновья/поддеревья? Удалить вместе с ними? Как? Тут я вообще сориентироваться не могу unsure.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 3.08.2006 16:34
Сообщение #8


Гость






Jill, с удалением одного элемента у тебя проблема - дело в том, что если у узла есть потомок (Sign = True), то НИГДЕ не хранится адрес предка этого узла. Смотри сама: в RL хранится указатель на "братьев", а в LL - указатель на потомка. Как найти предка?

Единственное решение, которое будет работать и для Sign = True и для Sign = False: Проходить еще раз по всему дереву, и искать узел, содержимое RL (или LL при Sign=True) которого равняется адресу элемента, который ты нашла здесь:
  pp:=FindNode(T, ToDel);
только так ты можешь гарантированно найти предка PP.
 К началу страницы 
+ Ответить 
Jill
сообщение 4.08.2006 15:35
Сообщение #9


Пионер
**

Группа: Пользователи
Сообщений: 105
Пол: Женский
Реальное имя: Юлия

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


Написала функцию поиска предыдущего элемента. Что-то длинноватая получилась, но работает:
 function FindPreceding(T,pp:PTree):PTree;   {pp - найденный узел}
var p:PTree;
begin
  FindPreceding:=nil;
  if T=nil then exit;
  if T^.RL=pp then
    begin
      FindPreceding:=T; exit;
    end;
  if (T^.Sign) and (T^.LL=pp) then
    begin
      FindPreceding:=T; exit;
    end;
  if T^.Sign then
    begin
      p:=FindPreceding(T^.LL,pp);
      FindPreceding:=p;
        if p<>NIL then exit;
    end;
  if T^.RL<>NIL then
    begin p:=FindPreceding(T^.RL,pp);
      FindPreceding:=p;
        if p<>NIL then exit;
    end;
end;  

Теперь удаление:
 procedure DeleteNode(T:PTree;ToDel:string);
var pred,posl,p:PTree;
begin
     p:=FindNode(T,ToDel);      {p указывает на выбранный узел}
      if p<>NIL then begin      {если узел найден, то...}

       if p^.LL=NIL then
          begin
            DeleteTree(p); {найденный узел - корень дерева}
            exit;
          end;

       pred:=FindPreceding(root,p);
       if p^.Sign then         {удаление поддерева без выбранного узла}
        begin
          posl:=p^.LL;         {?как быть с левым указателем?}
          DeleteTree(posl);
       end;

       if p^.RL=NIL then   {если узел не имеет "младших" братьев}
          begin
            pred^.RL:=NIL;
            dispose(p)
          end
       else
        if p^.RL<>NIL then  {если узел имеет "младшего" брата}
          begin
             if pred^.RL=p then    {если предыдуший узел - "старший" брат}
                begin
                  posl:=p^.RL;
                  pred^.RL:=posl;
                  dispose(p);
                end;
             if (pred^.Sign)and(pred^.LL=p) then   {если предыдуший узел - отец}
                begin
                  posl:=p^.RL;
                  pred^.LL:=posl;
                  dispose(p);
                end;
           end;
       end;
end;



Сообщение отредактировано: volvo - 25.11.2010 19:55
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 9.08.2006 15:23
Сообщение #10


Гость






По просьбе Jill зашел в этот топик smile.gif , и сразу вопрос на засыпку: а почему именно левопрошитое дерево? Есть какие-то преимущества его перед правопрошитым? Или перед AVL? Кстати, та структура, которую ты привела, не имеет никаких преимуществ перед N-арным деревом (когда-то было написано мной и такое, могу покопаться и найти исходники), а вот мороки с ней сама видишь, насколько больше...
 К началу страницы 
+ Ответить 

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

 

- Текстовая версия 25.07.2025 2:30
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"