Cod sursa(job #203360)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 15 august 2008 19:28:42
Problema Cautare binara Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.12 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:=0;b:=n;ok:=false;
while a<>b do begin
      c:=(a+b)div 2;
      if v[c]=x then begin
         ok:=true;
         while v[c]=x do inc(c);
         dec(c);
         break;
         end
         else if v[c]<x then a:=c+1
                        else b:=c;
end;
if int=0 then if ok then fct:=c
                    else fct:=-1;
if int=2 then if ok then fct:=c+1
                    else if v[c]>x then fct:=c
                                   else fct:=c+1;
if int=1 then if ok then begin
                         while v[c]=x do dec(c);
                         fct:=c;
                         end
                     else if v[c]<x then fct:=c
                                    else fct:=c-1;
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.