Раздел «Алгоритмы».BinaryHeapPAS:

Двоичная куча на Pascal

//(C) Igor Kvasov
const
  maxsize = 1000;

var
  s:longint;
  A:array[1..maxsize] of longint;

procedure heapify(i:longint);
var
  min,l,r,buf:longint;
begin
  l:=i*2; r:=l+1;
  if (l<=s)and(A[l]<A[i]) then min:=l else min:=i;
  if (r<=s)and(A[r]<A[min])then min:=r;
  if min<>i then begin
    buf:=A[i]; A[i]:=A[min]; A[min]:=buf;
    heapify(min);
  end;
end;

procedure makeheap;
var
  i:longint;
begin
  for i:=s div 2 downto 1 do heapify(i);
end;

procedure heapsort;
var
  i,buf:longint;
begin
  makeheap;
  for i:=s downto 1 do begin
    buf:=A[1]; A[1]:=A[s]; A[s]:=buf;
    dec(s);
    heapify(1);
  end;
end;

procedure insert(x:longint);
var
  i:longint;
begin
  inc(s); i:=s;
  while (i>1)and(A[i div 2]>x) do begin
    A[i]:=A[i div 2]; i:=i div 2;
  end;
  A[i]:=x;
end;

procedure delete(i:longint);
begin
  A[i]:=A[s]; dec(s);
  heapify(i);
end;

function minimum:longint;
begin
  minimum:=A[1];
end;

function extractmin:longint;
begin
  extractmin:=minimum;
  delete(1);
end;

procedure decreasekey(i,x:longint);
begin
  while (i>1)and(A[i div 2]>x) do begin
    A[i]:=A[i div 2]; i:=i div 2;
  end;
  A[i]:=x;
end;

begin
end.

-- IgorKvasov? - 28 Dec 2004

AlgorithmClasifyForm
Type: Код
Scope: Структуры данных
Strategy:  
Complexity: Low