Cod sursa(job #176232)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 10 aprilie 2008 21:26:08
Problema Piese Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.89 kb
var a:array[1..500,1..500] of longint;
    f,g:text;
    n,m:longint;
    i,j,nr:longint;

function lg(x:longint):longint;
 var num:longint;
 begin
  num:=0;
  while x<>0 do begin
   x:=x shr 1;
   num:=num+1;
  end;
  lg:=1 shl (num-1);
 end;

function min(x,y:longint):longint;
 begin
  if x<y then min:=x
  else min:=y;
 end;

procedure piesa(x1,y1,x2,y2:longint);
 var i,j,x:longint;
 begin
  if (x1<=x2) and (y1<=y2) then begin
   x:=lg(min(x2-x1+1,y2-y1+1));
   inc(nr);
   for i:=x1 to x1+x-1 do
    for j:=y1 to y1+x-1 do
     a[i,j]:=nr;
   piesa(x1+x,y1,x2,y2);
   piesa(x1,y1+x,x1+x-1,y2);
  end;
 end;

begin
 assign(f,'piese.in'); reset(f);
 assign(g,'piese.out'); rewrite(g);
 read(f,n,m);
 nr:=0;
 piesa(1,1,n,m);
 writeln(g,nr);
 for i:=1 to n do begin
  for j:=1 to m-1 do
   write(g,a[i,j],' ');
  writeln(g,a[i,m]);
 end;
 close(f); close(g);
end.