Çàäà÷à ¹2 (100 áàë³â).

Òåñò 1. n=3 (5 áàë³â)

Òåñò 2. n=4 (10 áàë³â)

Òåñò 3. n=7 (20 áàë³â)

Òåñò 4. n=8 (30 áàë³â)

Òåñò 5. n=9 (35 áàë³â)

Àâòîðñüêèé âàð³àíò ðîçâ’ÿçêó:

program Greek;

uses crt;

 type

  DigitStr=array[1..100] of 0..9;

var x: DigitStr;

    n1,r,c,k,k1,i,ss,r1,c1,kl:integer;

    t:array[1..10,1..10] of integer;

    ff,fff:boolean;

    n:1..100;

    g:text;

 function NextExist (var x:DigitStr):boolean;

  var

   i,j,k:1..100;

   temp:0..0;

   found:boolean;

  begin

   i:=n+1;

   j:=n;

   x[n+1]:=0;

   found:=false;

   while (not found) and (i>1) do

    begin

     found:=x[i-1]<x[i];

     if (not found) then i:=i-1

                    else k:=i-1;

    end;

   if found then

    begin

     i:=n;

     while x[i]<=x[k] do

     i:=i-1;

     temp:=x[i];

     x[i]:=x[k];

     x[k]:=temp;

     i:=k+1;

      while i<j do

       begin

        temp:=x[j];

        x[j]:=x[i];

        x[i]:=temp;

        i:=i+1;

        j:=j-1;

       end;

    end;

   NextExist:=found;

  end;

procedure InitAr(var x:DigitStr);

var i:integer;

begin

 for i:=1 to n do

  x[i]:=i;

end;

{}

procedure ZRow(rn:integer);

var i:integer;

begin

 for i:=1 to n do

  t[rn,i]:=x[i];

end;

{}

procedure ZXXX(rn:integer);

var i:integer;

begin

 for i:=1 to n do

  x[i]:=t[rn,i];

end;

{}

function chek(nk:integer):boolean;

var r1,c1,s,sn:integer;

    mn:set of 1..10;

begin

  chek:=true;

  for c1:=1 to n do

   begin

    mn:=[];

    for r1:=1 to nk do

      if not (t[r1,c1] in mn) then

        mn:=mn+[t[r1,c1]]

        else

         begin

          chek:=false;

          exit;

         end;

   end;

   for r1:=1 to nk do

    begin

     mn:=[];

    for c1:=1 to n do

      if not (t[r1,c1] in mn) then

        mn:=mn+[t[r1,c1]]

        else

         begin

          chek:=false;

          exit;

         end;

   end;

    mn:=[];

    for r1:=1 to nk do

      if not (t[r1,r1] in mn) then

        mn:=mn+[t[r1,r1]]

        else

         begin

          chek:=false;

          exit;

         end;

    c1:=n;

    mn:=[];

    for r1:=1 to nk do

      begin

       if not (t[r1,c1] in mn) then

        mn:=mn+[t[r1,c1]]

        else

         begin

          chek:=false;

          exit;

         end;

       dec(c1);

      end;

end;

{}

begin

  clrscr;

 { write('n=>>');

  readln(n);}

  assign(g,'in3.txt');

  reset(g);

  readln(g,n);

  close(g);

  initar(x);

  r:=1;

  ZRow(r);

  inc(r);

  fff:=false;

  ff:=true;

  while  ff do

   begin

    ff:=NextExist(x);

     ZRow(r);

    if chek(r) then

     begin

       initar(x);

       inc(r);

      if r>n then

       begin

        assign(g,'out.txt');

        rewrite(g);

        for r1:=1 to n do

         begin

          for c1:=1 to n do

           write(g,t[r1,c1],' ');

          writeln(g);

        end;

        close(g);

        exit;

       { inc(kl);

       writeln;}

       end;

     end;

     if not ff then

      repeat

       dec(r);

       ZXXX(r);

       ff:=NextExist(x);

       fff:=true;

      until ff;

   if fff then fff:=false;

  end;

 end.