Arbres n-aries

Télécharger le projet
Commenter

Description

Cette unité sert à gérer les arbres n-aires, elle fournit les modules nécessaire à leur gestion (nœuds : ajout, suppression, ajout fils, suppression fils, ...; arbres : destruction, nombre de niveaux, ...)

Source / Exemple : 


unit Trees;

interface

type PNode = ^TNode;
     TNodes = array of PNode;
     TNode = record
              Value : pointer;
              Parent : PNode;
              ChildNumber : integer;
              Children : TNodes;
             end;

     TFreeValueProc = procedure(Value : pointer);

procedure Allocate(var Node : PNode);
procedure Free(var Node : PNode; FreeValueProc : TFreeValueProc);
function IsFree(Node : PNode) : boolean;
function Value(Node : PNode) : pointer;
function Parent(Node : PNode) : PNode;
function ChildNumber(Node : PNode) : integer;
function CountChildren(Node : PNode) : integer;
function ChildExists(Node : PNode; Position : integer) : boolean;
function Children(Node : PNode) : TNodes;
function Child(Node : PNode; Position : integer) : PNode;
function FindChild(Node, Child : PNode) : integer;
procedure SetValue(Node : PNode; Value : pointer);
procedure SetParent(Node, Parent : PNode);
procedure SetChildNumber(Node : PNode; ChildNumber : integer);
procedure AddChild(Node, Child : PNode);
procedure InsertChild(Node, Child : PNode; Position : integer);
procedure ReplaceChild(Node, Child : PNode; Position : integer);
procedure DeleteLastChild(Node : PNode; FreeValueProc : TFreeValueProc);
procedure DeleteChild(Node, Child : PNode; Position : integer; FreeValueProc : TFreeValueProc);
procedure DeleteChildren(Node : PNode; FreeValueProc : TFreeValueProc);

procedure AddNode(var Nodes : TNodes; Node : PNode);
procedure InsertNode(var Nodes : TNodes; Node : PNode; Position : integer);
procedure CopyNodes(Source : TNodes; var Destination : TNodes);
procedure ReplaceNode(var Nodes : TNodes; Node : PNode; Position : integer);
procedure ClearNodes(var Nodes : TNodes);
procedure DeleteLastNode(var Nodes : TNodes; FreeValueProc : TFreeValueProc);
procedure DeleteNode(var Nodes : TNodes; Position : integer; FreeValueProc : TFreeValueProc);
procedure DeleteNodes(var Nodes : TNodes; FreeValueProc : TFreeValueProc);

function TreeHeight(Tree : PNode) : integer;
procedure DestroyTree(var Tree : PNode; FreeValueProc : TFreeValueProc);

implementation

type TIntArray = array of integer;

procedure AddInt(var IntArray : TIntArray; Value : integer);
begin
 SetLength(IntArray, Length(IntArray) + 1);
 IntArray[High(IntArray)] := Value
end;

procedure QuickSort(var IntArray : TIntArray; B, E : integer);
var I, P, Mid, Aux : integer;
begin
 if E > B then
  begin
   Mid := (B + E) shr 1;
   Aux := IntArray[Mid];
   IntArray[Mid] := IntArray[B];
   IntArray[B] := Aux;
   P := B;
   for I := B + 1 to E do
    if IntArray[I] > IntArray[B] then
     begin
      Inc(P);
      Aux := IntArray[I];
      IntArray[I] := IntArray[P];
      IntArray[P] := Aux
     end;
   Aux := IntArray[P];
   IntArray[P] := IntArray[B];
   IntArray[B] := Aux;
   QuickSort(IntArray, B, P - 1);
   QuickSort(IntArray, P + 1, E)
  end
end;

procedure FreeIntArray(var IntArray : TIntArray);
begin
 SetLength(IntArray, 0);
 IntArray := nil
end;

procedure Allocate(var Node : PNode);
begin
 New(Node);
 Node^.Value := nil;
 Node^.Parent := nil;
 Node^.ChildNumber := -1;
 SetLength(Node^.Children, 0)
end;

procedure Free(var Node : PNode; FreeValueProc : TFreeValueProc);
begin
 if Assigned(FreeValueProc) then
  FreeValueProc(Node^.Value);
 SetLength(Node^.Children, 0);
 Node^.Children := nil;
 Dispose(Node)
end;

function IsFree(Node : PNode) : boolean;
begin
 Result := Assigned(Node)
end;

function Value(Node : PNode) : pointer;
begin
 Result := Node^.Value
end;

function Parent(Node : PNode) : PNode;
begin
 Result := Node^.Parent
end;

function ChildNumber(Node : PNode) : integer;
begin
 Result := Node^.ChildNumber
end;

function CountChildren(Node : PNode) : integer;
begin
 Result := Length(Node^.Children)
end;

function ChildExists(Node : PNode; Position : integer) : boolean;
begin
 Result := Position <= High(Node^.Children)
end;

function Children(Node : PNode) : TNodes;
begin
 Result := Node^.Children
end;

function Child(Node : PNode; Position : integer) : PNode;
begin
 Result := nil;
 if Position > High(Node^.Children) then
  Exit;
 Result := Node^.Children[Position]
end;

function FindChild(Node, Child : PNode) : integer;
var I : integer;
begin
 Result := -1;
 for I := 0 to High(Node^.Children) do
  if Node^.Children[I] = Child then
   begin
    Result := I;
    Exit
   end
end;

procedure SetValue(Node : PNode; Value : pointer);
begin
 Node^.Value := Value
end;

procedure SetParent(Node, Parent : PNode);
begin
 Node^.Parent := Parent
end;

procedure SetChildNumber(Node : PNode; ChildNumber : integer);
begin
 Node^.ChildNumber := ChildNumber
end;

procedure AddChild(Node, Child : PNode);
begin
 SetLength(Node^.Children, Length(Node^.Children) + 1);
 Node^.Children[High(Node^.Children)] := Child;
 Child^.ChildNumber := High(Node^.Children)
end;

procedure InsertChild(Node, Child : PNode; Position : integer);
var I : integer;
begin
 if Position > High(Node^.Children) then
  AddChild(Node, Child)
 else
  begin
   SetLength(Node^.Children, Length(Node^.Children) + 1);
   for I := High(Node^.Children) downto Position + 1 do
    Node^.Children[I] := Node^.Children[I - 1];
   Node^.Children[Position] := Child;
   Child^.ChildNumber := Position
  end
end;

procedure ReplaceChild(Node, Child : PNode; Position : integer);
begin
 if Position > High(Node^.Children) then
  Exit;
 Node^.Children[Position] := Child;
 Child^.ChildNumber := Position
end;

procedure DeleteLastChild(Node : PNode; FreeValueProc : TFreeValueProc);
begin
 if Length(Node^.Children) = 0 then
  Exit;
 Free(Node^.Children[Length(Node^.Children) - 1], FreeValueProc);
 SetLength(Node^.Children, Length(Node^.Children) - 1)
end;

procedure DeleteChild(Node, Child : PNode; Position : integer; FreeValueProc : TFreeValueProc);
var I : integer;
begin
 if Length(Node^.Children) = 0 then
  Exit;
 if Position > High(Node^.Children) then
  DeleteLastChild(Node, FreeValueProc)
 else
  begin
   Free(Node^.Children[Position], FreeValueProc);
   for I := Position to High(Node^.Children) - 1 do
    begin
     Node^.Children[I].ChildNumber := Node^.Children[I + 1].ChildNumber;
     Node^.Children[I] := Node^.Children[I + 1]
    end;
   SetLength(Node^.Children, Length(Node^.Children) - 1)
  end
end;

procedure DeleteChildren(Node : PNode; FreeValueProc : TFreeValueProc);
begin
 while Length(Node^.Children) > 0 do
  DeleteLastChild(Node, FreeValueProc);
 Node^.Children := nil
end;

procedure AddNode(var Nodes : TNodes; Node : PNode);
begin
 SetLength(Nodes, Length(Nodes) + 1);
 Nodes[High(Nodes)] := Node
end;

procedure InsertNode(var Nodes : TNodes; Node : PNode; Position : integer);
var I : integer;
begin
 if Position > High(Nodes) then
  AddNode(Nodes, Node)
 else
  begin
   SetLength(Nodes, Length(Nodes) + 1);
   for I := High(Nodes) downto Position + 1 do
    Nodes[I] := Nodes[I - 1];
   Nodes[Position] := Node
  end
end;

procedure CopyNodes(Source : TNodes; var Destination : TNodes);
begin
 Destination := Copy(Source)
end;

procedure ReplaceNode(var Nodes : TNodes; Node : PNode; Position : integer);
begin
 if Position > High(Nodes) then
  Exit;
 Nodes[Position] := Node
end;

procedure ClearNodes(var Nodes : TNodes);
begin
 SetLength(Nodes, 0);
 Nodes := nil
end;

procedure DeleteLastNode(var Nodes : TNodes; FreeValueProc : TFreeValueProc);
begin
 if Length(Nodes) = 0 then
  Exit;
 Free(Nodes[Length(Nodes) - 1], FreeValueProc);
 SetLength(Nodes, Length(Nodes) - 1)
end;

procedure DeleteNode(var Nodes : TNodes; Position : integer; FreeValueProc : TFreeValueProc);
var I : integer;
begin
 if Length(Nodes) = 0 then
  Exit;
 if Position > High(Nodes) then
  DeleteLastNode(Nodes, FreeValueProc)
 else
  begin
   Free(Nodes[Position], FreeValueProc);
   for I := Position to High(Nodes) - 1 do
    Nodes[I] := Nodes[I + 1];
   SetLength(Nodes, Length(Nodes) - 1)
  end
end;

procedure DeleteNodes(var Nodes : TNodes; FreeValueProc : TFreeValueProc);
begin
 while Length(Nodes) > 0 do
  DeleteLastNode(Nodes, FreeValueProc);
 Nodes := nil
end;

function TreeHeight(Tree : PNode) : integer;
var I : integer;
    T : TIntArray;
begin
 if Tree = nil then
  begin
   Result := 0;
   Exit;
  end;
 if CountChildren(Tree) = 0 then
  Result := 1
 else
  begin
   for I := 0 to CountChildren(Tree) - 1 do
    AddInt(T, TreeHeight(Tree.Children[I]));
   QuickSort(T, 0, CountChildren(Tree));
   Result := 1 + T[0];
   FreeIntArray(T)
  end;
end;

procedure DestroyTree(var Tree : PNode; FreeValueProc : TFreeValueProc);
var I : integer;
begin
 if Tree = nil then
  Exit;
 if CountChildren(Tree) = 0 then
  Free(Tree, FreeValueProc)
 else
  for I := 0 to CountChildren(Tree) - 1 do
   DestroyTree(Tree.Children[I], FreeValueProc)
end;

end.

Conclusion :


Cette source a besoin de modifications, corrections, ... votre aide est la bienvenue
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.