Cod sursa(job #203479)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 16 august 2008 22:04:17
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.95 kb
{$s-}
program gaju;
var f,g:text;
    int,x,i,n,m:longint;
    v:array[1..100000]of longint;
function fct(x:longint):longint;
var a,b,c:longint;ok:boolean;
begin
a:=1;b:=n;ok:=false;
while a<b do begin
      c:=(a+b)div 2;
      if v[c]=x then begin
         while x=v[c] do inc(c);
         dec(c);
         ok:=true;
         break;
         end
      else if x<v[c] then b:=c-1
                     else a:=c+1;
end;
if not ok then if x<v[a] then c:=a-1
                         else c:=a;
if int=0 then if v[c]=x then fct:=c
                        else fct:=-1;
if int=1 then fct:=c;
if int=2 then begin
              while v[c]=x do dec(c);
              fct:=c+1;
              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);readln(f,m);
for i:=1 to m do begin
    readln(f,int,x);
    writeln(g,fct(x));
end;
close(f);close(g);
end.