Cod sursa(job #126175)

Utilizator CezarMocanCezar Mocan CezarMocan Data 21 ianuarie 2008 16:54:00
Problema Piese Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.27 kb
var m,n,i,j,nr,min,max,p,an,am,c,k,l,q,ac,li:longint;
    x,v:array[0..510] of longint;
    t,y:array[1..510,1..510] of longint;

begin
assign(input,'piese.in');reset(input);
assign(output,'piese.out');rewrite(output);
readln(n,m);
an:=n;am:=m;
min:=n;
if (m<min) then
        min:=m;
p:=1;
while (p<=min) do
        p:=p shl 1;
p:=p shr 1;
max:=p;
{while (n>0) do
        begin
        while (n>=p) do
                begin
                n:=n-p;
                inc(v[0]);
                v[v[0]]:=p;
                end;
        while (p>n) do
                p:=p shr 1;
        end;   }
while (m>0) do
        begin
        while (m>=p) do
                begin
                m:=m-p;
                inc(x[0]);
                x[x[0]]:=p;
                end;
        while (p>m) do
                p:=p shr 1;
        end;
m:=am;n:=an;
c:=1;
nr:=1;
for i:=1 to x[0] do
        begin
        //pun un patratel de marime x[i] si vad ce-mi mai trebe ca
        //sa ajung la latime n
        an:=n;
        p:=x[i];
        v[0]:=0;
        while (n>0) do
                begin
                while (n>=p) do
                        begin
                        n:=n-p;
                        inc(v[0]);
                        v[v[0]]:=p;
                        end;
                while (p>n) do
                        p:=p shr 1;
                        end;
        for j:=2 to v[0] do
                v[j]:=v[j]+v[j-1];
        for k:=1 to v[1] do
                for l:=c to c+x[i]-1 do
                        t[k,l]:=nr;
        inc(nr);
        li:=c+x[i];
        for j:=2 to v[0] do
                begin
                q:=v[j]-v[j-1];
                ac:=c;
                while (ac<li) do
                        begin
                        for k:=v[j-1]+1 to v[j] do
                                for l:=ac to ac+q-1 do
                                       t[k,l]:=nr;
                        inc(nr);
                        inc(ac,q);
                        end;
                end;
        c:=c+x[i];
        n:=an;
        end;
writeln(nr-1);
for i:=1 to n do
        begin
        for j:=1 to m do
                write(t[i,j],' ');
        writeln;
        end;
close(input);close(output);
end.