Cod sursa(job #477174)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 13 august 2010 17:59:56
Problema Statistici de ordine Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.75 kb
{$s-}
var a:array[1..3000000]of longint;
buf:array[0..102400]of byte;
n,k,i:longint;

function Select(g,h:longint):longint;
var p,pas,u,i,j,aux:longint;
begin
p:=g;
pas:=1;
while pas<=h-g+1 do begin
      u:=p+5*pas;
      i:=p;
      while u<=h do begin
            (*sortarea*)
            while i<=u-pas do begin
                  j:=i+pas;
                  while j<=u do begin
                        if a[i]>a[j] then begin
                           aux:=a[i];
                           a[i]:=a[j];
                           a[j]:=aux;
                        end;
                        j:=j+pas;
                  end;
                  i:=i+pas;
            end;
            i:=u+1;
            u:=u+5*pas;
      end;
      p:=(pas div 2)+1;
      pas:=pas*5;
end;
Select:=p;
end;

function partition(p,q:longint):longint;
var x,i,j,aux:longint;
begin
x:=a[select(p,q)];
i:=p;
j:=q;
repeat
while a[i]<x do inc(i);
while x<a[j] do dec(j);
if i<=j then begin
   aux:=a[i];
   a[i]:=a[j];
   a[j]:=aux;
   inc(i); dec(j);
end;
until i>j;
for i:=p to q do if a[i]=x then break;
partition:=i;
end;

function RandSel(p,q,i:longint):longint;
var r,k:longint;
begin
if p=q then RandSel:=a[p]
       else begin
            r:=partition(p,q);
            k:=r-p+1;
            if k=i then RandSel:=a[r]
                   else begin
                        if i<k then RandSel:=RandSel(p,r-1,i)
                               else RandSel:=RandSel(r+1,q,i-k);
                        end;
            end;
end;


begin
assign(input,'sdo.in');
reset(input);
settextbuf(input,buf);
assign(output,'sdo.out');
rewrite(output);
read(n,k);
for i:=1 to n do read(a[i]);
write(RandSel(1,n,k));
close(output);
end.