program heapsort;
const
max_Heap = 10000;
type
THeap = record
h:array [1..max_heap] of integer;
E:integer;
end;
var
Heap: theap;
i,p:integer;
procedure create_heap;
begin
heap.E:=0;
end;
procedure in_heap (A:integer);
var
cc:integer;
cur:integer;
begin
inc (heap.e);
heap.h [heap.e]:=a;
cur:=heap.e;
while (heap.h [cur]<heap.h [cur div 2]) do
begin
cc:=heap.h [cur];
heap.h [cur]:=heap.h [cur div 2];
heap.h [cur div 2]:=cc;
cur := cur div 2;
if cur = 1 then break;
end;
end;
PROCEDURE OUT_HEAP (var A:integer);
var
cc,cur,next:integer;
begin
a:=heap.h[1];
heap.h [1]:=heap.h[heap.e];
dec (heap.E);
cur:=1;
while true do
begin
if heap.h [cur*2]<heap.h [cur*2+1] then next:=cur*2 else next:=cur*2+1;
if heap.h [cur]>heap.h [next] then
begin
cc:=heap.h [cur];
heap.h [cur]:=heap.h [next];
heap.h [next]:=cc;
cur := next;
if cur * 2> heap.e then break;
end else break;
end;
end;
begin
create_heap;
for i:=1 to 1000 do
IN_heap (random (10000));
for i:=1 to 1000 do
begin
Out_heap (P);
write (p, ' ');
end;
end.
Вот, только что написал, слегка протестировал, вроди работает, адаптируй код под себя, мне просто спать уже пора, нет времени, кстати, я бы тебе посоветовал, посчитать сразу один массив с суммами, чтобы сократить количество вычислений. И не забудь указать кто код писал