二叉堆/Pascal

By Jollwish

var a:array[1..100000]of longint;
    i,n,nn:longint;
procedure heap(s,n:longint);
 var min,mn,tmp:longint;
 begin
  mn:=1;
  while mn<>maxlongint do
   begin
    min:=a[s];
    mn:=maxlongint;
    if s*2<=n then
     if a[s*2]<min then
      begin
       min:=a[s*2];
       mn:=s*2;
      end;
    if s*2+1<=n then
     if a[s*2+1]<min then
      begin
       min:=a[s*2+1];
       mn:=s*2+1;
      end;
    if mn<>maxlongint then
     begin
      tmp:=a[s];
      a[s]:=a[mn];
      a[mn]:=tmp;
      s:=mn;
     end;
   end;
 end;
begin
 readln(n);
 nn:=n;
 for i:=1 to n do read(a[i]);
 for i:=n div 2 downto 1 do heap(i,n);
 for i:=n downto 1 do
  begin
   write(a[1],' ');
   a[1]:=a[i];
   dec(n);
   if i>1 then heap(1,n);
  end;
end.

By clarkok

program heap_test;
type
  heap = record                         // small root heap
    h :array[1..100000] of longint;
    c :longint;
  end;
 
var
  h:heap;
  n:longint;
  t:longint;
 
procedure swap(var a,b:longint);        // 交换 a和b
var
  t:longint;
begin
    t:=a;
    a:=b;
    b:=t;
end;
 
procedure up(pos:longint);               // 向上调整位于 pos的元素 维持堆的特性
begin
  while (pos>1) and (h.h[pos]<h.h[pos shr 1]) do
    begin
      swap(h.h[pos],h.h[pos shr 1]);
      pos:=pos shr 1;
    end;
end;
 
procedure down(pos:longint);               // 向下调整位于 pos的元素
var
  i,j:longint;
begin
  i:=pos;
  if i shl 1 + 1<=h.c then
    begin
      if h.h[i shl 1] > h.h[i shl 1 + 1] then
        j:=i shl 1 + 1
      else
        j:=i shl 1;
    end
  else
  if i shl 1 <=h.c then
    j:=i shl 1
  else
    exit;
  while (h.h[j] < h.h[i]) do
    begin
      swap(h.h[i],h.h[j]);
      i:=j;
      if i shl 1 + 1<=h.c then
        begin
          if h.h[i shl 1] > h.h[i shl 1 + 1] then
            j:=i shl 1 + 1
          else
            j:=i shl 1;
        end
      else
      if i shl 1 <=h.c then
        j:=i shl 1
      else
        exit;
    end;
end;
 
procedure add(x:longint);       // 将x加入堆
begin
  inc(h.c);
  h.h[h.c]:=x;
  up(h.c);
end;
 
function del(pos:longint):longint;  // 返回 位于 pos的元素值 并将其从堆中删除
begin
  del:=h.h[pos];
  swap(h.h[pos],h.h[h.c]);
  dec(h.c);
  down(pos);
end;
 
begin
  readln(n);
  for n:= 1 to n do
    begin
        read(t);
        add(t);
    end;
 
  while h.c>0 do
    writeln(del(1));              // 朴素的堆排序
end.