Четвер, 18.04.2024, 07:39
Гость

Мішатронік

Мобільна версія | Додати у вибране  | Мій профіль | Вихід | RSS |
Меню сайту
Наше опитування
Яка мова вам ближче?
Всього відповідей: 11
Статистика

Онлайн всього: 1
Гостей: 1
Користувачів: 0


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.

 

Форма входа
Пошук
Друзі сайту
Календар
«  Квітень 2024  »
ПнВтСрЧтПтСбНд
1234567
891011121314
15161718192021
22232425262728
2930

Єдина Країна! Единая Страна!