1
$\begingroup$

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?

$\endgroup$
1

0

Your Answer

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

Browse other questions tagged or ask your own question.