Cod sursa(job #234934)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 22 decembrie 2008 12:06:10
Problema Cautare binara Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.58 kb
program alex;
var i,x,p,m,n,h:longint;
    v:array[1..30000]of integer;
    f,g:text;
Function BS1(a,b:integer;x:integer):integer;
var i,j,poz:integer;
begin
    i:=a; j:=b;
    poz:=-1;
    while i<=j do  begin
          m:=i+(j-i) div 2;
          if v[m]=x then begin
                              poz:=m;
                              break;
                         end
          else if x<v[m] then j:=m-1
                         else i:=m+1;
     end;
     BS1:=poz;
end;
Function BS2(a,b:integer;x:integer):integer;
var i,j,poz:integer;
begin
     i:=a; j:=b;
     poz:=0;
     while i<=j do  begin
          m:=i+(j-i) div 2;
          if v[m]<=x then begin
                          poz:=m;
                          i:=m+1;
                          end
                     else j:=m-1;
     end;
     BS2:=poz;
end;

Function BS3(a,b:integer;x:integer):integer;
var i,j,poz:integer;
begin
     i:=a; j:=b;
     poz:=b+1;
     m:=i+(j-i)div 2;
     while i<=j do  begin
          m:=i+(j-i) div 2;
          if x<=v[m]then begin
                          poz:=m;
                          j:=m-1;
                          end
                     else i:=m+1;
     end;
     BS3:=poz;
end;
Begin
assign(f,'cautbin.in');reset(f);
readln(f,n);
assign(g,'cautbin.out');rewrite(g);
for i:=1 to n do
    read(f,v[i]);
readln(f,m);
for h:=1 to m do
    begin
    readln(f,p,x);
    if p=0 then writeln(g,BS1(1,N,x))
      else if p=1 then  writeln(g,BS2(1,N,x))
                  else writeln(g,BS3(1,N,x));
    end;
close(f);close(g);
end.