Cod sursa(job #1199101)

Utilizator SwampiPasca Marius Swampi Data 18 iunie 2014 09:46:16
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.79 kb
type vector=array[1..100] of integer;
var li,ls,n,i,k,x,m:integer;
    v:vector;
    fin,fout:text;
    gasit:boolean;
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,x);
li:=1;
ls:=n;
gasit:=false;
repeat
    k:=(li+ls) div 2;
    if v[k]=x then
       begin
       m:=k;
       gasit:=true;
       end
       else
       if v[k]<x then
          li:=k+1
          else
          ls:=k-1;
until (li>ls) or gasit;
if li>ls then
   write(fout,'-1')
   else
   begin
   while v[m]=x do
         inc(m);
   dec(m);
   writeln(fout,m);
   writeln(fout,m);
   while v[m]=x do
         dec(m);
   inc(m);
   writeln(fout,m);
   end;
close(fin);
close(fout);
write(m);
end.