Мішатронік

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.