Cod sursa(job #1290165)

Utilizator robert0214Dezmerean Robert robert0214 Data 10 decembrie 2014 21:31:37
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.38 kb
Program cautbin;
Var f,g:text;
    n,k,x,y,i,h:longint;
    v:array[1..100000] of longint;
Function cautbin0(i,f,x:longint):longint;
 Var m:longint;
  Begin
   while (i <= f) do
    begin
     m:=(i + f) div 2;
     if (v[m] <= x) then i:=m + 1
                    else f:=m - 1;
    end;
   m:=(i + f) div 2;
   if v[m] > x then m:=m-1;
   if v[m] = x then cautbin0:=m
               else cautbin0:=-1;
  End;

Function cautbin1(i,f,x:longint):longint;
 Var m:longint;
  Begin
   while (i < f) do
    begin
     m:=(i + f) div 2;
     if (v[m] <= x) then i:=m + 1
                    else f:=m;
    end;
   m:=(i + f) div 2;
   if (v[m] > x) then m:=m-1;
   cautbin1:=m;
  End;

Function cautbin2(i,f,x:longint):longint;
 Var m:longint;
  Begin
   while (i < f) do
    begin
     m:=(i + f) div 2;
     if (v[m] < x) then i:=m + 1
                   else f:=m;
    end;
   m:=(i + f) div 2;
   if (v[m] < x) then m:=m+1;
   cautbin2:=m;
  End;

Begin{pp}
 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);
 readln(f,k);
 for i:=1 to k do
  begin
   readln(f,y,x);
   if y = 0 then writeln(g,cautbin0(1,n,x))
            else
             if y = 1 then writeln(g,cautbin1(1,n,x))
                      else writeln(g,cautbin2(1,n,x));
  end;
 close(f);
 close(g);
End.