Cod sursa(job #587340)

Utilizator elffikkVasile Ermicioi elffikk Data 4 mai 2011 18:09:53
Problema Range minimum query Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
var a:array[1..110000,1..30]of longint;
    d,n,nn,m:longint;


function min(a,b:longint):longint;
begin
  if a>b then min:=b else min:=a;
end;

procedure rez;
var i,j,p:longint;
begin
  p:=1;
  for j:=2 to d do
  begin
    for i:=1 to nn do
      a[i,j]:=min(a[i,j-1],a[min(nn,i+p),j-1]);
    p:=p*2;
  end;
  {
  for j:=1 to d do
  begin
    for i:=1 to nn do
      write(a[i,j],' ');
    writeln;
  end;
  }
end;

function ad(k:longint):longint;
var d,t:longint;
begin
  d:=0; t:=k div 2;
  while t>0 do
  begin
    t:=t div 2;
    inc(d);
  end;
  ad:=d;
end;

function rmq(x,y:longint):longint;
var d:longint;
begin
   {writeln(x,' ',y,';');}
   if x=y then rmq:=a[x,1]
   else begin
     d:=ad(abs(x-y)+1);
     if x+1 shl (d-1)=y then rmq:=a[x,d]
     else rmq:=min(a[x,d],rmq(x+1 shl (d-1)+1,y));
   end
end;


procedure init;
var f,ff:text; i,j,x,y:longint;
begin
  assign(f,'rmq.in');
  reset(f);
  assign(ff,'rmq.out');
  rewrite(ff);
  read(f,n,m);
  nn:=1;
  d:=1;
  while nn<n do
  begin
    nn:=nn*2;
    inc(d);
  end;
  for i:=1 to n do begin read(f,a[i,1]); {write(a[i,1],' ');}end;
  for i:=n+1 to nn do a[i,1]:=a[n,1];
  rez;
  for i:=1 to m do
  begin
    read(f,x,y);
    writeln(ff,rmq(x,y));
  end;
  close(f);
  close(ff);
end;

begin
  init;
  {writeln;
  writeln(ad(1),' ',ad(2),' ',ad(3),' ',ad(10),' ',ad(31),' ',ad(32));
  readln;}
end.