Question

请问什么是堆排序

具体该如何操作?
(pascal)

Answer 1

堆排序就是相当于一个排序二叉树，只是它是根节点的优先级别大于任何儿子的优先级别，这样可以每次删除根节点，然后调整整个堆。
program heap;
var a:array[1..10000] of integer;
n,i:integer;
procedure down(i:integer);
var x,j:integer;
begin
x:=a[i];
j:=i*2;
while j<=n do
begin
if a[j]>a[j+1] then j:=j+1；
if a[j]<x then
begin
a[i]:=a[j];
i:=j;
j:=i*2;
end else break;
end;
a[i]:=x;
end;
procedure delete(i);
begin
n:=n-1；
if (n=0)or(i=n+1) then exit
else
begin
a[i]:=a[n+1];
down(i);
end;
end;
{====main=====}
begin
readln(n);
for i:=1 to n do read(a[i]);
for i:=n div 2 downto 1 do down(i);
for i:=1 to n do
begin
write(a[1]);
delete(1);
end;
end.

{程序可能有点语法错误，全当是个程序代码}

Answer 2

我的堆排序：
program heapsort;
const max=100;
var a:array[1..max]of integer;
i,n,temp:integer;
procedure heap(nn,ii:integer);
var x,i,j:integer;
begin
i:=ii;
x:=a[ii];
j:=2*ii;
while j<=nn do begin
if (j<nn) and (a[j]<a[j+1]) then inc(j);
if x<a[j] then begin
a[i]:=a[j];
i:=j;
j:=2*i;
end
else j:=nn+1;
end;
a[i]:=x;
end;
begin
randomize;
n:=random(100);
for i:=1 to n do a[i]:=random(200);
writeln;
for i:=n div 2 downto 1 do heap(n,i);
for i:=n downto 2 do begin
temp:=a[1];
a[1]:=a[i];
a[i]:=temp;
heap(i-1,1);
end;
writeln('Output data:');
for i:=1 to n do write(a[i],' ');
writeln;
end.

堆排序

堆：设有数据元素的集合（R1,R2,R3,...Rn)它们是一棵顺序二叉树的结点且有

Ri<=R2i 和Ri<=R2i+1(或>=)

堆的性质：堆的根结点上的元素是堆中的最小元素，且堆的每一条路径上的元素都是有序的。

堆排序的思想是：

1）建初始堆（将结点[n/2],[ n/2]-1,...3,2,1分别调成堆）

2）当未排序完时

输出堆顶元素，删除堆顶元素，将剩余的元素重新建堆。

程序如下：

program duipx;
const n=8;
type arr=array[1..n] of integer;
var a:arr;i:integer;
procedure sift(var a:arr;l,m:integer);
var i,j, t:integer;
begin
i:=l;j:=2*i;t:=a[i];
while j<=m do
begin
if (j<m) and (a[j]>a[j+1]) then j:=j+1;
if t>a[j] then
begin a[i]:=a[j];i:=j;j:=2*i; end
else exit;
a[i]:=t;
end;

end;
begin
for i:=1 to n do read(a[i]);
for i:=(n div 2) downto 1 do
sift(a,i,n);
for i:=n downto 2 do
begin
write(a[1]:4);
a[1]:=a[i];
sift(a,1,i-1);
end;
writeln(a[1]:4);
end.

Answer 3

你就想像这些数据来组成一棵二叉树，其中每一个节点的左孩子比他小，有孩子比他大，这样建立一棵排序树。最后在按中序遍历一边，读一个点打印这个点的数据即可。

PS:楼上那位是哪位高人？程序貌似没错？！

Answer 4

var a:array[1..1000] of longint;
i,j,k,o,p,n,m:longint;

procedure make(i:longint);
var q,w,e:longint;
begin
if a[i*2+1]>a[i*2] then begin if a[i]<a[i*2+1] then begin o:=a[i];a[i]:=a[i*2+1];a[i*2+1]:=o;make(i*2+1);end;end
else begin if a[i]<a[i*2] then begin o:=a[i];a[i]:=a[i*2];a[i*2]:=o;make(i*2);end;end
end;

begin
read(n);
for i:=1 to n+1 do a[i]:=-maxlongint;
for i:=1 to n do read(a[i]);
for i:=n div 2 downto 1 do make(i);
p:=n;
for i:=1 to p-1 do
begin
write(a[1],' ');
a[1]:=a[n];a[n]:=-maxlongint;n:=n-1;
make(1);
end;
writeln(a[1]);
end.