Cod sursa(job #1231736)

Utilizator valen.valentinValentin Valeanu valen.valentin Data 21 septembrie 2014 14:08:03
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.12 kb
program cautbin;
type
tabel=array[0..100001] of longint;
tab=array[0..1 shl 17] of char;
var
t:tabel;
n,m,i,j,k,x:longint;
f1,f2:text;
function c1(x:longint):longint;
var
sol,s,d,m:longint;
begin
sol:=-1; s:=1; d:=n; m:=0;
while (s<=d) do begin
m:=(s+d) div 2;
if t[m]=x then begin
sol:=m;
s:=m+1;
end else
if t[m]>x then d:=m-1 else
s:=m+1;
end;
c1:=sol;
end;
function c2(x:longint):longint;
var
sol,s,d,m:longint;
begin
sol:=-1; s:=1; d:=n;
while (s<=d) do begin
m:=(s+d) div 2;
if t[m]<=x then begin
sol:=m;
s:=m+1;
end else
d:=m-1;
end;
c2:=sol;
end;
function c3(x:longint):longint;
var
sol,s,d,m:longint;
begin
sol:=-1; s:=1; d:=n;
while (s<=d) do begin
m:=(s+d) div 2;
if t[m]>=x then begin
sol:=m;
d:=m-1;
end else
s:=m+1;
end;
c3:=sol;
end;
begin
assign (f1,'cautbin.in');
assign (f2,'cautbin.out');
reset (f1);
rewrite (f2);
readln (f1,n);
for i:=1 to n do read(f1,t[i]);
readln (f1,m);
for i:=1 to m do begin
readln (f1,k,x);
if k=0 then writeln (f2,c1(x)) else
if k=1 then writeln (f2,c2(x)) else
if k=2 then writeln (f2,c3(x));
end ;
close (f1);
close (f2);
end.