Cod sursa(job #276282)

Utilizator andreirulzzzUPB-Hulea-Ionescu-Roman andreirulzzz Data 11 martie 2009 00:54:52
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
program binara;
var a:array[1..1000] of longint;
    n,m,i,x,cond:longint;
{--------------------------------}
procedure caut0;
var st,sf,mid:longint;
begin
     st:=1;sf:=n;
     while st<sf do begin
           mid:=st+(sf-st) div 2;
           if x<a[mid] then sf:=mid-1
           else if (a[mid]<x) then
                st:=mid+1;
           end;
     writeln(output,st);
end;
{--------------------------------}
procedure caut1;
var st,sf,mid,nr:longint;
begin
     st:=1; sf:=n; nr:=0;
     while st<sf do begin
           mid:=st+(sf-st) div 2;
           if a[mid]<x then begin
              nr:=mid;
              st:=mid+1;
              end
           else sf:=mid-1;
           end;
     writeln(output,nr);
end;
{--------------------------------}
procedure caut2;
var st,sf,mid,nr:longint;
begin
     st:=1; sf:=n; nr:=n+1;
     while st<sf do begin
           mid:=st+(sf-st) div 2;
           if a[mid]>=x then begin
              nr:=mid;
              sf:=mid-1;
              end
           else st:=mid+1;
           end;
     writeln(output,nr);
end;
{--------------------------------}
begin
assign(input,'cautbin.in');
reset(input);
read(input,n);
for i:=1 to n do read(input,a[i]);
read(input,m);
assign(output,'cautbin.out');
rewrite(output);
for i:=1 to m do begin
    read(input,cond,x);
    case cond of
         0: caut0;
         1: caut1;
         2: caut2;
         end;
    end;
close(input);
close(output);
end.