Cod sursa(job #295075)

Utilizator anca.vodaAnca Voda anca.voda Data 2 aprilie 2009 23:05:57
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.54 kb
var f,g:Text;
    j,p,n,c,x,m,i,k:longint;
    a:array[1..100000]of longint;
function caut_bin(x:longint):longint;
         var s,d,mij:longint;
         begin
              s:=1;d:=n;
              while (s<=d) do
                    begin
                    mij:=s+(d-s) div 2;
                    if a[mij]=x then
                       begin d:=mij; break end
                    else if a[mij]>=x then d:=mij-1
                            else s:=mij+1;
                    end;
              caut_bin:=d
         end;


begin
assign(f,'cautbin.in');reset(f);
assign(g,'cautbin.out');rewrite(g);
readln(f,n);
for i:=1 to n do
    begin
       read(f,a[i]);
    end;
readln(f,m);
for i:=1 to m do
    begin
    read(f,c,x);
    p:=caut_bin(x);
    case c of
       0: if a[p]=x then
            begin
               j:=p;
               while (j+1<=n) and (a[j+1]=x) do inc(j);
               writeln(g,j);
             end
          else writeln(g,-1);
       1:
            begin
               j:=p;
               while (j-1>=1) and (a[j-1]=x) do dec(j);
               {if (a[p]=x) then writeln(g,j)
                  else if j>1 then writeln(g,j-1)
                          else} writeln(g,j)
            end;

       2:
            begin
               j:=p;
               while (j+1>=1) and (a[j+1]=x) do inc(j);
               if (a[p]=x) then writeln(g,j)
                  {else if j<n then writeln(g,j+1)}
                          else writeln(g,j+1)
            end
    end;
    end;
close(g);
end.