Cod sursa(job #231127)

Utilizator chelaru_t_achelaru traian andrei chelaru_t_a Data 14 decembrie 2008 11:35:17
Problema Tablete Scor 30
Compilator fpc Status done
Runda Algoritmiada 2009, Runda 1, Clasele 9-10 Marime 1.09 kb
var i,j,n,aux,k,h,l:integer;
    v:array [1..1000] of integer;
    t:array [1..1000,1..1000] of integer;
    ok:boolean;
    f,g:text;

begin
  assign(f,'tablete.in');
  assign(g,'tablete.out');
  reset(f);
  rewrite(g);
  readln(f,n,k);
  i:=0;
  j:=0;
  l:=0;
  h:=0;
  for i:=1 to n-1 do
    for j:=1 to n do
      begin
      l:=l+1;
      if (j=k) and (l mod 2=1)then
        begin
        h:=h+1;
        v[h]:=l;
        l:=l+1;
        end;
      t[i,j]:=l;
      end;
  for i:=1 to h do t[n,i]:=v[i];
  for i:=h+1 to n do
    begin
    l:=l+1;
    t[n,i]:=l;
    end;
  if h>k then h:=k-1;
  if t[n,k] mod 2=1 then
    begin
    ok:=false;
    i:=n;
    while (i>1) and (not ok) do
      begin
      i:=i-1;
      if t[n,h+1]>t[i,n] then
        begin
        ok:=true;
        aux:=t[n,n];
        for j:=n downto h+2 do t[n,j]:=t[n,j-1];
        t[n,h+1]:=t[i,n];
        t[i,n]:=aux;
        end;
      end;
    end;
  for i:=1 to n do
    begin
    for j:=1 to n do write(g,t[i,j],' ');
    writeln(g);
    end;
  close(f);
  close(g);
end.