Cod sursa(job #324633)

Utilizator popa.andreeaPopa Andreea Maria popa.andreea Data 16 iunie 2009 16:47:47
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.09 kb
program caut;
var p,u,m,n,caz,x,k,i:longint;
    v:array[1..100000] of longint;
    f,g:text;


procedure p0;
   begin
   p:=1;
   u:=n;
   while (p<=u) do
         begin
         m:=p+((u-p) shr 1);
         if v[m]>x then u:=m-1
                   else p:=m+1;
         end;
   if v[u]=x then writeln(g,u)
             else writeln(g,'-1');
   end;
procedure p1;
   begin
   p:=1;
   u:=n;
   while (p<=u) do
         begin
         m:=p+((u-p) shr 1);
         if v[m]>x then u:=m-1
                   else p:=m+1;
         end;
   writeln(g,u);
   end;
procedure p2;
   begin
   p:=1;
   u:=n;
   while (p<=u) do
         begin
         m:=p+((u-p) shr 1);
         if v[m]>=x then u:=m-1
                   else p:=m+1;
         end;
   writeln(g,p);
   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,k);
for i:=1 to k do
    begin
    read(f,caz,x);
    case caz of
       0:p0;
       1:p1;
       2:p2;
       end;
    end;
close(f);
close(g);
end.