Cod sursa(job #1290157)

Utilizator robert0214Dezmerean Robert robert0214 Data 10 decembrie 2014 21:23:18
Problema Cautare binara Scor 0
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..100] of longint;
Function cautbin0(var i,f:longint;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(var i,f:longint;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(var i,f:longint;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);
 h:=1;
 for i:=1 to k do
  begin
   readln(f,y,x);
   case y of
    0: writeln(g,cautbin0(h,n,x));
    1: writeln(g,cautbin1(h,n,x));
    2: writeln(g,cautbin2(h,n,x));
   end;
  end;
 close(f);
 close(g);
End.