Cod sursa(job #1608984)

Utilizator DoubleNyNinicu Cristian DoubleNy Data 22 februarie 2016 15:09:03
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
var n,m,i:longint;
    multime:array[1..100005] of longint;
    r,x,q:longint;

function cautarebinara(low,hight:longint):longint;
var mid,i:longint;
   found:boolean;
begin
 found:=false;
  while low<hight do
   begin

     mid:=(hight+low) div 2;
     if multime[mid]=x then begin found:= true ; while multime[mid]=x do inc(mid); dec(mid); break end;
     if multime[mid]<x then low:=mid
     else hight:=mid;
   end;
  if not(found) then cautarebinara:=-1
  else cautarebinara:=mid;

end;

function cautarebinara1(low,hight:longint):longint;
var mid,i:longint;
begin
 while low<hight do
  begin
    mid:=(hight+low) div 2;
   if multime[mid]<=x then
     begin
        if x>=multime[n] then begin mid:=n;  break end
        else begin  while multime[mid]<=x do
                    inc(mid);
                 dec(mid);
                 break
                end;
     end;
   if multime[mid]>x then hight:=mid;

  end;
  cautarebinara1:=mid;
end;


function cautarebinara2(low,hight:longint):longint;
 var mid:longint;
 begin
   while low<=hight do
    begin

     mid:=(hight+low) div 2;
     if multime[mid]>=x then begin while multime[mid]>=x do dec(mid); inc(mid); break end;
     if multime[mid]<x then low:=mid;

    end;
    cautarebinara2:=mid;


 end;

begin
    assign(input,'cautbin.in'); reset(input);
    assign(output,'cautbin.out'); rewrite(output);
    readln(input,n);
    for i:=1 to n do read(input,multime[i]);
    readln(input,m);
     for i:=1 to m do
     begin
      readln(input,q,x);
      case q of

        0: writeln(output,cautarebinara(1,n));
        1: writeln(output,cautarebinara1(1,n));
        2 :writeln(output,cautarebinara2(1,n));
      end;
     end;

    close(input);
    close(output);

end.