Cod sursa(job #243806)

Utilizator ghitza_2000Stefan Gheorghe ghitza_2000 Data 13 ianuarie 2009 23:56:51
Problema Tablete Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.43 kb
type matrice=array[1..1000,1..1000] of longint;
var n,k,i,j:integer;
    f,g:text;
    c:matrice;
procedure matrice1(var c:matrice);
var i,j,h:longint;
begin
h:=1;
for i:=1 to n do
 for j:=1 to k do
 begin
 c[i,j]:=h;
 inc(h);
 end;
for i:=1 to n do
for j:=k+1 to n do
begin
c[i,j]:=h;
inc(h);
end;
end;

procedure matrice2(var c:matrice);
var i,j,h,p,d:longint;
begin
i:=1; p:=0;
while i<=n-1 do
begin
for j:=1 to k-1 do
c[i,j]:=j+p;
c[i,k]:=k+1+p;
p:=p+k; d:=p+3;
for j:=1 to k-1 do
c[i+1,j]:=j*2+p-2;
p:=p+k;
c[i+1,k]:=p;
i:=i+2;
end;
h:=n*k+1;
for i:=1 to n do
for j:=k+1 to n do
begin
c[i,j]:=h;
inc(h);
end;
end;
procedure matrice3(var c:matrice);
var i,j,h,p:longint;
begin

i:=1; p:=0;
while i<=n-2 do
begin
for j:=1 to k-1 do
c[i,j]:=j+p;
c[i,k]:=k+1+p;
p:=p+k;
for j:=1 to k-1 do
c[i+1,j]:=j*2+p-2;
p:=p+k;
c[i+1,k]:=p;
i:=i+2;
end;
h:=n*k+1;
for i:=1 to n do
for j:=k+1 to n do
begin
c[i,j]:=h;
inc(h);
end;
for j:=1 to k-1 do
c[n,j]:=(n-1)*k+j;
c[n,k]:=n*k+1; c[1,k+1]:=n*k;
end;
procedure mat(var c:matrice);
begin
if k mod 2=0 then matrice1(c)
             else if n mod 2 =0 then matrice2(c)
                                else matrice3(c);

end;

begin
assign(f,'tablete.in'); reset(f);
readln(f,n,k); close(f);
mat(c);
assign(g,'tablete.out'); rewrite(g);
for i:=1 to n do
begin

for j:=1 to n do
write(g,c[i,j],' ');
writeln(g);
end;
close(g);
end.