Cod sursa(job #341682)

Utilizator AndreiDumaAndrei Duma AndreiDuma Data 19 august 2009 11:58:47
Problema Cautare binara Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.77 kb
var v:array[0..100004] of integer;
    n,m,t,x,i:integer;

    f,g:text;


function BS1(x:integer):integer;
var lo, hi, mid:integer;
begin
        lo := 1; hi := n;
        while lo <= hi do
        begin
                mid := lo+(hi-lo) div 2;
                if x<v[mid] then hi := mid - 1
                else if v[mid]<x then lo := mid+1
                else
                begin
                        BS1:=mid;
                        break;
                end;
        end;
        if lo>hi then BS1:=-1;
end;

function bs2(x : integer):integer;
var lo, hi, mid, last:integer;
begin
        last := 0;
        lo := 1; hi := n;
        while lo<=hi do
        begin
                mid := lo +(hi-lo) div 2;
                if v[mid]<=x then
                begin
                        last := mid;
                        lo := mid+1;
                end
                             else
                hi := mid - 1;
        end;

        bs2:=last;
end;

function bs3(x:integer):integer;
var lo, hi, mid, last:integer;
begin
        last:=n+1;
        lo:=1; hi:=n;
        while lo<=hi do
        begin
                mid := lo+(hi-lo) div 2;
                if x<=v[mid] then
                begin
                        last := mid;
                        hi := mid-1;
                end
                             else
                lo := mid+1;
        end;

        bs3:=last;
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,m);

for i:=1 to m do
begin
        read(f,t,x);
        if t=0 then writeln(g,BS1(x))
        else if t=1 then writeln(g,BS2(x))
        else writeln(g,BS3(x));
end;

close(g);
end.