Работаю над курсовой по Фибоначиевым кучам.

← →
Druecher (2003-04-17 19:56) [0]

{Вроде все нормально, но возникает ошибка в процедуре Link}
unit FibHeap;

interface

type
pTNode = ^TNode;
TNode = record
Parent: pTNode;
Child: array of pTNode;
Left: pTNode;
Right: pTNode;
Mark: Boolean;
Key: Integer;//самый маленький ключ = -1
Degree: Word;//степень вершины
end;
THeap = class
Min: pTNode;
ColN: Word;
Trees: Word;
MarkedV: Word;
function GetLength: Word;
property RLLength: Word Read GetLength;//RootListLength
procedure Make;
procedure Add(Var Node: pTNode);
procedure Consolidate;
procedure Link(Var Node1,Node2: pTNode);
function ExtractMin: pTNode;
end;

function Union(Heap1,Heap2: THeap): THeap;

implementation

function Union(Heap1,Heap2: THeap): THeap;
Var Heap: THeap;
Tmp1,Tmp2: pTNode;
begin
Heap:=THeap.Create;
Heap.Make;
Heap.Min:=Heap1.Min;
//соединение 2-х корневых списков Н и Н2 в один
Tmp1:=Heap2.Min.Left;
Tmp2:=Heap.Min.Right;
Tmp1.Right:=Tmp2;
Tmp2.Left:=Tmp1;
Heap.Min.Right:=Heap2.Min;
Heap2.Min.Left:=Heap.Min;
//определение минимальной вершины кучи Н
if (Heap1.Min=nil) or ((Heap2.Min=nil) and
(Heap2.Min.Key<Heap1.Min.Key)) then Heap.Min:=Heap2.Min;
Heap.ColN:=Heap1.ColN+Heap2.ColN;
Heap1.Destroy;
Heap2.Destroy;
result:=Heap;
end;

procedure THeap.Make;
begin
Min:=nil; //min[H]
ColN:=0; //n[H]
Trees:=0; //t[H]
MarkedV:=0; //m[H]
end;

procedure THeap.Add(Var Node: pTNode);
Var Tmp: pTNode;
begin
if Min=nil then
begin
Node.Right:=Node;
Node.Left:=Node;
end
else
begin
Tmp:=Min.Left;
Node.Right:=Min;
Node.Left:=Tmp;
Tmp.Right:=Node;
Min.Left:=Node;
Node.Parent:=nil;
end;
if (Min=nil) or (Node.Key<Min.Key) then
Min:=Node;
inc(ColN);
end;

function THeap.ExtractMin: pTNode;
Var Tmp,Tmp1: pTNode;
i: Word;
begin
Tmp:=Min;
if Tmp<>nil then//Куча не пустая
begin
if Tmp.Child<>nil then//Вершина имеет потомков
for i:=0 to Length(Tmp^.Child)-1 do
begin
Tmp^.Child[i].Parent:=nil;
Tmp1.Parent:=nil;
Add(Tmp1);
end;
Tmp.Right.Left:=Tmp.Left;
Tmp.Left.Right:=Tmp.Right;
if Tmp=Tmp.Right then Min:=nil
else
begin
Min:=Tmp.Right;
Consolidate;
end;
dec(ColN);
end;
result:=Tmp
end;

function THeap.GetLength: Word;
Var n: word;
Tmp: pTNode;
begin
if Min=nil then result:=0
else
begin
n:=1;
Tmp:=Min;
While Tmp.Right<>Min do
begin
Tmp:=Tmp.Right;
inc(n)
end;
result:=n
end
end;

procedure THeap.Consolidate;
Var i,Dn,d: Word;
A: array of pTNode;
Tmp{x},Tmp1{y},Tmp2: pTNode;
begin
Dn:=ColN;
SetLength(A,Dn);
for i:=0 to Dn do A[i]:=nil;
Tmp:=Min;
Repeat
d:=Tmp.Degree;
While A[d]<>nil do
begin
Tmp1:=A[d];
if Tmp.Key>Tmp1.Key then
begin//обмен
Tmp2:=Tmp;
Tmp:=Tmp1;
Tmp1:=Tmp2;
end;
Link(Tmp1,Tmp);
A[d]:=Nil;
d:=d+1;
end;
A[d]:=Tmp;
Tmp:=Tmp.Right;
until Tmp.Right=Min;
Min:=nil;
for i:=0 to Dn do
if A[i]<>nil then
begin
Add(A[i]);
if (Min=nil) or(A[i].Key<Min.Key) then
Min:=A[i];
end;
end;
{$R+}
procedure THeap.Link(Var Node1,Node2: pTNode);
Var d: Word;
begin
//удаление Node1 из корневого списка кучи
Node1.Left.Right:=Node1.Right;
Node1.Right.Left:=Node1.Left;
//включение Node1 в список детей Node2
d:=Node2.Degree;
if d=0 then
begin
Node1.Right:=Node1;
Node1.Left:=Node1;
Node1.Parent:=Node2;
SetLength(Node1.Child,2);//ОШИБКА ЗДЕСЬ!!!!!!!!!!!!!!!!!!!!
Node2.Degree:=1;
end
else
begin
Node2.Child[0].Left:=Node1;
Node1.Right:=Node2.Child[0];
Node2.Child[d-1].Right :=Node1;
Node1.Left:=Node2.Child[d-1];
SetLength(Node2.Child,d+2);
Node2.Child[d+1]:=Node1;
Node2.Child[d+2]:=nil;
Node1.Parent:=Node2;
Node2.Degree:=d+1;
end;
Node1.Mark:=False;
end;

end.

← →
VD601 (2003-04-17 22:05) [1]

Какая ошибка-то?

← →
Druecher (2003-04-18 19:04) [2]

Ошибка была, Memory access violation,
отладчик встает на строке "push 0000400",
Хотя ,по моему, ее быть не должно,
это же просто изменение длинны массива.
Но я уже по другому сделал, а все равно интересно
то ли я дурак, то ли дельфа гонит.

Работаю над курсовой по Фибоначиевым кучам. Найти похожие ветки