Cod sursa(job #249457)

Utilizator rendorzegAndrei Pavel rendorzeg Data 28 ianuarie 2009 15:38:40
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.12 kb
 var a:array[1..100000] of longint;
     nr,n,m,i:longint;
     k:byte;
     f,g:text;

 function cautb(st,dr:longint):longint;
 var m:longint;
     ok:boolean;
 begin
   ok:=false;
   while st<dr do
     begin
       m:=(st+dr) div 2;
       if nr=a[m] then begin
                        while nr=a[m] do m:=m+1;
                        m:=m-1;
                        ok:=true;
                        break;
                        end
       else
         if nr<a[m] then dr:=m-1
                    else st:=m+1;
     end;
   if not ok then
     if nr<a[st] then m:=st-1
                else m:=st;
   case k of
     0:if a[m]=nr then cautb:=m
                  else cautb:=-1;
     1:cautb:=m;
     2:begin
        while a[m]=nr do m:=m-1;
        cautb:=m+1;
        end;
   end;
 end;


 begin
   assign(f,'cautbin.in');
   reset(f);
   assign(g,'cautbin.out');
   rewrite(g);
   readln(f,n);
   for i:=1 to n do read(f,a[i]);
   readln(f,m);
   for i:=1 to m do
     begin
       read(f,k);
       read(f,nr);
       writeln(g,cautb(1,n));
     end;
   close(f);
   close(g);
 end.