Cod sursa(job #465234)

Utilizator SpiderManSimoiu Robert SpiderMan Data 23 iunie 2010 18:26:13
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 2.49 kb
program cautarebinara ;

const FIN = 'cautbin.in';
      FOU = 'cautbin.out';

var N, i, T, aux, cnt, a, val, k, l : longint ;
    V : array[1 .. 100005] of longint ;
    f, g : text ;
    x : ansistring ;

function parse ( x : ansistring ; var a : longint ) : longint ;
    var i , y : longint;
        begin
            i := a; y := 0;
            while (i <= k) do
                begin
                    if (x[i] >= '0') and (x[i] <= '9') then
                        y := y * 10 + ord(x[i]) - 48
                    else
                        begin
                            inc(i);
                            break;
                        end;
                    inc(i);
                end;
           a := i;
           parse := y;
  end;

    begin
        assign ( f, FIN ) ; reset ( f ) ;
        assign ( g, FOU ) ; rewrite ( g ) ;

        readln ( f, N ) ;

        for i := 1 to N do
            read ( f, V[i] ) ;//V[i] := parse ( x, l ) ;

        readln ( f ) ; readln ( f, T ) ;
            writeln(T);
        aux := 1 ;

        while ( aux <= N ) do
            aux := aux shl 1 ;

        while ( T <> 0 ) do
            begin
                readln ( f, x ) ; k := length ( x ) ; l := 1 ;

                a := parse ( x, l ) ; val := parse ( x, l ) ; //readln ( f, a, val ) ;

                if ( a <> 2 ) then
                    begin
                        cnt := aux; i := 0 ;

                        while ( cnt <> 0 ) do
                            begin
                                if ( i + cnt <= N ) and ( V[i + cnt] <= val ) then
                                    inc ( i, cnt ) ;
                                cnt := cnt shr 1 ;
                            end;

                        if ( a = 0 ) and ( V[i] = val ) or ( a = 1 ) then
                            writeln ( g, i )
                        else writeln ( g, '-1' ) ;
                    end
                else
                    begin
                        cnt := aux; i := 0 ;

                        while ( cnt <> 0 ) do
                            begin
                                if ( i + cnt <= N ) and ( V[i + cnt] < val ) then
                                    inc ( i, cnt ) ;
                                cnt := cnt shr 1 ;
                            end;

                       writeln ( g, i + 1 ) ;
                    end;
               dec ( T ) ;
            end;

        close ( f ) ; close ( g ) ;
    end.