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>
- Solve - takes very long time