Cod sursa(job #203284)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 14 august 2008 23:51:02
Problema Cautare binara Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
program caut;
var f,g:text;
    v:array[1..10000]of longint;
    n,m,i,elem:longint;
    int:byte;
function zero(elem:longint):longint;
var a,b,c:longint;
    ok:boolean;
begin
ok:=false;
a:=1;b:=n;
while a<>b do begin
      c:=(a+b) div 2;
      if elem=v[c] then begin
                        ok:=true;
                        break;
                        end
      else
      if v[c]<elem then a:=c+1
                        else b:=c;
end;
if int=0 then begin
   if ok then begin
        while v[c]=elem do inc(c);
        dec(c);
        zero:=c;
        end
        else zero:=-1;
        end else
if int=1 then begin
  if ok then begin
        while v[c]=elem do dec(c);
        zero:=c;
        end
        else if v[c]>elem then zero:=c-1
                          else zero:=c;
        end else
if int=2 then
if ok then begin
        while v[c]=elem do inc(c);
        zero:=c;
        end
        else if v[c]>elem then zero:=c
                          else zero:=c+1;
end;
begin
assign(f,'cautbin.in');
assign(g,'cautbin.out');
reset(f);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,int,elem);
    writeln(g,zero(elem));
end;
close(f);close(g);
end.