Cod sursa(job #311701)

Utilizator stan_catalinUTCN-STAN-CATALIN-GABRIEL stan_catalin Data 3 mai 2009 22:50:12
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.87 kb
program cautare_binara;

type lung=-1..100000;
     long=-1..2*maxlongint;

var f,g:text;
    v:array[lung] of long;
    n,m,i,m1,y:lung;
    op:0..2;
    x:long;

function caut0(p,q:lung) :lung;
   var mij:lung;
   begin

      if p>q then caut0:=-1
      else
      if p=q then
         begin
            if v[p]=x then caut0:=p
            else caut0:=-1;
         end
         else
            begin

               mij:=(p+q) div 2;
               if v[mij]>x then caut0:=caut0(mij+1,q)
               else
               if v[mij]<x then caut0:=caut0(p,mij-1)
               else
               if v[mij]=x then caut0:=mij;

            end;

   end;


function caut1(p,q:lung) :lung;
   var mij:lung;
   begin

      if p>q then caut1:=p
      else
      if p=q then
         begin
            if v[p]<=x then caut1:=p
            else if v[p]>x then caut1:=p-1;
         end
         else
            begin

               mij:=(p+q) div 2;
               if v[mij]>x then caut1:=caut1(mij+1,q)
               else
               if v[mij]<x then caut1:=caut1(p,mij-1)
               else
               if v[mij]=x then caut1:=mij;

            end;

   end;






begin
   assign(f,'cautbin.in'); reset(f);
   assign(g,'cautbin.out'); rewrite(g);

   read(f,n);

   for i:=1 to n do
      read(f,v[i]);

   read(f,m);

   for m1:=1 to m do
      begin

         read(f,op,x);

         case op of

            0:begin
                 y:=caut0(1,n);
                 while v[y+1]=x do
                    y:=y+1;
                 writeln(g,y);
              end;

            1:begin
                 y:=caut1(1,n);
                 writeln(g,y);
              end;

            2:begin
                 writeln(g,y);
              end;

            end;

      end;

   close(f);
   close(g);
end.