1
$\begingroup$
ClearAll["Global`*"]

n = 4;

A = Table[Table[Indexed[x, {i, j}], {j, 1, n}], {i, 1, n}];

solns = Maximize[{Det[A], Join[Flatten[Map[{1 <= #, # <= n} &, Flatten[A]]], {Total[Flatten[A]] ==n*Total[Range[1, n]], Product[Flatten[A][[i]], {i, 1, n^2}] == (n!)^n}]}, Flatten[A],Integers][[2]];

MatrixForm[Table[Table[solns[[i*n + j - n]][[2]], {j, 1, n}], {i, 1, n}]]

Table[Table[solns[[i*n + j - n]][[2]], {j, 1, n}], {i, 1, n}]

I am looking to use this code to maximize the determinant of a $n\times n$ matrix which contains only digits $1$ through $n$ (inclusive), of which each digit must appear exactly $n$ times.

Currently, this code is very slow when $n\ge4$.

How can this Mathematica code be modified to make it tractable when $n\ge4$?

$\endgroup$
4
  • 2
    $\begingroup$ I believe but I do not think I can prove that the best possible 9x9 matrix for this is any positive-determinant row-column permutation of the following matrix: RotateRight[Range[9], #] & /@ (Range[9] - 1). For the 4x4 case this finds a 4x4 matrix with a determinant of 160, which is an improvement over the existing answer. $\endgroup$
    – eyorble
    Feb 19, 2022 at 2:49
  • 1
    $\begingroup$ For the n=9 case a determinant of 933,251,220 can be achieved: {{9, 4, 1, 5, 6, 8, 3, 2, 7}, {5, 9, 4, 6, 3, 2, 1, 8, 7}, {8, 5, 9, 2, 1, 4, 7, 3, 6}, {4, 3, 7, 9, 8, 1, 5, 2, 6}, {3, 6, 8, 1, 9, 7, 2, 5, 4}, {1, 7, 5, 8, 2, 9, 6, 3, 4}, {6, 8, 2, 4, 7, 3, 9, 5, 1}, {7, 1, 6, 7, 4, 6, 4, 9, 1}, {2, 2, 3, 3, 5, 5, 8, 8, 9}} $\endgroup$ Feb 19, 2022 at 3:44
  • 1
    $\begingroup$ “Each digit appears exactly $n$ times” seems to imply there are $9n$ entries in your $n\times n$ matrix. Did you mean digits 1 through $n$ (for a given $n$ up to 9), by chance? $\endgroup$
    – Michael E2
    Feb 20, 2022 at 5:52
  • $\begingroup$ Thank you for pointing that out, I did mean 1 through $n$ however I was initially interested in the $n=9$ case when I made the post and must have mixed it up. $\endgroup$ Feb 20, 2022 at 15:05

2 Answers 2

2
$\begingroup$

You can use the MaximizeOverPermutations resource function to find Monte-Carlo stochastic estimates of the maximum (with no guarantee of global maximality). With this method you can get "pretty good" solutions for very large $n$.

As an example, let's do $n=5$:

f[L_] := With[{n = Sqrt[Length[L]]}, Det[Partition[Mod[L, n, 1], n]]]

MOP = ResourceFunction["MaximizeOverPermutations"];
M = MOP[f, 25, Method -> {"MonteCarlo", "Iterations" -> 10^5,
                          "AnnealingParameter" -> 1}];
M[[2]]
(*    2196.    *)

Show the unique solution(s):

Partition[#, 5] & /@ Union[Mod[M[[1]], 5, 1]]
(*    {
        {{3, 1, 5, 4, 2},
         {2, 2, 1, 4, 5},
         {4, 4, 2, 5, 1},
         {1, 5, 4, 2, 3},
         {5, 3, 3, 1, 3}}
      }    *)

We can also do $n=9$:

M = MOP[f, 81, Method -> {"MonteCarlo", "Iterations" -> 10^5,
                          "AnnealingParameter" -> 1}];
M[[2]]
(*    9.02194*10^8    *)

(not quite reached @YusufBashi's maximum yet, need more iterations)

Partition[#, 9] & /@ Union[Mod[M[[1]], 9, 1]]
(*    {
        {{6, 7, 2, 4, 7, 1, 5, 9, 5},
         {7, 4, 7, 8, 9, 3, 2, 1, 4},
         {5, 9, 4, 6, 3, 5, 9, 1, 3},
         {1, 4, 2, 6, 7, 8, 5, 4, 9},
         {3, 1, 8, 7, 3, 2, 9, 6, 6},
         {8, 2, 2, 8, 2, 8, 4, 7, 3},
         {2, 8, 9, 5, 3, 6, 1, 7, 4},
         {9, 5, 6, 1, 2, 5, 4, 3, 9},
         {5, 3, 6, 1, 8, 8, 7, 6, 1}
      }    *)
$\endgroup$
1
$\begingroup$

Maybe use NMaximize.

n = 4;
A = Table[Indexed[x, {i, j}], {j, 1, n}, {i, 1, n}];
vars = Flatten[A];
solns = NMaximize[{Det[A], 1 <= vars <= n, vars ∈ Integers, 
    Plus @@ vars == n*Plus @@ Range[n], Times @@ vars == (n!)^n}, 
   vars][[2]]
A /. solns
A /. solns // Transpose

{{3, 4, 1, 2}, {3, 1, 3, 3}, {1, 4, 2, 4}, {1, 2, 4, 2}}

{{3, 3, 1, 1}, {4, 1, 4, 2}, {1, 3, 2, 4}, {2, 3, 4, 2}}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.