Cod sursa(job #647787)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 11 decembrie 2011 22:48:20
Problema Cautare binara Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.71 kb
Program binar_cautare;
var fi,fo:text;
    i,tip,val,n,m : longint;
    a:array[1..100] of longint;


function cautare_binara_0(p,u,key:longint):longint;
var m :longint;
begin
     while (p<=u) do begin
                     m:=(p+u) div 2;
                     if (a[m]<=key) then p:=m+1
                                    else u:=m-1;
                     end;
     m:=(p+u) div 2;
     if (a[m]>key) then m:=m-1;
     if (a[m]=key) then cautare_binara_0:=m
                   else cautare_binara_0:=-1;
end;

Function cautare_binara_1(p,u,key:longint):longint;
var m,n :longint;
begin
    n:=u;
    while (p<u) do begin
                   m:=(p+u) div 2;
                   if a[m]<=key then p:=m+1
                                else u:=m;
                   end;
    m:=(p+u) div 2;
    if a[m]>key then m:=m-1;
    cautare_binara_1:=m;
end;

Function cautare_binara_2(p,u,key : longint):longint;
var m:longint;
begin
    while (p<u) do begin
                   m:=(p+u) div 2;
                   if a[m]<key then p:=m+1
                               else u:=m;
                   end;
    m:=(p+u) div 2;
    if a[m]<key then m:=m+1;
    cautare_binara_2:=m;
end;


begin
    assign(fi,'cautbin.in'); reset(fi);
    assign(fo,'cautbin.out'); rewrite(fo);
    readln(fi,n);
    for i:=1 to n do read(fi,a[i]);
    readln(fi,m);
    for i:=1 to m do begin
                     readln(fi,tip,val);
                     if tip=0 then writeln(fo,cautare_binara_0(1,n,val));
                     if tip=1 then writeln(fo,cautare_binara_1(1,n,val));
                     if tip=2 then writeln(fo,cautare_binara_2(1,n,val));
                     end;

    close(fi); close(fo);
end.