Cod sursa(job #231458)

Utilizator SleepyOverlordPatcas Csaba SleepyOverlord Data 14 decembrie 2008 12:27:03
Problema Tablete Scor 70
Compilator fpc Status done
Runda Algoritmiada 2009, Runda 1, Studenti Marime 1.69 kb
const in_file='tablete.in';
      out_file='tablete.out';
      max=1000;
var fin,fout:text;
    n,k:word;
    a:array[1..max,1..max] of longint;
procedure par;
var base:longint;
    q,w:word;
begin
     base:=0;
     for q:=1 to n div 2 do
     begin
          for w:=1 to k-1 do a[q*2-1][w]:=base+w;
          if odd(k)
          then
          begin
               a[q*2-1][k]:=base+k+1;
               a[q*2][1]:=base+k;
               for w:=2 to k do a[q*2][w]:=base+k+w;
          end
          else
          begin
               a[q*2-1][k]:=base+k;
               for w:=1 to k do a[q*2][w]:=base+k+w;
          end;
          for w:=1 to n-k do
          begin
               a[q*2-1][k+w]:=base+2*k+w;
               a[q*2][k+w]:=base+2*k+(n-k)+w;
          end;
          inc(base,2*n);
     end;
end;
procedure swap(i1,j1,i2,j2:word);
var cs:longint;
begin
     cs:=a[i1][j1];
     a[i1][j1]:=a[i2][j2];
     a[i2][j2]:=cs;
end;
procedure impar;
var q:word;
    aux:longint;
begin
     par;
     for q:=1 to n do a[n][q]:=longint(n-1)*n+q;
     if odd(k)
     then
     begin
          swap(n,k,n,k-1);
          swap(n,k-1,n-1,n);
          aux:=a[n][k-1];
          for q:=k-1 downto 2 do a[n][q]:=a[n][q-1];
          a[n][1]:=aux;
     end;
end;
procedure write_data;
var q,w:word;
begin
     assign(fout,out_file);
     rewrite(fout);
     for q:=1 to n do
     begin
         for w:=1 to n do write(fout,a[q][w],' ');
         writeln(fout);
     end;
     close(fout);
end;
begin
     assign(fin,in_file);
     reset(fin);
     read(fin,n,k);
     if not odd(n)
     then par
     else impar;
     close(fin);
     write_data;
end.