Cod sursa(job #324645)

Utilizator nod_softwareBudisteanu Ionut Alexandru nod_software Data 16 iunie 2009 16:59:10
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.29 kb
program Giga_software;
var p,u,i,j,n,m,x,y:longint;
    v:array [1..10000] of longint;
    fin,fout:text;
{*----------------------------------*}
procedure zero;
begin
    p:=1; u:=n;
    while p <=u do
    begin
        m:=(p+u) shr 1;
        if v[m] > x
          then u:=m-1
        else
          p:=m+1;
    end;
    if v[u] = x
      then writeln(fout,u)
    Else
      writeln(fout,-1);
end;
{*----------------------------------*}
procedure unu;
begin
    p:=1; u:=n;
    while p <=u do
    begin
       m:=(p+u) shr 1;

       if v[m] > x then u:=m-1
       else
         p := m+1;
    end;
    writeln(fout,u);
end;
{*----------------------------------*}
procedure doi;
begin
    p:=1; u:=n;
    while p  <=u do
    begin
       m:=(p+u) shr 1;
       if v[m] < x then p:=m+1
       else
         u:=m-1;
    end;
    writeln(fout,p);
end;
{*----------------------------------*}
begin
    assign(fin,'cautbin.in'); reset(fin); assign(fout,'cautbin.out'); rewrite(fout);

    readln(fin,n);
    for i:=1 to n do
       read(fin,v[i]);

    readln(fin,m);
    for j:=1 to m do
    begin
        read(fin,y,x);
        case y of
           0:zero;
           1:unu;
           2:doi;
        end;
    end;


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