• To: mathgroup at smc.vnet.net
• Subject: [mg55028] Re: [mg55004] Google's aptitude test equation
• From: DrBob <drbob at bigfoot.com>
• Date: Thu, 10 Mar 2005 05:24:27 -0500 (EST)
• References: <200503091134.GAA06997@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```That's a brilliantly simple solution, although I'd replace

Select[sol, Unequal @@ (Part[#, 2] & /@ Cases[#, _Equal, 1]) &]

with

Select[sol, Unequal @@ #[[All, 2]] &]

which is virtually instantaneous.

As for Reduce, it can't check even ONE of the 449 solutions:

First@sol
%&&Unequal@@vars
Reduce[%]

c == 0 && d == 0 && e == 0 && g == 0 && l == 0 && m == 0 &&
o == 0 && t == 0 && w == 0

c == 0 && d == 0 && e == 0 &&
g == 0 && l == 0 && m == 0 &&
o == 0 && t == 0 && w == 0 &&
c != d != e != g != l != m !=
o != t != w

\$Aborted

or...

First@sol&&Reduce[Unequal@@vars]
Reduce@%

c == 0 && d == 0 && e == 0 &&
g == 0 && l == 0 && m == 0 &&
o == 0 && t == 0 && w == 0 &&
(c - d)*(c - e)*(d - e)*
(c - g)*(d - g)*(e - g)*
(c - l)*(d - l)*(e - l)*
(g - l)*(c - m)*(d - m)*
(e - m)*(g - m)*(l - m)*
(c - o)*(d - o)*(e - o)*
(g - o)*(l - o)*(m - o)*
(c - t)*(d - t)*(e - t)*
(g - t)*(l - t)*(m - t)*
(o - t)*(c - w)*(d - w)*
(e - w)*(g - w)*(l - w)*
(m - w)*(o - w)*(t - w) != 0

\$Aborted

Bobby

On Wed, 9 Mar 2005 06:34:29 -0500 (EST), Lorenzo Castelli <gcastelli at NOSPAMracine.ra.it> wrote:

> Hi everybody, I have a little question about Mathematica (version 5.1).
> Please note that I just began to use this program, so sorry if I'm missing
> some trivial points.
>
> As an exercise I've tried to resolve the Google's equation that appeared on
> the web some time ago, using this page as a reference:
>
> The text of the exercise is:
> 1. Solve this cryptic equation, realizing of course that values for M and E
> could be interchanged. No leading zeros are allowed.
> WWWDOT - GOOGLE = DOTCOM
>
> I've implemented the solution in Mathematica in this way:
>
> - Setup the problem:
> prob = "wwwdot" - "google" == "dotcom"
>
> - Setup the equation associated with the problem:
> eqn = prob /. s_String :> FromDigits[ToExpression[Characters[s]], 10]
>
> - Extract the variables of the equation:
> vars = Union[Cases[eqn, _Symbol, Infinity]]
>
> - Setup the constraints:
> ineqs = And @@ (0 <= # <= 9 & /@ vars)
>
> - Resolve the equation:
> (sol = Reduce[eqn && ineqs, vars, Integers]) // Timing
>
> This operation gives 449 solutions, calculated in roughly 13 seconds.
> Only two of these solutions are correct, since I have to remove the
> solutions which yield more than one variable to have the same value.
>
> Obviously this task is pretty easy, so I should expect it to take just a
> short time to compute.
> And that is actually the case if use a code like this:
>
> Select[sol, Unequal @@ (Part[#, 2] & /@ Cases[#, _Equal, 1]) &] // Timing
>
> The two solutions are extracted in a fraction of a second.
>
> On the contrary if I try to do that in the following way, Mathematica starts
> a long session of evaluation and eventually crashes after some minutes:
>
> Reduce[sol && Unequal @@ vars] // Timing
>
> I understand that Reduce might be too general to perform this operation in
> an efficient way, but I haven't been able to find a more suitable function.
>
> Also I've noticed that if I change the constraints on the single variables
> for the first Reduce in order to explicity consider that no leading zeros
> are allowed (so just replacing the 0<=x<=9 with 0<x<=9 for the variables w,
> g and d), the evaluation time jumps from 13 seconds to 40 seconds.
> That's odd, as in this case the new solutions are obviously just an easily
> computable subset of the previous ones.
>
> So I don't really know if Reduce is actually the best function even in the
> first usage.
>
> Can you help me out?
>
> Thanks,
>
> Lorenzo Castelli
> E-Mail: gcastelli at racine.ra.it
>
>
>
>

--
DrBob at bigfoot.com

```

• Prev by Date: Re: Canonical order...
• Next by Date: Re: Google's aptitude test equation