Ответ 1

Мне не удалось выяснить, что неправильно, изучив исходный код Tomes of Delphi и сравнив либо с алгоритмом, либо с другой реализацией Джулиана, сильно оптимизированной реализацией библиотеки EZDSL (таким образом, этот вопрос!), но Вместо этого я повторно выполнил Delete, и для хорошей меры также Insert, на основе примера C-код для красно-черного дерева на сайте Грамотного программирования, один из самых ярких примеров красно-черного дерева, который я нашел. (На самом деле довольно сложная задача найти ошибку, просто измельчив код и проверив, что она реализует что-то правильно, особенно если вы не полностью понимаете алгоритм. Могу сказать, у меня теперь гораздо лучшее понимание!) дерево хорошо документировано - я думаю, что Tomes of Delphi дает лучший обзор причин того, почему дерево работает так, как оно есть, но этот код является лучшим примером читаемой реализации.

Заметки об этом:

• Комментарии часто являются прямыми кавычками на странице объяснения конкретных методов.
• Достаточно легко было переносить, хотя я переместил процедурный код C в объектно-ориентированную структуру. Есть некоторые незначительные причуды, такие как дерево Bucknall, имеющее FHead node, дочерний элемент которого является корнем дерева, о котором вы должны знать при преобразовании. (Тесты часто проверялись, если родитель node был NULL в качестве способа тестирования, если node был корнем node. Я извлек эту и другую аналогичную логику для вспомогательных методов или node или древовидных методов.)
• Читатели также могут найти Eternally Confuzzled page на красно-черных деревьях. Хотя я не использовал его при написании этой реализации, я, вероятно, должен был иметь, и если в этой реализации есть ошибки, я перейду туда для понимания. Это была первая страница, которую я нашел при исследовании деревьев RB при отладке ToD, чтобы упомянуть о связи между красно-черными деревьями и 2-3-4 дерева по имени.
• Если это не ясно, этот код изменяет пример Tomes Delphi TtdBinaryTree, TtdBinarySearchTree и TtdRedBlackTree, найденный в TDBinTre.pas (source кода на странице ToD.) Чтобы использовать его, отредактируйте этот файл. Это не новая реализация, и она не завершена сама по себе. В частности, он сохраняет структуру кода ToD, такую ​​как TtdBinarySearchTree не являющийся потомком TtdBinaryTree, но владеющий им как член (т.е. Его перенос), используя FHead node вместо родителя nil для Root и т.д.
• Исходный код имеет лицензию MIT. (Сайт переходит на другую лицензию, он может быть изменен к тому моменту, когда вы его проверяете. Для будущих читателей на момент написания кода код определенно соответствовал лицензии MIT.) Я не уверен в лицензии на Tomes кода Delphi; так как он в книге алгоритмов, вероятно, разумно предположить, что вы можете его использовать - это подразумевается в справочнике, я думаю. Насколько мне известно, если вы согласны с оригинальными лицензиями, вы можете использовать его:) Пожалуйста, оставьте комментарий, если это полезно, я хотел бы знать.
• Реализация Tomes of Delphi работает путем вставки с использованием метода вставки двоичного дерева по умолчанию, а затем "продвижения" node. Логика находится в любом из этих двух мест. Эта реализация также реализует вставку, а затем переходит в ряд случаев, чтобы проверить положение и изменить его с помощью явных поворотов. Эти повороты находятся в отдельных методах (RotateLeft и RotateRight), которые я нахожу полезными - код ToD говорит о поворотах, но явно не вставляет их в отдельные именованные методы. Delete похож: он идет в несколько случаев. Каждый случай объясняется на странице и как комментарии в моем коде. Некоторые из них я назвал, но некоторые из них слишком сложны для ввода имени метода, так что это просто "случай 4", "случай 5" и т.д., С пояснениями комментариев.
• На странице также был код, чтобы проверить структуру дерева и свойства red-black. Я начал делать это как часть написания модульных тестов, но еще не полностью добавил все красно-черные ограничения дерева, и поэтому добавил этот код к дереву. Он присутствует только в сборке отладки и утверждает, что что-то не так, поэтому в модульных тестах, выполненных при отладке, будут возникать проблемы.
• Теперь дерево проходит мои модульные тесты, хотя они могут быть гораздо более обширными - я написал их, чтобы упростить отладку дерева Tomes of Delphi. Этот код не имеет никаких гарантий или гарантий. Считайте его непроверенным. Напишите тесты перед тем, как использовать их. Прокомментируйте, если вы нашли ошибку:)

На код!

Node модификации

Я добавил следующие вспомогательные методы в node, чтобы сделать код более грамотным при чтении. Например, исходный код часто тестировался, если node был левым дочерним элементом его родителя путем тестирования (слепое преобразование в Delphi и немодифицированные структуры ToD) if Node = Node.Parent.btChild[ctLeft] then..., тогда как теперь вы можете протестировать if Node.IsLeft then... и т.д. Прототипы метода в определение записи не включается для экономии места, но должно быть очевидно:)

function TtdBinTreeNode.Parent: PtdBinTreeNode;
begin
  assert(btParent <> nil, 'Parent is nil');
  Result := btParent;
end;

function TtdBinTreeNode.Grandparent: PtdBinTreeNode;
begin
  assert(btParent <> nil, 'Parent is nil');
  Result := btParent.btParent;
  assert(Result <> nil, 'Grandparent is nil - child of root node?');
end;

function TtdBinTreeNode.Sibling: PtdBinTreeNode;
begin
  assert(btParent <> nil, 'Parent is nil');
  if @Self = btParent.btChild[ctLeft] then
    Exit(btParent.btChild[ctRight])
  else
    Exit(btParent.btChild[ctLeft]);
end;

function TtdBinTreeNode.Uncle: PtdBinTreeNode;
begin
  assert(btParent <> nil, 'Parent is nil');
  // Can be nil if grandparent has only one child (children of root have no uncle)
  Result := btParent.Sibling;
end;

function TtdBinTreeNode.LeftChild: PtdBinTreeNode;
begin
  Result := btChild[ctLeft];
end;

function TtdBinTreeNode.RightChild: PtdBinTreeNode;
begin
  Result := btChild[ctRight];
end;

function TtdBinTreeNode.IsLeft: Boolean;
begin
  Result := @Self = Parent.LeftChild;
end;

function TtdBinTreeNode.IsRight: Boolean;
begin
  Result := @Self = Parent.RightChild;
end;

Я также добавил дополнительные методы, такие как существующий IsRed(), чтобы проверить, является ли он черным (IMO-код сканирует лучше, если он говорит if IsBlack(Node) не if not IsRed(Node)), и чтобы получить цвет, включая обработку nil node Обратите внимание, что они должны быть согласованными - например, IsRed возвращает false для nil node, поэтому nil node является черным (это также относится к свойствам красно-черного дерева и согласованное количество черных узлов на пути к листу.)

function IsBlack(aNode : PtdBinTreeNode) : boolean;
begin
  Result := not IsRed(aNode);
end;

function NodeColor(aNode :PtdBinTreeNode) : TtdRBColor;
begin
  if aNode = nil then Exit(rbBlack);
  Result := aNode.btColor;
end;

Проверка ограничения черного-черного цвета

Как упоминалось выше, эти методы проверяют структуру дерева и красно-черные ограничения и являются прямым переводом тех же методов в исходном коде С. Verify объявляется как встроенный, если не отлаживается в определении класса. Если не отладка, метод должен быть пустым и, мы надеемся, полностью удалим компилятор. Verify вызывается в начале и конце методов Insert и Delete, чтобы гарантировать правильность дерева до и после модификации.

procedure TtdRedBlackTree.Verify;
begin
{$ifdef DEBUG}
  VerifyNodesRedOrBlack(FBinTree.Root);
  VerifyRootIsBlack;
  // 3 is implicit
  VerifyRedBlackRelationship(FBinTree.Root);
  VerifyBlackNodeCount(FBinTree.Root);
{$endif}
end;

procedure TtdRedBlackTree.VerifyNodesRedOrBlack(const Node : PtdBinTreeNode);
begin
  // Normally implicitly ok in Delphi, due to type system - can't assign something else
  // However, node uses a union / case to write to the same value, theoretically
  // only for other tree types, so worth checking
  assert((Node.btColor = rbRed) or (Node.btColor = rbBlack));
  if Node = nil then Exit;
  VerifyNodesRedOrBlack(Node.LeftChild);
  VerifyNodesRedOrBlack(Node.RightChild);
end;

procedure TtdRedBlackTree.VerifyRootIsBlack;
begin
  assert(IsBlack(FBinTree.Root));
end;

procedure TtdRedBlackTree.VerifyRedBlackRelationship(const Node : PtdBinTreeNode);
begin
  // Every red node has two black children; or, the parent of every red node is black.
  if IsRed(Node) then begin
    assert(IsBlack(Node.LeftChild));
    assert(IsBlack(Node.RightChild));
    assert(IsBlack(Node.Parent));
  end;
  if Node = nil then Exit;
  VerifyRedBlackRelationship(Node.LeftChild);
  VerifyRedBlackRelationship(Node.RightChild);
end;

procedure VerifyBlackNodeCountHelper(const Node : PtdBinTreeNode; BlackCount : NativeInt; var PathBlackCount : NativeInt);
begin
  if IsBlack(Node) then begin
    Inc(BlackCount);
  end;

  if Node = nil then begin
    if PathBlackCount = -1 then begin
      PathBlackCount := BlackCount;
    end else begin
      assert(BlackCount = PathBlackCount);
    end;
    Exit;
  end;
  VerifyBlackNodeCountHelper(Node.LeftChild, BlackCount, PathBlackCount);
  VerifyBlackNodeCountHelper(Node.RightChild, BlackCount, PathBlackCount);
end;

procedure TtdRedBlackTree.VerifyBlackNodeCount(const Node : PtdBinTreeNode);
var
  PathBlackCount : NativeInt;
begin
  // All paths from a node to its leaves contain the same number of black nodes.
  PathBlackCount := -1;
  VerifyBlackNodeCountHelper(Node, 0, PathBlackCount);
end;

Вращения и другие полезные методы дерева

Вспомогательные методы для проверки, является ли node корнем node, чтобы установить node в качестве корня, заменить один node на другой, выполнить левое и правое вращение и следовать за деревом вниз по правым узлам к листу. Сделайте эти защищенные члены красно-черного дерева.

procedure TtdRedBlackTree.RotateLeft(Node: PtdBinTreeNode);
var
  R : PtdBinTreeNode;
begin
  R := Node.RightChild;
  ReplaceNode(Node, R);
  Node.btChild[ctRight] := R.LeftChild;
  if R.LeftChild <> nil then begin
    R.LeftChild.btParent := Node;
  end;
  R.btChild[ctLeft] := Node;
  Node.btParent := R;
end;

procedure TtdRedBlackTree.RotateRight(Node: PtdBinTreeNode);
var
  L : PtdBinTreeNode;
begin
  L := Node.LeftChild;
  ReplaceNode(Node, L);
  Node.btChild[ctLeft] := L.RightChild;
  if L.RightChild <> nil then begin
    L.RightChild.btParent := Node;
  end;
  L.btChild[ctRight] := Node;
  Node.btParent := L;
end;

procedure TtdRedBlackTree.ReplaceNode(OldNode, NewNode: PtdBinTreeNode);
begin
  if IsRoot(OldNode) then begin
    SetRoot(NewNode);
  end else begin
    if OldNode.IsLeft then begin // // Is the left child of its parent
      OldNode.Parent.btChild[ctLeft] := NewNode;
    end else begin
      OldNode.Parent.btChild[ctRight] := NewNode;
    end;
  end;
  if NewNode <> nil then begin
    newNode.btParent := OldNode.Parent;
  end;
end;

function TtdRedBlackTree.IsRoot(const Node: PtdBinTreeNode): Boolean;
begin
  Result := Node = FBinTree.Root;
end;

procedure TtdRedBlackTree.SetRoot(Node: PtdBinTreeNode);
begin
  Node.btColor := rbBlack; // Root is always black
  FBinTree.SetRoot(Node);
  Node.btParent.btColor := rbBlack; // FHead is black
end;

function TtdRedBlackTree.MaximumNode(Node: PtdBinTreeNode): PtdBinTreeNode;
begin
  assert(Node <> nil);
  while Node.RightChild <> nil do begin
    Node := Node.RightChild;
  end;
  Result := Node;
end;

Вставка и удаление

Красно-черное дерево является оберткой вокруг внутреннего дерева, FBinTree. Слишком сложным образом этот код изменяет дерево напрямую. И FBinTree, и красно-черное дерево обертки содержат счетчик FCount количества узлов, и для удаления этого очистителя я удалил TtdBinarySearchTree (предок красно-черного дерева) FCount и перенаправил Count, чтобы вернуть FBinTree.Count, т.е. спросить фактическое внутреннее дерево, используемое двоичным деревом поиска и красно-черными древовидными классами - это все, что принадлежит узлам. Я также добавил методы уведомления NodeInserted и NodeRemoved для увеличения и уменьшения количества отсчетов. Код не включен (тривиальный).

Я также извлек некоторые способы выделения node и удаления node - не вставлять и не удалять из дерева или ничего не делать с соединениями или присутствием node; они должны заботиться о создании и уничтожении самого node. Обратите внимание, что для создания node необходимо установить цвет node в красный цвет, после чего будут исправлены следующие изменения цвета. Это также гарантирует, что при освобождении node есть возможность освободить связанные с ним данные.

function TtdBinaryTree.NewNode(const Item : Pointer): PtdBinTreeNode;
begin
  {allocate a new node }
  Result := BTNodeManager.AllocNode;
  Result^.btParent := nil;
  Result^.btChild[ctLeft] := nil;
  Result^.btChild[ctRight] := nil;
  Result^.btData := Item;
  Result.btColor := rbRed; // Red initially
end;

procedure TtdBinaryTree.DisposeNode(Node: PtdBinTreeNode);
begin
  // Free whatever Data was pointing to, if necessary
  if Assigned(FDispose) then FDispose(Node.btData);
  // Free the node
  BTNodeManager.FreeNode(Node);
  // Decrement the node count
  NodeRemoved;
end;

С помощью этих дополнительных методов используйте следующий код для вставки и удаления. Код прокомментирован, но я рекомендую вам прочитать исходную страницу, а также книгу Tomes of Delphi для объяснения поворотов и различные случаи, когда тесты кода для.

Вставка

procedure TtdRedBlackTree.Insert(aItem : pointer);
var
  NewNode, Node : PtdBinTreeNode;
  Comparison : NativeInt;
begin
  Verify;
  newNode := FBinTree.NewNode(aItem);
  assert(IsRed(NewNode)); // new node is red
  if IsRoot(nil) then begin
    SetRoot(NewNode);
    NodeInserted;
  end else begin
    Node := FBinTree.Root;
    while True do begin
      Comparison := FCompare(aItem, Node.btData);
      case Comparison of
        0: begin
          // Equal: tree doesn't support duplicate values
          assert(false, 'Should not insert a duplicate item');
          FBinTree.DisposeNode(NewNode);
          Exit;
        end;
        -1: begin
          if Node.LeftChild = nil then begin
            Node.btChild[ctLeft] := NewNode;
            Break;
          end else begin
            Node := Node.LeftChild;
          end;
        end;
        else begin
          assert(Comparison = 1, 'Only -1, 0 and 1 are valid comparison values');
          if Node.RightChild = nil then begin
            Node.btChild[ctRight] := NewNode;
            Break;
          end else begin
            Node := Node.RightChild;
          end;
        end;
      end;
    end;
    NewNode.btParent := Node; // Because assigned to left or right child above
    NodeInserted; // Increment count
  end;
  InsertCase1(NewNode);
  Verify;
end;

// Node is now the root of the tree.  Node must be black; because it the only
// node, there is only one path, so the number of black nodes is ok
procedure TtdRedBlackTree.InsertCase1(Node: PtdBinTreeNode);
begin
  if not IsRoot(Node) then begin
    InsertCase2(Node);
  end else begin
    // Node is root (the less likely case)
    Node.btColor := rbBlack;
  end;
end;

// New node has a black parent: all properties ok
procedure TtdRedBlackTree.InsertCase2(Node: PtdBinTreeNode);
begin
  // If it is black, then everything ok, do nothing
  if not IsBlack(Node.Parent) then InsertCase3(Node);
end;

// More complex: uncle is red. Recolor parent and uncle black and grandparent red
// The grandparent change may break the red-black properties, so start again
// from case 1.
procedure TtdRedBlackTree.InsertCase3(Node: PtdBinTreeNode);
begin
  if IsRed(Node.Uncle) then begin
    Node.Parent.btColor := rbBlack;
    Node.Uncle.btColor := rbBlack;
    Node.Grandparent.btColor := rbRed;
    InsertCase1(Node.Grandparent);
  end else begin
    InsertCase4(Node);
  end;
end;

// "In this case, we deal with two cases that are mirror images of one another:
// - The new node is the right child of its parent and the parent is the left child
// of the grandparent. In this case we rotate left about the parent.
// - The new node is the left child of its parent and the parent is the right child
// of the grandparent. In this case we rotate right about the parent.
// Neither of these fixes the properties, but they put the tree in the correct form
// to apply case 5."
procedure TtdRedBlackTree.InsertCase4(Node: PtdBinTreeNode);
begin
  if (Node.IsRight) and (Node.Parent = Node.Grandparent.LeftChild) then begin
    RotateLeft(Node.Parent);
    Node := Node.LeftChild;
  end else if (Node.IsLeft) and (Node.Parent = Node.Grandparent.RightChild) then begin
    RotateRight(Node.Parent);
    Node := Node.RightChild;
  end;
  InsertCase5(Node);
end;

// " In this final case, we deal with two cases that are mirror images of one another:
// - The new node is the left child of its parent and the parent is the left child
// of the grandparent. In this case we rotate right about the grandparent.
// - The new node is the right child of its parent and the parent is the right child
// of the grandparent. In this case we rotate left about the grandparent.
// Now the properties are satisfied and all cases have been covered."
procedure TtdRedBlackTree.InsertCase5(Node: PtdBinTreeNode);
begin
  Node.Parent.btColor := rbBlack;
  Node.Grandparent.btColor := rbRed;
  if (Node.IsLeft) and (Node.Parent = Node.Grandparent.LeftChild) then begin
    RotateRight(Node.Grandparent);
  end else begin
    assert((Node.IsRight) and (Node.Parent = Node.Grandparent.RightChild));
    RotateLeft(Node.Grandparent);
  end;
end;

Удаление

procedure TtdRedBlackTree.Delete(aItem : pointer);
var
  Node,
  Predecessor,
  Child : PtdBinTreeNode;
begin
  Node := bstFindNodeToDelete(aItem);
  if Node = nil then begin
    assert(false, 'Node not found');
    Exit;
  end;
  if (Node.LeftChild <> nil) and (Node.RightChild <> nil) then begin
    Predecessor := MaximumNode(Node.LeftChild);
    Node.btData := aItem;
    Node := Predecessor;
  end;

  assert((Node.LeftChild = nil) or (Node.RightChild = nil));
  if Node.LeftChild = nil then
    Child := Node.RightChild
  else
    Child := Node.LeftChild;

  if IsBlack(Node) then begin
    Node.btColor := NodeColor(Child);
    DeleteCase1(Node);
  end;
  ReplaceNode(Node, Child);
  if IsRoot(Node) and (Child <> nil) then begin
    Child.btColor := rbBlack;
  end;

  FBinTree.DisposeNode(Node);

  Verify;
end;

// If Node is the root node, the deletion removes one black node from every path
// No properties violated, return
procedure TtdRedBlackTree.DeleteCase1(Node: PtdBinTreeNode);
begin
  if IsRoot(Node) then Exit;
  DeleteCase2(Node);
end;

// Node has a red sibling; swap colors, and rotate so the sibling is the parent
// of its former parent.  Continue to one of the next cases
procedure TtdRedBlackTree.DeleteCase2(Node: PtdBinTreeNode);
begin
  if IsRed(Node.Sibling) then begin
    Node.Parent.btColor := rbRed;
    Node.Sibling.btColor := rbBlack;
    if Node.IsLeft then begin
      RotateLeft(Node.Parent);
    end else begin
      RotateRight(Node.Parent);
    end;
  end;
  DeleteCase3(Node);
end;

// Node parent, sibling and sibling children are black; paint the sibling red.
// All paths through Node now have one less black node, so recursively run case 1
procedure TtdRedBlackTree.DeleteCase3(Node: PtdBinTreeNode);
begin
  if IsBlack(Node.Parent) and
     IsBlack(Node.Sibling) and
     IsBlack(Node.Sibling.LeftChild) and
     IsBlack(Node.Sibling.RightChild) then
  begin
    Node.Sibling.btColor := rbRed;
    DeleteCase1(Node.Parent);
  end else begin
    DeleteCase4(Node);
  end;
end;

// Node sibling and sibling children are black, but node parent is red.
// Swap colors of sibling and parent Node; restores the tree properties
procedure TtdRedBlackTree.DeleteCase4(Node: PtdBinTreeNode);
begin
  if IsRed(Node.Parent) and
     IsBlack(Node.Sibling) and
     IsBlack(Node.Sibling.LeftChild) and
     IsBlack(Node.Sibling.RightChild) then
  begin
    Node.Sibling.btColor := rbRed;
    Node.Parent.btColor := rbBlack;
  end else begin
    DeleteCase5(Node);
  end;
end;

// Mirror image cases: Node sibling is black, sibling left child is red,
// sibling right child is black, and Node is the left child.  Swap the colors
// of sibling and its left sibling and rotate right at S
// And vice versa: Node sibling is black, sibling right child is red, sibling's
// left child is black, and Node is the right child of its parent.  Swap the colors
// of sibling and its right sibling and rotate left at the sibling.
procedure TtdRedBlackTree.DeleteCase5(Node: PtdBinTreeNode);
begin
  if Node.IsLeft and
     IsBlack(Node.Sibling) and
     IsRed(Node.Sibling.LeftChild) and
     IsBlack(Node.Sibling.RightChild) then
  begin
    Node.Sibling.btColor := rbRed;
    Node.Sibling.LeftChild.btColor := rbBlack;
    RotateRight(Node.Sibling);
  end else if Node.IsRight and
    IsBlack(Node.Sibling) and
    IsRed(Node.Sibling.RightChild) and
    IsBlack(Node.Sibling.LeftChild) then
  begin
    Node.Sibling.btColor := rbRed;
    Node.Sibling.RightChild.btColor := rbBlack;
    RotateLeft(Node.Sibling);
  end;
  DeleteCase6(Node);
end;

// Mirror image cases:
// - "N sibling S is black, S right child is red, and N is the left child of its
// parent. We exchange the colors of N parent and sibling, make S right child
// black, then rotate left at N parent.
// - N sibling S is black, S left child is red, and N is the right child of its
// parent. We exchange the colors of N parent and sibling, make S left child
// black, then rotate right at N parent.
// This accomplishes three things at once:
// - We add a black node to all paths through N, either by adding a black S to those
// paths or by recoloring N parent black.
// - We remove a black node from all paths through S red child, either by removing
// P from those paths or by recoloring S.
// - We recolor S red child black, adding a black node back to all paths through
// S red child.
// S left child has become a child of N parent during the rotation and so is
// unaffected."
procedure TtdRedBlackTree.DeleteCase6(Node: PtdBinTreeNode);
begin
  Node.Sibling.btColor := NodeColor(Node.Parent);
  Node.Parent.btColor := rbBlack;
  if Node.IsLeft then begin
    assert(IsRed(Node.Sibling.RightChild));
    Node.Sibling.RightChild.btColor := rbBlack;
    RotateLeft(Node.Parent);
  end else begin
    assert(IsRed(Node.Sibling.LeftChild));
    Node.Sibling.LeftChild.btColor := rbBlack;
    RotateRight(Node.Parent);
  end;
end;

Заключительные заметки

• Надеюсь, это полезно! Если вы сочтете это полезным, пожалуйста, оставьте комментарий о том, как вы его использовали. Я бы очень хотел знать.
• Он поставляется без каких-либо гарантий или гарантии. Он проходит мои модульные тесты, но они могут быть более полными - все, что я могу сказать, это то, что этот код преуспевает там, где код Tomes of Delphi терпит неудачу. Кто знает, если он потерпит неудачу другими способами. Используйте на свой риск. Я рекомендую вам написать тесты для этого. Если вы нашли ошибку, прокомментируйте здесь!
• Удачи:)

Ответ 2

Bucknall пишет, что его реализация двоичного дерева использует фиктивную головку node в качестве родителя root node (чтобы избежать особых случаев). Эта головка создается в конструкторе:

  constructor TtdBinaryTree.Create
   ...
 {allocate a head node, eventually the root node of the tree will be
   its left child}
  FHead := BTNodeManager.AllocNodeClear;

и используется во время первой вставки node:

function TtdBinaryTree.InsertAt
  ...
  {if the parent node is nil, assume this is inserting the root}
  if (aParentNode = nil) then begin
    aParentNode := FHead;
    aChildType := ctLeft;
  end;

Итак, ваша ситуация "the node parent is the root node, which obviously has a nil parent itself" выглядит очень странно, если вы не переписали ключевые методы