       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

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 == 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.

(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[].xvars[[1, All, 2]] >= 1 + yvars[].yvars[[1, All, 2]]

Out=
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=
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

Timing[
solns = Reduce[Join[c1, c2, c3, {c4, c5}], allvars, Integers];]
s2 = Map[Select[#, (#[] == 1 &)] &, solns];
s3 = Map[Partition[List @@ #, 3] &, s2];
s4 = Map[Most[#[]] == #[[1, 2]] &, s3, {3}];

Out= {5.75, Null}

Check how many solutions we have, and show the first few.

Length[s4]
s4[[1 ;; 5]]

Out= 168

Out= {{x == 9, x == 6, x == 5}, {y == 4, y == 1,
y == 2}, {z == 3, z == 8, z == 7}} || {{x == 9,
x == 6, x == 2}, {y == 4, y == 1,
y == 5}, {z == 3, z == 8, z == 7}} || {{x == 9,
x == 5, x == 6}, {y == 4, y == 2,
y == 1}, {z == 3, z == 8, z == 7}} || {{x == 9,
x == 5, x == 6}, {y == 4, y == 1,
y == 2}, {z == 3, z == 7, z == 8}} || {{x == 9,
x == 5, x == 3}, {y == 7, y == 2,
y == 1}, {z == 6, z == 8, z == 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