Cod sursa(job #586954)

Utilizator elffikkVasile Ermicioi elffikk Data 3 mai 2011 16:12:38
Problema Range minimum query Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.63 kb
var a:array[1..110000,1..30]of longint;
    q:array[1..1000000,1..2]of longint;
    d,n,nn,m:longint;
procedure init;
var f:text; i,j:longint;
begin
  assign(f,'rmq.in');
  reset(f);
  read(f,n,m);
  nn:=1;
  d:=1;
  while nn<n do
  begin
    nn:=nn*2;
    inc(d);
  end;
  {writeln(nn,' ', d);}
  
  {fillchar(a,sizeof(a));}
  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];
  for i:=1 to m do begin read(f,q[i,1],q[i,2]); {writeln(q[i,1],' ',q[i,2]);} end;
  close(f);
end;

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 rez2;
var i:longint;f:text;
begin
  assign(f,'rmq.out');
  rewrite(f);
  for i:=1 to m do writeln(f,rmq(q[i,1],q[i,2]));
  close(f);
end;

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