Cod sursa(job #290038)

Utilizator b_ady20Branescu Adrian b_ady20 Data 27 martie 2009 12:40:16
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda aa Marime 1.41 kb
var nr : array[1..1000] of longint;
    fin,fout : text;
    n,i,op,q,p,m,out,x,o : longint;

procedure citire;
begin
     read(fin,n);
     for i := 1 to n do begin
         read(fin,nr[i]);
     end;
     read(fin,o);
end;

procedure mic;
begin
     p := 1;
     q := n;
     while p <= q do begin
           m := p + (q - p) div 2;
           if nr[m] >= x then begin
              out := m;
              q := m -1;
           end
           else p := m +1;
     end;
     writeln(fout,out);
end;

procedure poz;
begin
     p := 1;
     q := n;
     out := -1;
     while p <= q do begin
           m := p + (q - p) div 2;
           if nr[m] = x then begin
              out := m;
              p := m +1;
           end
           else if nr[m] < x then
                p := m +1
           else q := m -1;
     end;
     writeln(fout,out);
end;
procedure mare;
begin
     p := 1;
     q := n;
     while p <= q do begin
           m := p + (q - p) div 2;
           if nr[m] <= x then begin
              out := m;
              p := m +1;
           end
           else q := m -1;
     end;
     writeln(fout,out);
end;
begin
     assign(fin,'cautbin.in');reset(fin);
     assign(fout,'cautbin.out');rewrite(fout);
     citire;

     for i := 1 to o do begin
         read(fin,op,x);
         case op of
              0: poz;
              1: mare;
              2: mic;
         end;
     end;
     close(fin);
     close(fout);
end.