Cod sursa(job #18201)

Utilizator VmanDuta Vlad Vman Data 18 februarie 2007 10:34:56
Problema Plantatie Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 2, Clasa a 10-a Marime 1.82 kb
program plantatie;
var n:integer;
    m,i,j,x,y,z:longint;
    a:array[1..500,1..500,0..9]of longint;
    {a[i][j][k]=maximul din patratul cu coltu i,j si latura 2^k}
    p:array[0..10]of longint;
    f,g:text;

function getmax(x,y,z:longint):longint;
var k,kk,l,i,j:integer;
    max:longint;
begin
k:=0;
max:=0;
while p[k]<=z do inc(k);
dec(k);
max:=a[x][y][k];
l:=p[k];
kk:=k;
while (l<=z-1) do begin
   k:=kk;
   while (l+p[kk]>z) do dec(kk);
   j:=0;
   for i:=1 to p[k-kk] do
       begin
       if a[x+j][y+l][kk]>max then max:=a[x+j][y+l][kk];
       inc(j,p[kk]);
       end;
   j:=0;
   for i:=1 to p[k-kk] do
       begin
       if a[x+l][y+j][kk]>max then max:=a[x+l][y+j][kk];
       inc(j,p[kk]);
       end;
   if a[x+l][y+l][kk]>max then max:=a[x+l][y+l][kk];
   inc(l,p[kk]);
end;
getmax:=max;
end;

procedure constr; {construiesc arbore de intervale}
var i,j,k:integer;
begin
p[0]:=1;
for i:=1 to 10 do
    p[i]:=p[i-1] shl 1;
k:=1;
while p[k]<=n do begin
      for i:=1 to n do
          if i+p[k]-1<=n then
             for j:=1 to n do
                 if j+p[k]-1<=n then
                  begin
                  a[i][j][k]:=a[i][j][k-1];
                  if a[i+p[k-1]][j][k-1]>a[i][j][k] then a[i][j][k]:=a[i+p[k-1]][j][k-1];
                  if a[i][j+p[k-1]][k-1]>a[i][j][k] then a[i][j][k]:=a[i][j+p[k-1]][k-1];
                  if a[i+p[k-1]][j+p[k-1]][k-1]>a[i][j][k] then a[i][j][k]:=a[i+p[k-1]][j+p[k-1]][k-1];
                  end;
inc(k);
end;
end;

begin
assign(f,'plantatie.in');reset(f);
assign(g,'plantatie.out');rewrite(g);
readln(f,n,m);
for i:=1 to n do begin
    for j:=1 to n do
        read(f,a[i][j][0]);
    readln(f);
end;
constr;
for i:=1 to m do begin
    readln(f,x,y,z);
    writeln(g,getmax(x,y,z));
end;
close(f);
close(g);
end.