Cod sursa(job #404829)

Utilizator danimihalcaDaniel Mihalca danimihalca Data 26 februarie 2010 19:20:17
Problema Tablete Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.26 kb
program tablete;
var a:array[1..1000,1..1000] of longint;
    b:array[1..1000000] of boolean;
   n,k,i,j:integer; f,g:text;  p,x,aux,aux2:longint;
begin
  assign(f,'tablete.in'); reset(f);
  read(f,n,k);
  close(f);
  assign(g,'tablete.out'); rewrite(g);
  if (not odd(n)) and (not odd(k)) then
   begin
    for i:=1 to n do
      begin
      for j:=1 to n do
        write(g,j+(i-1)*n,' ');
      writeln(g);
    end; close(g); end
 else
   begin
    x:=1;
    for i:=1 to n do
      for j:=1 to n do
         begin
           if j=k then
            begin
              repeat
                 x:=x+1;
              until (not odd(x)) and (not b[x]);
              a[i,j]:=x; b[x]:=true;
            end
              else
               if j<k then
                 begin
                    p:=0;
                    repeat
                        p:=p+1
                    until not b[p];
                    a[i,j]:=p; b[p]:=true;
                  end
                    else
                    begin
                      p:=a[i,j-1];
                      repeat
                        p:=p+1
                      until not b[p];
                      a[i,j]:=p; b[p]:=true;
                    end;
        end;
  i:=n*(n-1)-1;
  repeat
    i:=i+1;
  until b[i]=false;
  aux2:=i;
  aux:=a[n-1,n]; a[n-1,n]:=n*n-1; a[n,n]:=n*n;
  a[n,k]:=a[n,k]-2;
  for i:=1 to n-1 do
   begin
    for j:=i+1 to n do
      begin
        if a[n,i]=a[n,j] then
         if (i=k) then a[n,j]:=aux
                  else
                    if (j=k) or (j=n) then
                        a[n,j]:=aux;
         break;
       end;
         if a[n,j]=aux then break;
    end;
   for i:=1 to n-1 do
   begin
    for j:=i+1 to n do
      begin
        if a[n,i]=a[n,j] then
         if (i=k) then a[n,j]:=aux2
            else if (j=k) or (j=n) then a[n,j]:=aux2;
            break;
        end;
         if a[n,j]=aux2 then break;
      end;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[n,i]>a[n,j] then
        begin
         aux:=a[n,i]; a[n,i]:=a[n,j]; a[n,j]:=aux;
        end;
  for i:=1 to n do
    begin
      for j:=1 to n do
        write(g,a[i,j],' ');
      writeln(g);
    end;
    close(G);
 end;
end.