Cod sursa(job #294850)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 2 aprilie 2009 20:02:09
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.68 kb
var f,g:Text;
    n,c,x,m,i:longint;
    a:array[1..10000]of longint;
procedure caut_bin;
         var s,d,mij,k:longint;
         begin
              s:=1;d:=n;k:=0;
              while (s<=d) do
                    begin
                    mij:=(s+d)div 2;
                    if (c=0)and(a[mij]=x)then begin
                                              writeln(g,mij);
                                              break;
                                              end
                    else if (c=1)and(a[mij]<x)then begin
                                                   writeln(g,mij);
                                                   break;
                                                   end
                    else if (c=2)and(a[mij]>x)then begin
                                                   writeln(g,mij);
                                                   break;
                                                   end
                    else if c=0 then begin
                                     if a[mij]<x then s:=mij+1
                                     else d:=mij-1;
                                     end
                    else if c=1 then begin
                                     d:=mij-1;
                                     end
                    else if c=2 then begin
                                     s:=mij+1;
                                     end;
                    end;
         end;


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]);
readln(f,m);
for i:=1 to m do
    begin
    read(f,c,x);
    caut_bin;
    end;
close(g);
end.