# Двоичная куча на 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