Cod sursa(job #226913)

Utilizator johnyJohny Deep johny Data 3 decembrie 2008 07:28:17
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.49 kb
program cautabin;
var A:array[1..100000] of longint;
n,m: longint;
k,x: array[1..100] of longint;
i,j: longint;

function cb1(s,d,x:longint):longint;
var m: longint;
begin
  cb1:=-1;
  while (s<=d) do
  begin
    m:=s+(d-s) div 2;
    if A[m]>x then d:=m-1
    else
    if A[m]<x then s:=m+1
    else
    begin
      cb1:=m;
      exit;
    end;
  end;
end;

function cb2(s,d,x:longint):longint;
var m,l: longint;
begin
  l:=0;
  while (s<=d) do
  begin
    m:=s+(d-s) div 2;
    if A[m]<=x then
    begin
      l:=m;
      s:=m+1;
    end
    else d:=m-1;
  end;
  cb2:=l;
end;

function cb3(s,d,x:longint):longint;
var m,l: longint;
begin
  l:=n+1;
  while (s<=d) do
  begin
    m:=s+(d-s) div 2;
    if A[m]>=x then
    begin
      l:=m;
      d:=d-1;
    end
    else
    s:=m+1;
  end;
  cb3:=l;
end;

begin
  assign(input,'cautbin.in');
  reset(input);
  assign(output,'cautbin.out');
  rewrite(output);
  readln(n);
  for i:=1 to n do
   read(A[i]);
  readln;
  readln(m);
  for i:=1 to m div 10 do
  begin
    for j:=1 to 100 do
    readln(k[j],x[j]);

    for j:=1 to 100 do
    case k[j] of
    0: writeln(cb1(1,n,x[j]));
    1: writeln(cb2(1,n,x[j]));
    2: writeln(cb3(1,n,x[j]));
    end;
  end;

  for j:=1 to m mod 100 do
  begin
    readln(k[j],x[j]);
    case k[j] of
    0: writeln(cb1(1,n,x[j]));
    1: writeln(cb2(1,n,x[j]));
    2: writeln(cb3(1,n,x[j]));
    end;
  end;

  close(input);
  close(output);
end.