|
type
pnode = ^node;
node = record
p,next,child:pnode;
key,d:longint;
end;
function minimum(h:pnode):pnode;
var
x,y:pnode;
min:longint;
begin
y:=nil; x:=h;
min:=maxlongint;
while x<>nil do begin
if x^.key<min then begin
min:=x^.key;
y:=x;
end;
x:=x^.next;
end;
minimum:=y;
end;
function union(h1,h2:pnode):pnode;
var
h,x,y,z,prevx,nextx:pnode;
procedure link(y,x:pnode);
begin
y^.p:=z;
y^.next:=z^.child;
z^.child:=y;
inc(z^.d);
end;
begin
h:=nil;
x:=h1 ;y:=h2; z:=h;
while (x<>nil)and(y<>nil) do begin
if x^.d<y^.d then begin
if z<>nil then z^.next:=x;
z:=x; x:=x^.next;
end else begin
if z<>nil then z^.next:=y;
z:=y; y:=y^.next;
end;
if h=nil then h:=z;
end;
while x<>nil do begin
z^.next:=x; z:=x; x:=x^.next;
end;
while y<>nil do begin
z^.next:=y; z:=y; y:=y^.next;
end;
z^.next:=nil;
if h=nil then begin
union:=h; exit;
end;
prevx:=nil;
x:=h;
nextx:=x^.next;
while nextx<>nil do begin
if (x^.d<>nextx^.d)or((nextx^.next<>nil)and(nextx^.next^.d<>x^.d))
then begin
prevx:=x; x:=nextx;
end else if x^.key<=nextx^.key then begin
x^.next:=nextx^.next;
link(nextx,x);
end else begin
if prevx=nil then h:=nextx
else prevx^.next:=nextx;
link(x,nextx);
x:=nextx;
end;
nextx:=x^.next;
end;
union:=h;
end;
procedure insert(var h:pnode;x:longint);
var
y:pnode;
begin
new(y);
with y^ do begin
p:=nil; child:=nil; next:=nil; d:=0; key:=x;
end;
h:=union(h,y);
end;
function extractmin(var h:pnode):longint;
var
prevx,nextx,prevy,x,y:pnode;
min:longint;
begin
y:=nil; x:=h; prevx:=nil;
min:=maxlongint;
while x<>nil do begin
if x^.key<min then begin
min:=x^.key;
y:=x; prevy:=prevx;
end;
prevx:=x;
x:=x^.next;
end;
extractmin:=min;
if prevy=nil then h:=y^.next
else prevy^.next:=y^.next;
x:=y^.child;
dispose(y);
if x=nil then exit;
prevx:=nil;
while x^.next<>nil do begin
x^.p:=nil;
nextx:=x^.next; x^.next:=prevx; prevx:=x; x:=nextx;
end;
h:=union(h,x);
end;
procedure decreasekey(x:pnode;key:longint);
var
y,z:pnode;
buf:longint;
begin
x^.key:=key;
y:=x; z:=y^.p;
while (z<>nil)and(y^.key<z^.key) do begin
buf:=y^.key; y^.key:=z^.key; z^.key:=buf;
y:=z;
z:=y^.p;
end;
end;
procedure delete(var h:pnode;x:pnode);
begin
decreasekey(x,-maxlongint);
extractmin(h);
end;
begin
end.
|
