Cod sursa(job #568016)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 30 martie 2011 18:41:16
Problema Range minimum query Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.1 kb
var v:array [1..200001] of longint;
    a:array[0..17, 1..200001] of longint;
    buf1, buf2:array [1..1 shl 17] of char;
    m, n, i, j, x, y, k, k1, xx:longint;
    f, g:text;
    p:longint;

begin
assign (f, 'rmq.in'); settextbuf (f, buf1); reset (f);
assign (g, 'rmq.out'); settextbuf (g, buf2); rewrite (g);

readln (f, n, m); for i := 1 to n do readln (f, v[i]);
x:=n;
k1:=0;
while x <> 0 do begin k1:=k1+1; x:= x shr 1; end;
for i := 1 to n do a[0, i] := i;

k:=1;
for i := 1 to k1 do
  begin
  for j := 1 to n do
    begin
    if v[a[i-1, j]] <= v[a[i-1, j+k]] then a[i, j] := a[i-1, j]
                                      else a[i, j] := a[i-1, j+k]
    end;
  k:=k shl 1;
  end;

for i := 1 to m do
  begin
  readln (f, x, y);
  if x = y then writeln (g, v[x])
           else
    begin
    xx:=y-x; k1:=0;
    while xx > 1 do begin k1:=k1+1; xx:= xx shr 1; end;
    k := y-(1 shl k1)+1;

    if v[a[k1, x]] < v[a[k1, k]] then
       writeln (g, v[a[k1, x]])
                                 else
       writeln (g, v[a[k1, k]]);
    end;
  end;

close (f); close (g);
end.