# Finding the divisors of the numbers 2 to 13 as a knapsack problem

I don't know how to write this as Latex formulas, but here are anyways two examples, the divisors of $$9$$ and $$12$$ as the solutions to knapsack problems.

Beware that there is some DeleteDuplicates[] sequence manipulation in Mathematica. I have tested this knapsack method for numbers $$2$$ to $$13$$ and it gives the divisors greater than 1 for those numbers.

(*start*)"knapsack problem"
nn = 9;
TableForm[solve = Solve[
x1 == 1 &&
x1 == x8 &&
x2 == x7 &&
x3 == x6 &&
x4 == x5 &&
0 < Abs[x2] < 2 &&
0 < Abs[x3] < 3 &&
0 < Abs[x4] < 4 &&
0 < Abs[x5] < 5 &&
0 < Abs[x6] < 6 &&
0 < Abs[x7] < 7 &&
0 < Abs[x8] < 8 &&
0 < Abs[x9] < 9 &&
x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 == 0,
{x1, x2, x3, x4, x5, x6, x7, x8, x9}, Integers]];
TableForm[
solutions =
Transpose[
Table[ReleaseHold[
MakeExpression[RowBox[{StringJoin["x", ToString[n]]}],
StandardForm]] /. solve, {n, 1, nn}]]];
"Number of solutions"
Length[solutions]
abs = Abs[1 - solutions];
table = Table[DeleteDuplicates[abs[[k]]], {k, 1, Length[abs]}];
minLength = Min[Table[Length[table[[k]]], {k, 1, Length[table]}]];
select = Select[table, Length[#] == minLength &];
deleteDuplicates = DeleteDuplicates[select];
"Divisors excluding 1"
DeleteCases[Flatten[deleteDuplicates], 0]
(*end*)


where the essential part is:

    x1 == 1 &&
x1 == x8 &&
x2 == x7 &&
x3 == x6 &&
x4 == x5 &&
0 < Abs[x2] < 2 &&
0 < Abs[x3] < 3 &&
0 < Abs[x4] < 4 &&
0 < Abs[x5] < 5 &&
0 < Abs[x6] < 6 &&
0 < Abs[x7] < 7 &&
0 < Abs[x8] < 8 &&
0 < Abs[x9] < 9 &&
x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 == 0,


(*start*)
"knapsack problem"
nn = 12;
TableForm[solve = Solve[
x1 == 1 &&
x1 == x11 &&
x2 == x10 &&
x3 == x9 &&
x4 == x8 &&
x5 == x7 &&
x6 == x6 &&
0 < Abs[x2] < 2 &&
0 < Abs[x3] < 3 &&
0 < Abs[x4] < 4 &&
0 < Abs[x5] < 5 &&
0 < Abs[x6] < 6 &&
0 < Abs[x7] < 7 &&
0 < Abs[x8] < 8 &&
0 < Abs[x9] < 9 &&
0 < Abs[x10] < 10 &&
0 < Abs[x11] < 11 &&
0 < Abs[x12] < 12 &&
x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 ==
0, {x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12},
Integers]];
TableForm[
solutions =
Transpose[
Table[ReleaseHold[
MakeExpression[RowBox[{StringJoin["x", ToString[n]]}],
StandardForm]] /. solve, {n, 1, nn}]]];
"Number of solutions"
Length[solutions]
abs = Abs[1 - solutions];
table = Table[DeleteDuplicates[abs[[k]]], {k, 1, Length[abs]}];
minLength = Min[Table[Length[table[[k]]], {k, 1, Length[table]}]];
select = Select[table, Length[#] == minLength &];
deleteDuplicates = DeleteDuplicates[select];
"Divisors excluding 1"
DeleteCases[Flatten[deleteDuplicates], 0]
(*end*)


where the essential part is:

    x1 == 1 &&
x1 == x11 &&
x2 == x10 &&
x3 == x9 &&
x4 == x8 &&
x5 == x7 &&
x6 == x6 &&
0 < Abs[x2] < 2 &&
0 < Abs[x3] < 3 &&
0 < Abs[x4] < 4 &&
0 < Abs[x5] < 5 &&
0 < Abs[x6] < 6 &&
0 < Abs[x7] < 7 &&
0 < Abs[x8] < 8 &&
0 < Abs[x9] < 9 &&
0 < Abs[x10] < 10 &&
0 < Abs[x11] < 11 &&
0 < Abs[x12] < 12 &&
x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 == 0,


Output for nn=9

{3, 9}

Output for nn=12

{2, 3, 4, 6, 12}

Can you explain/prove this?