Cod sursa(job #232823)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 16 decembrie 2008 08:51:26
Problema Tablete Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.47 kb
var f,g:text;
a:array[1..1000,1..1000]of integer;
n,i,k,j,p,aux:integer;
begin
assign(f,'tablete.in');
reset(f);
readln(f,n,k);
assign(g,'tablete.out');
rewrite(g);
p:=1;
if n mod 2 =0 then
  begin
  if k mod 2=0 then
    for i:=1 to n do
       begin
       for j:=1 to n do
               begin
               write(g,p,' ');
               p:=p+1;
               end;
       writeln(g);
       end
     else
        begin
        for i:=1 to n do
           for j:=1 to n do
               begin
               a[i,j]:=p ;
               p:=p+1;
               end;
        for i:=1 to n-1 do
            begin
            aux:=a[i,k];
            a[i,k]:=a[i,k+1];
            a[i,k+1]:=aux;
            end;
        for i:=1 to n-1 do
          begin
          aux:=a[i,k+1];
          for j:=k+1 to n-1 do
                 a[i,j]:=a[i,j+1];
          a[i,n]:=aux;
          end;
        for i:=1 to n-2 do
          begin
          aux:=a[i,n];
          a[i,n]:=a[i+1,1];
          a[i+1,1]:=aux;
          end;
        aux:=a[n,k];
        a[n,k]:=a[n,k-1];
        a[n,k-1]:=aux;
        aux:=a[n,1];
          for j:=1 to k-2 do
                 a[n,j]:=a[n,j+1];
          a[n,k-1]:=aux;
        aux:=a[n,1];
        a[n,1]:=a[n-1,n];
        a[n-1,n]:=aux;
        for i:=1 to n do
        begin
        for j:=1 to n do
            write(g,a[i,j],' ');
       writeln(g);
       end
    end;
    end;
close(f);
close(g);
end.