Cod sursa(job #1199093)

Utilizator cojocarugabiReality cojocarugabi Data 18 iunie 2014 09:26:53
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.96 kb
var s:array[1..500000] of longint;
  i,j:                    longint;
    n:                    longint;
    fi,fo:                   text;
    b1,b2:array [1..1 shl 15] of char;
  procedure qsort(st,dr:longint);
   var i,j,k,aux:longint;
    begin
     i:=st;
     j:=dr;
     k:=s[(i+j) div 2];
     repeat
      while (s[i]<k) do inc(i);
      while (s[j]>k) do dec(j);
      if (i<=j) then begin
                aux:=s[i];
                s[i]:=s[j];
                s[j]:=aux;
                inc(i);
                dec(j);
      end;
     until (i>=j);
     if (i<dr) then qsort(i,dr);
     if (j>st) then qsort(st,j);
    end;
      begin
       assign(fi,'algsort.in');
        assign(fo,'algsort.out');
       reset(fi); rewrite(fo);
       settextbuf(fi,b1);
       settextbuf(fi,b2);
       readln(fi,n);
       for i:=1 to n do read(fi,s[i]);
       qsort(1,n);
       for i:=1 to n do write(fo,s[i],' ');
       close(fo);
      end.