Cod sursa(job #455772)

Utilizator sapiensCernov Vladimir sapiens Data 14 mai 2010 10:42:30
Problema Statistici de ordine Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 kb
Program Sdo;
 var f,g:text; i,n,k:longint;
     a:array[1..3000000]of longint;
 procedure swap (x,y:longint);
  var z:longint;
  begin
   z:=a[x]; a[x]:=a[y]; a[y]:=z;
  end;
 function partition (l,r:longint):longint;
  var u,z:longint;
  begin
   z:=l;
   swap ((l+r) div 2,r);
   for u:=l to r-1 do
     if a[u]<a[r] then begin
       swap (u,z);
       inc (z);
     end;
   swap (z,r);
   exit (z);
  end;
 procedure qsort (x,y:longint);
  var np:longint;
  begin
   if x<=y then begin
     np:=partition (x,y);
     if np=k then writeln (g,a[np]);
     if np<k then qsort (np+1,y);
     if np>k then qsort (x,np-1);
   end;
  end;
 begin
  assign (f,'sdo.in'); reset (f);
  assign (g,'sdo.out'); rewrite (g);
  readln (f,n,k);
  for i:=1 to n do read (f,a[i]);
  qsort (1,n);
  close (f); close (g);
 end.