Cod sursa(job #1290171)

Utilizator robert0214Dezmerean Robert robert0214 Data 10 decembrie 2014 21:41:52
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.01 kb
Var f,g:text;n,k,x,y,i:longint;v:array[1..1000] of longint;
Function cb0(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 cb0:=m else cb0:=-1;End;
Function cb1(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;
cb1:=m;End;
Function cb2(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;
cb2:=m;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);readln(f,k);
for i:=1 to k do begin readln(f,y,x);
if y = 0 then writeln(g,cb0(1,n,x));if y = 1 then writeln(g,cb1(1,n,x));if y = 2 then writeln(g,cb2(1,n,x));
end;close(f);close(g);End.