Cod sursa(job #214332)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 13 octombrie 2008 21:54:57
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 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;
  }
  case k of
   0:if v[m]=nr then binar:=m
                   else binar:=-1;
   1:binar:=m;
   2: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.