Cod sursa(job #198504)

Utilizator alex-Palex puscas alex-P Data 11 iulie 2008 20:47:38
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.43 kb
program cautare_binara;
type integer=longint;
     vector = array [1..100000] of longint;

var v:vector;
    n,m,int,i,a,b,x:integer;
    f,g:text;

procedure cautare(var a,b:integer);

begin
     if (x<>v[a]) and (x<>v[b]) and (a+1<>b) then
        begin
             if v[(a+b) div 2] > x then b := (a+b) div 2
             else a:=(a+b) div 2;
             cautare(a,b);
        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,v[i]); readln(f);
     readln(f,m);
     for i:=1 to m do
          begin
               read(f,int,x);
               a:=1; b:=n;
               case int of 0 : begin cautare(a,b);
                                     if v[a]=x then writeln(g,a)
                                     else if v[b]=x then writeln(g,a)
                                          else writeln(g,'-1');
                               end;
                           1 : begin cautare(a,b);
                                     if v[b]<=x then writeln(g,b)
                                     else writeln(g,a);
                               end;
                           2 : begin cautare(a,b);
                                     if v[a]>=x then writeln(g,a)
                                     else writeln(g,b);
                               end;
               end;
          end;
     close(f); close(g);
end.