Cod sursa(job #203482)

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