Cod sursa(job #480335)

Utilizator cont_de_testeCont Teste cont_de_teste Data 27 august 2010 15:09:47
Problema Statistici de ordine Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 3.36 kb
program sdo ;

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

type vec = array[-1 .. MAX] of longint ;
     vec1 = string[255] ;

var A : vec  ;
    N, K, l, len : longint ;
    f : text ;
    x : vec1 ;
    Bufin : Array[1 .. 10000000] of byte;

    function parse ( var x : vec1 ; var a : longint ) : longint ;
    var i , y : longint;

    begin
            i := a; y := 0;

            while (i <= len) do
                begin
                    if ( x[i] >= '0' ) and ( x[i] <= '9' ) then
                        y := y * 10 + ord(x[i]) - 48
                    else
                        begin
                            if ( i = 255 ) then
                                begin
                                    a := 1 ; i := 0;
                                    read ( f, x ) ;
                                    len := length ( x ) ;
                                end ;
                            inc ( i ) ;
                            break;
                        end;

                    if ( i = 255 ) then
                         begin
                              a := 1 ; i := 0;
                              read ( f, x ) ;
                              len := length ( x ) ;
                         end ;

                    inc ( i ) ;

                end;

           a := i;
           parse := y;
    end;

    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 ) ;
           SetTextBuf ( f, Bufin ) ;
           readln ( f, N, K ) ;

           //read ( f, x ) ; len := length ( x ) ; l := 1;
           for i := 1 to N do
               read ( f, A[i] ) ;//A[i] := parse ( x, l ) ;
           close ( f ) ;
       end ;


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

       sdo ( A, 1, N, K ) ;

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