Cod sursa(job #480331)

Utilizator cont_de_testeCont Teste cont_de_teste Data 27 august 2010 14:56:32
Problema Statistici de ordine Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.99 kb
program sdo ;

const FIN = 'sdo.in' ;
      FOU = 'sdo.out' ;
      MAX = 3000000 ;

type vec = array[-1 .. MAX] of longint ;
var A : vec  ;
    N, K : longint ;
    f : text ;

    procedure change ( var i : longint ; var j : longint ) ;
        var aux : longint ;

        begin
            aux := i ;
            i := j ;
            j := aux ;
        end ;

    function parti ( var A : vec ; st : longint ; dr : longint ) : longint ;
        var i, j, piv : longint ;

        begin
            i := st - 1 ; j := dr + 1 ; piv := A [ st + random ( dr - st + 1 ) ] ;

            while ( true ) do
                begin
                    repeat
                        inc ( i ) ;
                    until A[i] >= piv ;

                    repeat
                        dec ( j ) ;
                    until A[j] <= piv ;

                    if ( i < j ) then
                        change ( A[i], A[j] )
                    else
                        begin
                            parti := j ;
                            exit ;
                        end ;
                end ;
            parti := 0 ;
        end ;

    procedure sdo ( var A : vec ; st : longint ; dr : longint ; x : longint ) ;
        var q , t : longint ;

        begin
            if ( st = dr ) then
                exit ;
            q := parti ( A, st, dr ) ;
            t := q - st + 1 ;

            if ( t >= x ) then
                sdo ( A, st, q, x )
            else
                sdo ( A, q + 1, dr, x - t ) ;
        end ;

   procedure read_data ;
       var i : longint ;

       begin
           assign ( f, FIN ) ; reset ( f ) ;
           readln ( f, N, K ) ;

           for i := 1 to N do
               read ( f, A[i] ) ;
           close ( f ) ;
       end ;


   //-----------------
   begin
       read_data ;

       sdo ( A, 1, N, K ) ;

       assign ( f, FOU ) ; rewrite ( f ) ;
       writeln ( f, A[K] ) ; close ( f ) ;
   end .