Cod sursa(job #324630)

Utilizator DeadEyeNaiba Mihai Lucian DeadEye Data 16 iunie 2009 16:44:20
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 2.34 kb
var f,g:text;
    st,dr,n,i,j,x,y,m:longint;
    a:array[0..100001] of longint;
begin
    assign(f,'cautbin.in'); reset(f);
    assign(g,'cautbin.out'); rewrite(g);
    readln(f,n);
    for i:=1 to n do read(f,a[i]);
    a[n+1]:=a[n]+1;
    a[0]:=a[1]-1;
    readln(f,m);
    for i:=1 to m do
       begin
          readln(f,x,y);
          if x=0
             then
                begin
                   st:=1; dr:=n;
                   while st<=dr do
                      begin
                         m:=st+(dr-st) div 2;
                         if (a[m]=y) and (a[m+1]>y)
                            then begin writeln(g,m); break; end;
                         if (a[m]>y)
                            then dr:=m-1
                            else
                               if (a[m]<y) or ((a[m]=y) and (a[m+1]=y))
                                  then st:=m+1;
                      end;
                   if st>dr then writeln(g,'-1');
                end
             else if x=1
                then
                   begin
                      st:=1; dr:=n;
                      while st<=dr do
                      begin
                         m:=st+(dr-st) div 2;
                         if (a[m]<=y) and (a[m+1]>y)
                            then begin writeln(g,m); break; end;
                         if (a[m]>y)
                            then dr:=m-1
                            else
                               if (a[m]<y) or ((a[m]<=y) and (a[m+1]<=y))
                                  then st:=m+1;
                      end;
                   if st>dr then writeln(g,'-1');
                   end
                else
                   begin
                      st:=1; dr:=n;
                      while st<=dr do
                      begin
                         m:=st+(dr-st) div 2;
                         if (a[m]>=y) and (a[m-1]<y)
                            then begin writeln(g,m); break; end;
                         if (a[m]>y) or ((a[m]>=y) and (a[m-1]>=y))
                            then dr:=m-1
                            else
                               if a[m]<y
                                  then st:=m+1;
                      end;
                   if st>dr then writeln(g,'-1');
                   end;
       end;
    close(f); close(g);
end.