Cod sursa(job #721629)

Utilizator ionutz32Ilie Ionut ionutz32 Data 23 martie 2012 21:44:26
Problema Statistici de ordine Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.45 kb
var v:array[0..3000001] of longint;
n,k,i,j,aux,piv:longint;
f,g:text;
bufin,bufout:array[1..65000] of byte;
function cauta2(min,max:longint):longint;
         begin
         piv:=v[random(max-min+1)+min];
         i:=min-1;
         j:=max+1;
         repeat
               repeat
                     inc(i);
               until v[i]>=piv;
               repeat
                     dec(j);
               until v[j]<=piv;
               if i<j then
                  begin
                  aux:=v[i];
                  v[i]:=v[j];
                  v[j]:=aux;
                  end
               else
                   begin
                   cauta2:=j;
                   exit;
                   end;
         until n=0;
         end;
procedure cauta(min,max:longint);
          var p:longint;
          begin
          if min<max then
             begin
             p:=cauta2(min,max);
             if k<=p then
                cauta(min,p)
             else
                 cauta(p+1,max);
             end
          else
              if (min=max) and (min=k) then
                 begin
                 writeln(g,v[k]);
                 close(f);close(g);
                 halt;
                 end;
          end;
begin
randomize;
assign(f,'sdo.in');
assign(g,'sdo.out');
reset(f);rewrite(g);
settextbuf(f,bufin);
settextbuf(g,bufout);
readln(f,n,k);
for i:=1 to n do
    read(f,v[i]);
cauta(1,n);
end.