Re: Solve - takes very long time

*To*: mathgroup at smc.vnet.net*Subject*: [mg121822] Re: Solve - takes very long time*From*: Daniel Lichtblau <danl at wolfram.com>*Date*: Tue, 4 Oct 2011 01:30:42 -0400 (EDT)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com*References*: <201110030821.EAA08778@smc.vnet.net>

On 10/03/2011 03:21 AM, Fredob wrote: > Hi, > > I tried the following on Mathematica 8 and it doesn't seem to stop > running (waited 40 minutes on a 2.6 Ghz processor w 6 GB of primary > memory). > > Solve[ > {100*Subscript[x, 2] + 10*Subscript[x, 1] + Subscript[x, 0] + > 100*Subscript[y, 2] + 10*Subscript[y, 1] + Subscript[y, 0] == > 100*Subscript[z, 2] + 10*Subscript[z, 1] + Subscript[z, 0], > Subscript[x, 0]> 0, Subscript[y, 0]> 0, Subscript[z, 0]> 0, > Subscript[x, 1]> 0, Subscript[y, 1]> 0, Subscript[z, 1]> 0, > Subscript[x, 2]> 0, Subscript[y, 2]> 0, Subscript[z, 2]> 0, > Subscript[x, 0]<= 9, Subscript[y, 0]<= 9, Subscript[z, 0]<= 9, > Subscript[x, 1]<= 9, Subscript[y, 1]<= 9, Subscript[z, 1]<= 9, > Subscript[x, 2]<= 9, Subscript[y, 2]<= 9, Subscript[z, 2]<= 9, > Subscript[x, 0] != Subscript[y, 0] != Subscript[z, 0] != Subscript[ > x, 1] != Subscript[y, 1] != Subscript[z, 1] != Subscript[x, 2] != > Subscript[y, 2] != Subscript[z, 2]}, > {Subscript[x, 2], Subscript[y, 2], Subscript[z, 2], Subscript[x, 1], > Subscript[y, 1], Subscript[z, 1], Subscript[x, 0], Subscript[y, 0], > Subscript[z, 0] }, > Integers] > > The problem was a homework for my daugther where you are supposed to > use all digits to build - but only once - 2 three digit numbers and > addition. The problem is in the inequalities. Enforcing them means (to Solve) that nonlinear equations will be needed. They will have the form (Subscript[x, 0]- Subscript[y, 0])*xyreciprocal[0] == 1 which simply is a way of making that difference not vanish. So we add such new equations (and corresponding reciprocal variables) for every pair of unequal original variables. That's a bunch of quadratics. As if that's not bad enought from a computational complexity point of view, we are enforcing integrality. Probably hopeless to do in this way. A different way to go about this is to subdivide each digit into nine (sub) variables, where each will be 0 or 1, and exactly one will be 1. This is enforced using linear equalities and inequalities. We furthermore insist that exactly one from the 1's be 1, likewise exactly 1 from the 2's, etc. Can be done as below. Also observe that there is symmetry in the usage of x and y variables. To cut in half the number of solutions we can disambiguate by making one particular x digit larger than its corresponding y counterpart. That is the purpose of the constraint c5 below. xvars = Array[x, {3, 9}, {0, 1}]; yvars = Array[y, {3, 9}, {0, 1}]; zvars = Array[z, {3, 9}, {0, 1}]; allvars = Flatten[{xvars, yvars, zvars}]; c1 = Map[0 <= # <= 1 &, allvars]; c2 = Map[Total[#] == 1 &, Join[xvars, yvars, zvars], {1}]; c3 = Map[Total[#] == 1 &, Transpose[Join[xvars, yvars, zvars]]]; powers = 10^Range[0, 2]; c4 = Map[#.#[[All, 2]] &, xvars].powers + Map[#.#[[All, 2]] &, yvars].powers == Map[#.#[[All, 2]] &, zvars].powers c5 = xvars[[1]].xvars[[1, All, 2]] >= 1 + yvars[[1]].yvars[[1, All, 2]] Out[1145]= x[0, 1] + 2 x[0, 2] + 3 x[0, 3] + 4 x[0, 4] + 5 x[0, 5] + 6 x[0, 6] + 7 x[0, 7] + 8 x[0, 8] + 9 x[0, 9] + 10 (x[1, 1] + 2 x[1, 2] + 3 x[1, 3] + 4 x[1, 4] + 5 x[1, 5] + 6 x[1, 6] + 7 x[1, 7] + 8 x[1, 8] + 9 x[1, 9]) + 100 (x[2, 1] + 2 x[2, 2] + 3 x[2, 3] + 4 x[2, 4] + 5 x[2, 5] + 6 x[2, 6] + 7 x[2, 7] + 8 x[2, 8] + 9 x[2, 9]) + y[0, 1] + 2 y[0, 2] + 3 y[0, 3] + 4 y[0, 4] + 5 y[0, 5] + 6 y[0, 6] + 7 y[0, 7] + 8 y[0, 8] + 9 y[0, 9] + 10 (y[1, 1] + 2 y[1, 2] + 3 y[1, 3] + 4 y[1, 4] + 5 y[1, 5] + 6 y[1, 6] + 7 y[1, 7] + 8 y[1, 8] + 9 y[1, 9]) + 100 (y[2, 1] + 2 y[2, 2] + 3 y[2, 3] + 4 y[2, 4] + 5 y[2, 5] + 6 y[2, 6] + 7 y[2, 7] + 8 y[2, 8] + 9 y[2, 9]) == z[0, 1] + 2 z[0, 2] + 3 z[0, 3] + 4 z[0, 4] + 5 z[0, 5] + 6 z[0, 6] + 7 z[0, 7] + 8 z[0, 8] + 9 z[0, 9] + 10 (z[1, 1] + 2 z[1, 2] + 3 z[1, 3] + 4 z[1, 4] + 5 z[1, 5] + 6 z[1, 6] + 7 z[1, 7] + 8 z[1, 8] + 9 z[1, 9]) + 100 (z[2, 1] + 2 z[2, 2] + 3 z[2, 3] + 4 z[2, 4] + 5 z[2, 5] + 6 z[2, 6] + 7 z[2, 7] + 8 z[2, 8] + 9 z[2, 9]) Out[1146]= x[0, 1] + 2 x[0, 2] + 3 x[0, 3] + 4 x[0, 4] + 5 x[0, 5] + 6 x[0, 6] + 7 x[0, 7] + 8 x[0, 8] + 9 x[0, 9] >= 1 + y[0, 1] + 2 y[0, 2] + 3 y[0, 3] + 4 y[0, 4] + 5 y[0, 5] + 6 y[0, 6] + 7 y[0, 7] + 8 y[0, 8] + 9 y[0, 9] With all this we now have a set of integer linear equations and inequalities. Reduce can handle it. After which we massage to put into a readable form. Timing[ solns = Reduce[Join[c1, c2, c3, {c4, c5}], allvars, Integers];] s2 = Map[Select[#, (#[[2]] == 1 &)] &, solns]; s3 = Map[Partition[List @@ #, 3] &, s2]; s4 = Map[Most[#[[1]]] == #[[1, 2]] &, s3, {3}]; Out[1181]= {5.75, Null} Check how many solutions we have, and show the first few. Length[s4] s4[[1 ;; 5]] Out[1185]= 168 Out[1186]= {{x[0] == 9, x[1] == 6, x[2] == 5}, {y[0] == 4, y[1] == 1, y[2] == 2}, {z[0] == 3, z[1] == 8, z[2] == 7}} || {{x[0] == 9, x[1] == 6, x[2] == 2}, {y[0] == 4, y[1] == 1, y[2] == 5}, {z[0] == 3, z[1] == 8, z[2] == 7}} || {{x[0] == 9, x[1] == 5, x[2] == 6}, {y[0] == 4, y[1] == 2, y[2] == 1}, {z[0] == 3, z[1] == 8, z[2] == 7}} || {{x[0] == 9, x[1] == 5, x[2] == 6}, {y[0] == 4, y[1] == 1, y[2] == 2}, {z[0] == 3, z[1] == 7, z[2] == 8}} || {{x[0] == 9, x[1] == 5, x[2] == 3}, {y[0] == 7, y[1] == 2, y[2] == 1}, {z[0] == 6, z[1] == 8, z[2] == 4}} Yet another approach might be to use Boolean algebra. I suspect that too can be made to work well with this problem. Daniel Lichtblau Wolfram Research

**References**:**Solve - takes very long time***From:*Fredob <fredrik.doberl@gmail.com>