Cod sursa(job #214329)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 13 octombrie 2008 21:43:42
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.13 kb
    var v:array[1..100000] of longint;  
        nr,n,m,i:longint;  
       k:byte;  
       f,g:text;  
      
    function binar(a,b:longint):longint;  
    var m:longint; ok:boolean;  
    begin  
      ok:=false;  
     while a<b do  
       begin  
        m:=(a+b) div 2;  
         if nr=v[m] then begin while nr=v[m] do inc(m); dec(m); ok:=true; break; end  
         else  
           if nr<v[m] then b:=m-1  
                      else a:=m+1;  
       end;  
     if not ok then  
       if nr<v[a] then m:=a-1  
                  else m:=a;  
     if k=0 then begin 
       if v[m]=nr then binar:=m  
                    else binar:=-1;end  
       else if k=1 then binar:=m;  
       else begin while v[m]=nr do dec(m); binar:=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,v[i]);  
     readln(f,m);  
     for i:=1 to m do  
      begin  
        readln(f,k,nr);  
         writeln(g,binar(1,n));  
       end;  
     close(f);  
     close(g);  
  end.