2
$\begingroup$

Distribute the numbers from 1 to 10(view image) so that the sum of each row and each column is the same and a) the maximum possible b) the minimum possible (I put it from 1 to 10 for ease)

I know it is a problem that could work with matrices or lists but I can't think how to start

Image

Edition: Clarification of the sums that must be equal

Image

$\endgroup$
5
$\begingroup$

Index the cells:

1 * * 2
3 4 5 6
7 * * 8
9 * * 10

Define a $10\times 10$ zero-one matrix $M$, where $M_{i,j}=1$ iff number $i$ is in $j^\text{th}$ cell, and $0$ otherwise.

Constraints:

  • Every number in unique cell: $\sum_j M_{I,j}=1 \quad \forall_I$
  • Every cell has unique number: $\sum_i M_{i,J}=1 \quad \forall_J$
  • $n_j=$ (Number in $j^\text{th}$ cell) $=\sum_i {(i M_{i,j})}$, hence $n_1+n_2=n_3+n_4+n_5+n_6=\dots$

Into Mathematica code:

cons1 = Table[Sum[m[i, j], {j, 10}] == 1, {i, 10}];

cons2 = Table[Sum[m[i, j], {i, 10}] == 1, {j, 10}];

n[j_] := Sum[i*m[i, j], {i, 10}]
cons3 = Equal @@ 
  Append[Plus @@@ 
    Map[n, {{1, 2}, {3, 4, 5, 6}, {7, 8}, {9, 10}, {1, 3, 7, 
       9}, {4}, {5}, {2, 6, 8, 10}}, {-1}], k];

domCons = {k \[Element] PositiveIntegers, 
  Table[{0 <= m[i, j] <= 1, m[i, j] \[Element] Integers}, {i, 10}, {j,
     10}]};

vars = Append[Flatten@Table[m[i, j], {i, 10}, {j, 10}], k];

Then optimize the sum k with the linear constraints:

LinearOptimization[k, {cons1, cons2, cons3, domCons}, vars]

We'll see this problem is unsolvable:

LinearOptimization::nsolc: There are no points that satisfy the constraints.

Generalization is similar.

Update

I misread the problem. In this case we only need to modify cons3 so that $n_3+n_4+n_5+n_6=n_1+n_3+n_7+n_9=n_2+n_6+n_8+n_{10}$:

cons3 = Equal @@ 
   Append[Plus @@@ 
     Map[n, {{3, 4, 5, 6}, {1, 3, 7, 9}, {2, 6, 8, 10}}, {-1}], k];

a) the maximum possible

Run LinearOptimization[-k, ...] to get maximum sum 24:

{m[1, 1] -> 1, m[1, 2] -> 0, m[1, 3] -> 0, m[1, 4] -> 0, m[1, 5] -> 0,
  m[1, 6] -> 0, m[1, 7] -> 0, m[1, 8] -> 0, m[1, 9] -> 0, 
 m[1, 10] -> 0, m[2, 1] -> 0, m[2, 2] -> 0, m[2, 3] -> 0, 
 m[2, 4] -> 1, m[2, 5] -> 0, m[2, 6] -> 0, m[2, 7] -> 0, m[2, 8] -> 0,
  m[2, 9] -> 0, m[2, 10] -> 0, m[3, 1] -> 0, m[3, 2] -> 0, 
 m[3, 3] -> 0, m[3, 4] -> 0, m[3, 5] -> 0, m[3, 6] -> 0, m[3, 7] -> 0,
  m[3, 8] -> 0, m[3, 9] -> 0, m[3, 10] -> 1, m[4, 1] -> 0, 
 m[4, 2] -> 0, m[4, 3] -> 0, m[4, 4] -> 0, m[4, 5] -> 0, m[4, 6] -> 0,
  m[4, 7] -> 0, m[4, 8] -> 0, m[4, 9] -> 1, m[4, 10] -> 0, 
 m[5, 1] -> 0, m[5, 2] -> 0, m[5, 3] -> 0, m[5, 4] -> 0, m[5, 5] -> 1,
  m[5, 6] -> 0, m[5, 7] -> 0, m[5, 8] -> 0, m[5, 9] -> 0, 
 m[5, 10] -> 0, m[6, 1] -> 0, m[6, 2] -> 1, m[6, 3] -> 0, 
 m[6, 4] -> 0, m[6, 5] -> 0, m[6, 6] -> 0, m[6, 7] -> 0, m[6, 8] -> 0,
  m[6, 9] -> 0, m[6, 10] -> 0, m[7, 1] -> 0, m[7, 2] -> 0, 
 m[7, 3] -> 0, m[7, 4] -> 0, m[7, 5] -> 0, m[7, 6] -> 1, m[7, 7] -> 0,
  m[7, 8] -> 0, m[7, 9] -> 0, m[7, 10] -> 0, m[8, 1] -> 0, 
 m[8, 2] -> 0, m[8, 3] -> 0, m[8, 4] -> 0, m[8, 5] -> 0, m[8, 6] -> 0,
  m[8, 7] -> 0, m[8, 8] -> 1, m[8, 9] -> 0, m[8, 10] -> 0, 
 m[9, 1] -> 0, m[9, 2] -> 0, m[9, 3] -> 0, m[9, 4] -> 0, m[9, 5] -> 0,
  m[9, 6] -> 0, m[9, 7] -> 1, m[9, 8] -> 0, m[9, 9] -> 0, 
 m[9, 10] -> 0, m[10, 1] -> 0, m[10, 2] -> 0, m[10, 3] -> 1, 
 m[10, 4] -> 0, m[10, 5] -> 0, m[10, 6] -> 0, m[10, 7] -> 0, 
 m[10, 8] -> 0, m[10, 9] -> 0, m[10, 10] -> 0, k -> 24}

Visualization (see below):

$$ \left( \begin{array}{cccc} 1 & \_ & \_ & 6 \\ 10 & 2 & 5 & 7 \\ 9 & \_ & \_ & 8 \\ 4 & \_ & \_ & 3 \\ \end{array} \right) $$

b) the minimum possible

Run LinearOptimization[k, ...] to get minimum sum 20:

{m[1, 1] -> 0, m[1, 2] -> 0, m[1, 3] -> 0, m[1, 4] -> 0, m[1, 5] -> 0,
  m[1, 6] -> 1, m[1, 7] -> 0, m[1, 8] -> 0, m[1, 9] -> 0, 
 m[1, 10] -> 0, m[2, 1] -> 0, m[2, 2] -> 0, m[2, 3] -> 0, 
 m[2, 4] -> 0, m[2, 5] -> 0, m[2, 6] -> 0, m[2, 7] -> 1, m[2, 8] -> 0,
  m[2, 9] -> 0, m[2, 10] -> 0, m[3, 1] -> 0, m[3, 2] -> 0, 
 m[3, 3] -> 0, m[3, 4] -> 0, m[3, 5] -> 0, m[3, 6] -> 0, m[3, 7] -> 0,
  m[3, 8] -> 0, m[3, 9] -> 0, m[3, 10] -> 1, m[4, 1] -> 0, 
 m[4, 2] -> 0, m[4, 3] -> 1, m[4, 4] -> 0, m[4, 5] -> 0, m[4, 6] -> 0,
  m[4, 7] -> 0, m[4, 8] -> 0, m[4, 9] -> 0, m[4, 10] -> 0, 
 m[5, 1] -> 0, m[5, 2] -> 0, m[5, 3] -> 0, m[5, 4] -> 0, m[5, 5] -> 0,
  m[5, 6] -> 0, m[5, 7] -> 0, m[5, 8] -> 0, m[5, 9] -> 1, 
 m[5, 10] -> 0, m[6, 1] -> 0, m[6, 2] -> 1, m[6, 3] -> 0, 
 m[6, 4] -> 0, m[6, 5] -> 0, m[6, 6] -> 0, m[6, 7] -> 0, m[6, 8] -> 0,
  m[6, 9] -> 0, m[6, 10] -> 0, m[7, 1] -> 0, m[7, 2] -> 0, 
 m[7, 3] -> 0, m[7, 4] -> 1, m[7, 5] -> 0, m[7, 6] -> 0, m[7, 7] -> 0,
  m[7, 8] -> 0, m[7, 9] -> 0, m[7, 10] -> 0, m[8, 1] -> 0, 
 m[8, 2] -> 0, m[8, 3] -> 0, m[8, 4] -> 0, m[8, 5] -> 1, m[8, 6] -> 0,
  m[8, 7] -> 0, m[8, 8] -> 0, m[8, 9] -> 0, m[8, 10] -> 0, 
 m[9, 1] -> 1, m[9, 2] -> 0, m[9, 3] -> 0, m[9, 4] -> 0, m[9, 5] -> 0,
  m[9, 6] -> 0, m[9, 7] -> 0, m[9, 8] -> 0, m[9, 9] -> 0, 
 m[9, 10] -> 0, m[10, 1] -> 0, m[10, 2] -> 0, m[10, 3] -> 0, 
 m[10, 4] -> 0, m[10, 5] -> 0, m[10, 6] -> 0, m[10, 7] -> 0, 
 m[10, 8] -> 1, m[10, 9] -> 0, m[10, 10] -> 0, k -> 20}

$$ \left( \begin{array}{cccc} 9 & \_ & \_ & 6 \\ 4 & 7 & 8 & 1 \\ 2 & \_ & \_ & 10 \\ 5 & \_ & \_ & 3 \\ \end{array} \right) $$


Addendum

If we loosen the constraints so that only the sums of 1st row and 2nd row are equal:

cons3 = Equal @@ 
  Append[Plus @@@ Map[n, {{1, 2}, {3, 4, 5, 6}}, {-1}], k];

This is a solvable case:

solution = LinearOptimization[k, {cons1, cons2, cons3, domCons}, vars]
{m[1, 1] -> 0, m[1, 2] -> 0, m[1, 3] -> 0, m[1, 4] -> 0, m[1, 5] -> 0,
  m[1, 6] -> 1, m[1, 7] -> 0, m[1, 8] -> 0, m[1, 9] -> 0, 
 m[1, 10] -> 0, m[2, 1] -> 0, m[2, 2] -> 0, m[2, 3] -> 0, 
 m[2, 4] -> 0, m[2, 5] -> 1, m[2, 6] -> 0, m[2, 7] -> 0, m[2, 8] -> 0,
  m[2, 9] -> 0, m[2, 10] -> 0, m[3, 1] -> 0, m[3, 2] -> 0, 
 m[3, 3] -> 0, m[3, 4] -> 1, m[3, 5] -> 0, m[3, 6] -> 0, m[3, 7] -> 0,
  m[3, 8] -> 0, m[3, 9] -> 0, m[3, 10] -> 0, m[4, 1] -> 0, 
 m[4, 2] -> 1, m[4, 3] -> 0, m[4, 4] -> 0, m[4, 5] -> 0, m[4, 6] -> 0,
  m[4, 7] -> 0, m[4, 8] -> 0, m[4, 9] -> 0, m[4, 10] -> 0, 
 m[5, 1] -> 0, m[5, 2] -> 0, m[5, 3] -> 1, m[5, 4] -> 0, m[5, 5] -> 0,
  m[5, 6] -> 0, m[5, 7] -> 0, m[5, 8] -> 0, m[5, 9] -> 0, 
 m[5, 10] -> 0, m[6, 1] -> 0, m[6, 2] -> 0, m[6, 3] -> 0, 
 m[6, 4] -> 0, m[6, 5] -> 0, m[6, 6] -> 0, m[6, 7] -> 1, m[6, 8] -> 0,
  m[6, 9] -> 0, m[6, 10] -> 0, m[7, 1] -> 1, m[7, 2] -> 0, 
 m[7, 3] -> 0, m[7, 4] -> 0, m[7, 5] -> 0, m[7, 6] -> 0, m[7, 7] -> 0,
  m[7, 8] -> 0, m[7, 9] -> 0, m[7, 10] -> 0, m[8, 1] -> 0, 
 m[8, 2] -> 0, m[8, 3] -> 0, m[8, 4] -> 0, m[8, 5] -> 0, m[8, 6] -> 0,
  m[8, 7] -> 0, m[8, 8] -> 0, m[8, 9] -> 0, m[8, 10] -> 1, 
 m[9, 1] -> 0, m[9, 2] -> 0, m[9, 3] -> 0, m[9, 4] -> 0, m[9, 5] -> 0,
  m[9, 6] -> 0, m[9, 7] -> 0, m[9, 8] -> 0, m[9, 9] -> 1, 
 m[9, 10] -> 0, m[10, 1] -> 0, m[10, 2] -> 0, m[10, 3] -> 0, 
 m[10, 4] -> 0, m[10, 5] -> 0, m[10, 6] -> 0, m[10, 7] -> 0, 
 m[10, 8] -> 1, m[10, 9] -> 0, m[10, 10] -> 0, k -> 11}

Visualization:

dp = Dispatch[{1 -> {1, 1}, 2 -> {1, 4}, 3 -> {2, 1}, 4 -> {2, 2}, 
   5 -> {2, 3}, 6 -> {2, 4}, 7 -> {3, 1}, 8 -> {3, 4}, 9 -> {4, 1}, 
   10 -> {4, 4}}];
SparseArray[
  KeyValueMap[#2[[1]] -> #1 &]@GroupBy[
    Most[solution],
    #[[1, 1]] & -> (If[#[[2]] == 1, #[[1, 2]] /. dp, Nothing] &)
    ],
  {4, 4}, _] // MatrixForm

$$ \left( \begin{array}{cccc} 7 & \_ & \_ & 4 \\ 5 & 3 & 2 & 1 \\ 6 & \_ & \_ & 10 \\ 9 & \_ & \_ & 8 \\ \end{array} \right) $$

We validate that $7+4=5+3+2+1=11=k$.

| improve this answer | |
$\endgroup$
  • $\begingroup$ @ SneezeFor16Mim thanks for helping, but it seems to me that you misunderstood the problem as it also happened to me when I read it the first time, the image shows you the sums that should be the same,see issue of problem. $\endgroup$ – BeTDa Jun 29 at 0:37
  • $\begingroup$ @BeTDa Oh yes... What was I thinking yesterday :^( But that's fairly easy as all you need to do is to modify cons3. I'll update the answer later. $\endgroup$ – SneezeFor16Min Jun 29 at 3:24
  • $\begingroup$ @BeTDa Updated. $\endgroup$ – SneezeFor16Min Jun 29 at 5:45
  • $\begingroup$ ,I have executed your code making the necessary modifications but I get this error LinearOptimization::vedom: The constraints include restrictions of some variables to the domain Currently there is only support for the Reals. and I do not arrive at the result, and even less at the matrix representation .I'll put the execution somewhere $\endgroup$ – BeTDa Jun 29 at 19:32
  • $\begingroup$ look here drive.google.com/file/d/1Zz4LOj6BP4UD9A2oEzE5iIbWXw7sf0zc/… ,I use mathematica 12.0, I don't know if it influences something $\endgroup$ – BeTDa Jun 29 at 19:43
2
$\begingroup$

Sheer brute force is also an option if you need to generate lots of solutions and it's very fast. Here we randomly permute the range [1,10], saving permutations when the totals are equal:

results = DeleteDuplicates@Reap[Do[
      s = RandomSample[Range[10]];
      If[Total[s[[1 ;; 4]]] == Total[s[[5 ;; 8]]] == 
        s[[2]] + s[[6]] + Total[s[[9 ;; 10]]], Sow[s]]
      , 100000]][[-1, 1]];

In any given result, the first 4 elements are the column S1, the next four S2, and the last two elements are the middle two from S3. I'd say I got around 200 results on average each time I ran it. Here's a sample:

{{2, 7, 9, 3, 10, 1, 6, 4, 5, 8}, {10, 1, 6, 3, 2, 4, 9, 5, 7, 8}, {2,
   1, 10, 7, 8, 4, 3, 5, 9, 6}, {1, 6, 5, 9, 8, 2, 7, 4, 3, 10}, {9, 
  4, 8, 1, 2, 7, 10, 3, 5, 6}, {4, 2, 7, 8, 1, 6, 5, 9, 3, 10}, {9, 4,
   3, 6, 8, 7, 5, 2, 1, 10}, {4, 6, 9, 3, 8, 5, 7, 2, 1, 10}, {3, 7, 
  2, 10, 8, 4, 1, 9, 6, 5}, {2, 10, 3, 7, 4, 1, 8, 9, 5, 6}, {1, 2, 9,
   8, 7, 3, 6, 4, 5, 10}, {7, 1, 6, 8, 4, 10, 3, 5, 9, 2}}

I'd like to show it is possible to do it with FindInstance but it is very much slower than LinearOptimization used in @SneezeFor16Min's answer:

s1vars = Array[s1, 4];
s2vars = Array[s2, 4];
s3vars = {s1[2], s3[1], s3[2], s2[2]};
allvars = Union[Join @@ {s1vars, s2vars, s3vars}];
constraints = (
   (*totals are the same*)
   Total[s1vars] == Total[s2vars] == Total[s3vars]
    (*all numbers unique*)
    && (And @@ (Unequal @@@ Subsets[allvars, {2}]))
    (*all numbers in 1 to 10*)
    && (And @@ (1 <= # <= 10 & /@ allvars)));
sol = FindInstance[constraints, allvars, Integers]

mtx = {{s1[1], x, x, s2[1]},
   {s1[2], s3[1], s3[2], s2[2]},
   {s1[3], x, x, s2[3]},
   {s1[4], x, x, s2[4]}};

MatrixForm[mtx /. First[sol]] /. x -> ""

$$ \left( \begin{array}{cccc} 1 & & & 4 \\ 2 & 6 & 9 & 3 \\ 7 & & & 5 \\ 10 & & & 8 \\ \end{array} \right) $$

You can try to get other solutions, for example: FindInstance[constraints, allvars, Integers, 5] but you will be waiting a very long time. However, note you can easily generate some new solutions with the same totals from any existing one by permuting the column elements not connected to S3 and the two middle elements on S3, as well as swapping the columns over.

| improve this answer | |
$\endgroup$
  • $\begingroup$ ,Thanks for answering, I am studying your way of doing things, I am new to programming something, so I take a while to understand some things. $\endgroup$ – BeTDa Jun 29 at 19:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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