Cod sursa(job #125776)

Utilizator Data 20 ianuarie 2008 18:00:24
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.87 kb
var fi,fo:text;
    r:array[1..36000]of string[17];
    n,i,j:longint;
    c:char;
    s:string[17];
function part(st,dr:longint):longint;
var i,j,s:longint;
    aux:string;
begin
  i:=st; j:=dr; s:=-1;
  while i<j do
    begin
      if (r[i]>r[j]) then
        begin
          aux:=r[i];
          r[i]:=r[j];
          r[j]:=aux;
          s:=-s;
        end;
      if s=1 then inc(i)
             else dec(j);
    end;
  part:=i;
end;
procedure qsort(st,dr:longint);
var p:longint;
begin
  if st<dr then
    begin
      p:=part(st,dr);
      qsort(st,p-1);
      qsort(p+1,dr);
    end;
end;
begin
  assign(fi,'restante.in'); reset(fi);
  assign(fo,'restante.out'); rewrite(fo);
  readln(fi,n);
  for i:=1 to n do
    begin
      readln(fi,r[i]);
    end;

  qsort(1,n);
  for i:=1 to n do
    writeln(fo,r[i]);
  close(fi);
  close(fo);
end.