Cod sursa(job #342614)

Utilizator sapiensCernov Vladimir sapiens Data 22 august 2009 15:27:54
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
Program cautbin;
 var f,g:text; a:array[1..100000]of longint;
     i,k,n,m,p:longint; j:byte;
 function max (x,y:longint):longint;
  begin
   if x<y then exit (y) else exit (x);
  end;
 procedure find_1 (x,y,z:longint);
  begin
   if x=y then if a[x]=z then writeln (g,x) else writeln (g,-1) else
     if a[(x+y+1) div 2]>z then find_1 (x,(x+y+1) div 2-1,z) else find_1 ((x+y+1) div 2,y,z);
  end;
 procedure find_2 (x,y,z:longint);
  begin
   if x=y then if a[x]<=z then writeln (g,x) else else
     if a[(x+y+1) div 2]>z then find_2 (x,(x+y+1) div 2-1,z) else find_2 ((x+y+1) div 2,y,z);
  end;
 procedure find_3 (x,y,z:longint);
  begin
   if x=y then if a[x]<=z then writeln (g,x) else else
     if a[(x+y-1) div 2]>=z then find_3 (x,(x+y-1) div 2,z) else find_3 ((x+y-1) div 2+1,y,z);
  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,a[i]); readln (f);
  readln (f,m);
  for i:=1 to m do begin
    readln (f,j,k);
    case j of
      0: find_1 (1,n,k);
      1: find_2 (1,n,k);
      2: find_3 (1,n,k);
    end;
  end;
  close (f); close (g);
 end.