Cod sursa(job #698718)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 29 februarie 2012 15:39:03
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
program heapsort;

type heap=array[1..500000] of longint;

var  fi,fo:Text;
     h:heap;
     n,i:longint;
     bufin,bufout:array[1..65000]of char;


     function fiu_st(k:longint):longint; begin fiu_st:=k*2; end;
     function fiu_dr(k:longint):longint; begin fiu_dr:=k*2+1; end;
     procedure swap(var a,b:longint); var c:longint; begin c:=a; a:=b; b:=c; end;


  procedure insus(var h:heap; n:longint; k:longint);
  var fiu:longint;
  begin
      repeat
        fiu:=0;

        if fiu_st(k)<=n then
          begin
              fiu:=fiu_st(k);
              if (fiu_dr(k)<=n) and (h[fiu_St(k)]<h[fiu_dr(k)]) then
                fiu:=fiu_dr(k);
              if h[k]>=h[fiu] then
                fiu:=0;
          end;

        if fiu<>0 then
          begin
              swap(h[k],h[fiu]);
              k:=fiu;
          end;
      until fiu=0;
  end;

  procedure construireheap;
  var i:longint;
  begin
      for i:=n div 2 downto 1 do
        insus(h,n,i);
  end;

  procedure heapsort;
  var i:longint;
  begin
      for i:=n downto 2 do
        begin
            swap(h[1],h[i]);
            insus(h,i-1,1);
        end;
  end;

begin
    assign(fi,'algsort.in'); reset(fi);
    settextbuf(fi,bufin);
    assign(fo,'algsort.out'); rewrite(fo);
    settextbuf(fo,bufout);

      readln(fi,n);
      for i:=1 to n do
        read(fi,h[i]);
      construireheap;
      heapsort;

        for i:=1 to n do
        write(fo,h[i],' ');

    close(Fi); close(Fo);
end.