Cod sursa(job #1199113)

Utilizator SwampiPasca Marius Swampi Data 18 iunie 2014 10:23:35
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
type vector=array[1..100] of integer;
var n,m,a,o,k,i,x:integer;
    v:vector;
    fin,fout:text;
    gasit:boolean;


procedure cbin(n,x:integer;
              v:vector;
              var k,o:integer);
var li,ls:integer;
    gasit:boolean;
begin
li:=1;
ls:=n;
gasit:=false;
repeat
    k:=(li+ls) div 2;
    if v[k]=x then
       gasit:=true
       else
       if v[k]<x then
          li:=k+1
          else
          ls:=k-1;
until (li>ls) or gasit;
if li>ls then
   o:=-1;
end;



begin
assign(fin,'cautbin.in');
assign(fout,'cautbin.out');
reset(fin);
rewrite(fout);
read(fin,n);
for i:=1 to n do
    read(fin,v[i]);
read(fin,m);
for i:=1 to m do
    begin
    read(fin,a,x);
    cbin(n,x,v,k,o);
    if a=0 then
       if o=-1 then
          writeln(fout,'-1')
          else
          begin
          while v[k]=x do
                inc(k);
          writeln(fout,k-1);
          end
       else
           if a=1 then
              begin
              while v[k]<=x do
                    inc(k);
              writeln(fout,k-1);
              end else
                  if a=2 then
                     begin
                     while v[k]>=x do
                           dec(k);
                     writeln(fout,k+1);
                     end;

    end;
close(fin);
close(fout);
end.