# Speeding up calculation of global maximum

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][];

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

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


I am looking to use this code to maximize the determinant of an nXn matrix which contains only digits 1-9, each of which must appear exactly n times. Currently, this code is very slow for values of n greater than 3, and I was wondering if there is a way to parallelize the code in order to complete the necessary calculations at a much faster rate. An even better solution would be to use my GPU to complete the required calculations, however I am not sure how to implement either of these solutions.

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][]
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}}`