Cod sursa(job #411172)

Utilizator hungntnktpHungntnktp hungntnktp Data 4 martie 2010 19:10:57
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
{DINH QUANG DAT TIN 07-10}
{CAUTBIN}
{$inline on}
{$mode objfpc}
CONST
 TFI='cautbin.in';
 TFO='cautbin.out';
 MAX=100001;
TYPE
 arr1int=array[0..MAX] of longint;
VAR
 fi,fo:text;
 res,task,x,m,n:longint;
 a:arr1int;
 f,g:array[0..MAX] of ^longint;

PROCEDURE       process1;inline;
var
 l,r,mid:longint;
begin
 l:=1;
 r:=n;
 res:=-1;
 while l<=r do
  begin
   mid:=(l+r) div 2;
   if a[mid]=x then
    begin
     res:=g[mid]^;
     l:=mid+1;
    end else
    if a[mid]<x then l:=mid+1 else r:=mid-1;
  end;
 writeln(fo,res);
end;

PROCEDURE       process2;inline;
var
 l,r,mid:longint;
begin
 l:=1;
 r:=n;
 while l<=r do
  begin
   mid:=(l+r) div 2;
   if a[mid]<=x then
    begin
     res:=g[mid]^;
     l:=mid+1;
    end else r:=mid-1;
  end;
 writeln(fo,res);
end;

PROCEDURE       process3;inline;
var
 l,r,mid:longint;
begin
 l:=1;
 r:=n;
 while l<=r do
  begin
   mid:=(l+r) div 2;
   if a[mid]>=x then
    begin
     res:=f[mid]^;
     r:=mid-1;
    end else l:=mid+1;
  end;
 writeln(fo,res);
end;

PROCEDURE       input;inline;
var
 i:longint;
begin
 read(fi,n);
 for i:= 1 to n do read(fi,a[i]);
end;

PROCEDURE       init;
var
 i,j:longint;
begin
 new(f[1]);
 new(g[1]);
 j:=1;
 f[1]^:=1;
 g[1]^:=1;
 for i:= 2 to n do
  if a[i]<>a[j] then
   begin
    inc(j);
    a[j]:=a[i];
    new(f[j]);
    new(g[j]);
    f[j]^:=i;
    g[j]^:=i;
   end else g[j]^:=i;
 n:=j;
end;

PROCEDURE       process;inline;
var
 i:longint;
begin
 read(fi,m);
 for i:= 1 to m do
  begin
   read(fi,task,x);
   case task of
    0:process1;
    1:process2;
    2:process3;
   end;
  end;
end;

BEGIN
 assign(fi,tfi);reset(fi);
 assign(fo,tfo);rewrite(fo);
  input;
  init;
  process;
 close(fo);
 close(fi);
END.