{模版}堆排序

Min-Heap.pas

const
        maxn=1000000;
var
        num,i,n:longint;
        a:array[0..maxn] of longint;
procedure swap(var a,b:longint);//交换两数
var
        c:longint;
begin
        c:=a;a:=b;b:=c;
end;
procedure up(x:longint);//上浮a[x]
var
        t:longint;
begin
        while(x>1)and(a[x]<a[x>>1])do
        begin
                swap(a[x],a[x>>1]);
                x:=x>>1;
        end;
end;
procedure insert(x:longint);//在堆中插入数x
begin
        inc(num);
        a[num]:=x;
        up(num);
end;
procedure down(x:longint);//下沉a[x]
var
        y,t:longint;
begin
        while(x<<1<=num)and(a[x]>a[x<<1])or(x<<1+1<=num)and(a[x]>a[x<<1+1])do
        begin
                y:=x<<1;
                if(y+1<=num)and(a[y+1]<a[y])then inc(y);
                swap(a[x],a[y]);
                x:=y;
        end;
end;
procedure delete(x:longint);//删除a[x]
begin
        if(a[num]>a[x])then//把a[num]移到x,再作维护
        begin
                a[x]:=a[num];
                dec(num);
                down(x);
        end
        else
        begin
                a[x]:=a[num];
                dec(num);
                up(x);
        end;
end;
begin
        readln(n);
        for i:=1 to n do
                readln(a[i]);
        num:=0;//清零堆
        for i:=1 to n do insert(a[i]);//建堆
        while(num>0)do
        begin
                writeln(a[1]);
                delete(1);//输出堆顶并删除
        end;
end.

Max-Heap.pas

const
        maxn=1000000;
var
        num,i,n:longint;
        a:array[0..maxn] of longint;
procedure swap(var a,b:longint);//交换两数
var
        c:longint;
begin
        c:=a;a:=b;b:=c;
end;
procedure up(x:longint);//上浮a[x]
var
        t:longint;
begin
        while(x>1)and(a[x]>a[x>>1])do
        begin
                swap(a[x],a[x>>1]);
                x:=x>>1;
        end;
end;
procedure insert(x:longint);//在堆中插入数x
begin
        inc(num);
        a[num]:=x;
        up(num);
end;
procedure down(x:longint);//下沉a[x]
var
        y,t:longint;
begin
        while(x<<1<=num)and(a[x]<a[x<<1])or(x<<1+1<=num)and(a[x]<a[x<<1+1])do
        begin
                y:=x<<1;
                if(y+1<=num)and(a[y+1]>a[y])then inc(y);
                swap(a[x],a[y]);
                x:=y;
        end;
end;
procedure delete(x:longint);//删除a[x]
begin
        if(a[num]<a[x])then//把a[num]移到x,再作维护
        begin
                a[x]:=a[num];
                dec(num);
                down(x);
        end
        else
        begin
                a[x]:=a[num];
                dec(num);
                up(x);
        end;
end;
begin
        readln(n);
        for i:=1 to n do
                readln(a[i]);
        num:=0;//清零堆
        for i:=1 to n do insert(a[i]);//建堆
        while(num>0)do
        begin
                writeln(a[1]);
                delete(1);//输出堆顶并删除
        end;
end.