Cod sursa(job #605374)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 28 iulie 2011 01:40:22
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
Program sortare_rapida;
var a,b:array[1..500000] of longint;
    i,n:longint;
    b1,b2: array[1..1 shl 17] of char;
    fi,fo:text;
procedure qsort(l,r:longint);
 var k,i,j,y:longint;
 begin
  i:=l; j:=r;
   k:=a[(l+r) div 2];
 repeat
  while a[i]<k do inc(I);
   while a[j]>k do dec(j);
 if i<=j then
              begin
               y:=a[i];
                a[i]:=a[j];
                  a[j]:=y;
                     inc(i); dec(j);
              end;
 until i>=j;
  if l<j then qsort(l,j);
   if i<r then qsort(i,r);
 end;
procedure interclasare();
var i,k,j,m,l,s,x,y:longint;
begin
  i:=1; j:=1; k:=1; m:=n div 2; l:=n-(n div 2); s:=n div 2+1;
 while (i<=m) and (j<=l) do
      begin
        if a[i]<a[s] then
            begin
                b[k]:=a[i];
                i:=i+1;
            end
        else
            begin
                b[k]:=a[s];
                inc(s);
                j:=j+1;
            end;
        k:=k+1;
     end;
 if i<=m then for x:=i to m do
      begin
        b[k]:=a[x];
        k:=k+1;
      end;
 if j<=l then for y:=j to l do
      begin
        b[k]:=a[y+n div 2];
        k:=k+1;
      end;
 end;
begin
assign(fi,'algsort.in');
 assign(fo,'algsort.out');
reset(fi);
 rewrite(fo);
settextbuf(fi,b1);
settextbuf(fo,b2);
readln(fi,n);
 for i:=1 to n do read(fi,a[i]);
  qsort(1,n div 2);
   qsort(n div 2+1,n);
    interclasare();
 for i:=1 to n do write(fo,b[i],' ');
  close(fo);
end.