Cod sursa(job #125448)

Utilizator DiaconuDiaconu Loredana Diaconu Data 20 ianuarie 2008 12:53:45
Problema Piese Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasa a 9-a Marime 1.4 kb
var     f,g:text;
        n,m,cnr,nr,cul,i,j,k,l,x,y,a,b,aux,z,cz:integer;
        v:array[1..500,1..500] of integer;
begin
assign (f,'piese.in');reset (f);
assign (g,'piese.out');rewrite (g);
readln (f,n,m);
if n<m then begin
 aux:=m;
 m:=n;
 n:=aux;
end;
z:=0;
nr:=1;
while nr<m do nr:=nr*2;
nr:=nr div 2;
for i:=1 to (m div nr) do
 for j:=1 to (n div nr) do begin
  inc(cul);
  for l:=(i-1)*nr+1 to ((i-1)*nr+nr) do
   for k:=(j-1)*nr+1 to (j-1)*nr+nr do
    v[l,k]:=cul;
 end;
a:=m-nr*(m div nr);
b:=n;
x:=nr*(m div nr);
y:=nr*(n div nr);
cnr:=nr;
while cnr>1 do begin
 cnr:=cnr div 2;
 if (a div cnr)<>0 then begin
  for i:=1 to (a div cnr) do
   for j:=1 to (b div cnr) do begin
    inc(cul);
    for l:=x+((i-1)*cnr+1) to x+((i-1)*cnr+cnr) do
     for k:=(j-1)*cnr+1 to (j-1)*cnr+cnr do
      v[l,k]:=cul;
   end;
  a:=a mod cnr;
 end;
end;
cnr:=nr;
a:=n-y;
b:=x;
while cnr>1 do begin
 cnr:=cnr div 2;
 if (a div cnr)<>0 then begin
  for i:=1 to (a div cnr) do
   for j:=1 to (b div cnr) do begin
    inc(cul);
    for l:=y+(i-1)*cnr+1 to y+(i-1)*cnr+cnr do
     for k:=(((j-1)*cnr+1)) to ((j-1)*cnr+cnr) do
      v[k+z,l+z]:=cul;
   end;
   a:=a mod cnr;
 end;
end;
writeln (g,cul);
for i:=1 to m do begin
 writeln (g);
 for j:=1 to n do
  write (g,v[i,j],' ');
end;

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