Cod sursa(job #329410)

Utilizator ionutz32Ilie Ionut ionutz32 Data 6 iulie 2009 09:51:11
Problema Cautare binara Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
var v:array[1..100000] of longint;
n,i,m,nr,x,p:longint;
f,g:text;
function caut(x,p1,p2:longint):longint;
         begin
         if ((p2=p1+1) or (p1=p2)) and (x<>v[p1]) and (x<>v[p2]) then
            caut:=p1
         else
             if v[(p1+p2) div 2]=x then
                caut:=(p1+p2) div 2
             else
                 if v[(p1+p2) div 2]>x then
                    caut:=caut(x,p1,(p1+p2) div 2)
                 else
                     caut:=caut(x,(p1+p2) div 2,p2);
         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,m);
for i:=1 to m do
    begin
    readln(f,nr,x);
    p:=caut(x,1,n);
    case nr of
         0:if v[p]=x then
              begin
              repeat
                    p:=p+1;
              until (p>n) or (v[p]<>x);
              writeln(g,p-1);
              end
           else
               writeln(g,-1);
         1:if v[p]=x then
              begin
              while v[p]=x do
                    p:=p-1;
              p:=p+1;
              writeln(g,p);
              end
           else
               writeln(g,p);
         2:if v[p]=x then
              begin
              while v[p]=x do
                    p:=p+1;
              p:=p-1;
              writeln(g,p)
              end
           else
               writeln(g,p+1);
         end;
    end;
close(f);close(g);
end.