Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

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




  • Prev by Date: Re: Solve - takes very long time
  • Next by Date: Re: Solve - takes very long time
  • Previous by thread: Re: Solve - takes very long time
  • Next by thread: Re: Solve - takes very long time