Re: Solving Alphametics with Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg39526] Re: Solving Alphametics with Mathematica
• From: David Jameson <nospam at nospam.digiportal.com>
• Date: Fri, 21 Feb 2003 04:08:14 -0500 (EST)
• References: <auuaku\$pjh\$1@smc.vnet.net> <av36pf\$g00\$1@smc.vnet.net> <av6kp3\$o1m\$1@smc.vnet.net> <av955q\$sbp\$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Very impressive....more for me to study   (I guess Mathematica programmers

Seriously though, thanks for taking the time to generalise this solution - I
appreciate it very much.

D

--

"Orestis Vantzos" <atelesforos at hotmail.com> wrote in message
news:av955q\$sbp\$1 at smc.vnet.net...
> OK, here it goes:
>
> solveAlphametic[lhs_ == rhs_] :=
>   Module[{lhsChars, rhsChars, check},
>     lhsChars = Union @@ Cases[lhs, s_String :> Characters[s],
> Infinity];
>     rhsChars = Complement[Characters[rhs], lhsChars];
>     With[{len = Length[lhsChars], lhsChars = lhsChars},
>       check[lst_] /; Length[Union[lst]] == len :=
>         Module[{lhsRulz, res, rhsPattern},
>          lhsRulz = Thread[lhsChars -> lst];
>           res = IntegerDigits[lhs /. s_String :>
> FromDigits[Characters[s] /. lhsRulz]];
>           rhsPattern =
>            With[{rhsSymbols = Symbol /@ rhsChars,
>              rhsRulz = (# -> Pattern[Evaluate[Symbol[#]], _] & ) /@
> rhsChars},
>             (Characters[rhs] /. lhsRulz /. rhsRulz) /;
> Intersection[rhsSymbols, lst] == {}];
>           If[MatchQ[res, rhsPattern],
>        Do[check[IntegerDigits[n, 10, len]], {n, 1, 10^len - 1}]]
>   ]
>
> In[34]:=
> solveAlphametic["ball" + "base" == "games"]
>
> {a -> 4, b -> 7, e -> 3, g -> 1, l -> 5, m -> 9, s -> 8}
>
> This code is much more involved, but (hopefully) solves many
> alphametics.
> OK, let's say we want to check whether 45679 is a solution.
> Check does the following:
> 45679 is turned into {4,5,6,7,9}
> It is checked to see whether it contains duplicate digits
> (Length[Union[lst]]==len).
> lhsRulz = {"a"->4, "b"->5, "e"->6, "l"->7, "s"->9}
> "ball"+"base" is evaluated in one pass using the lhsRulz to give
>    5477+5496 = 10973 ---> res = {1,0,9,7,3}
> Now we create rhsPattern which is a template for what "games" should
> be:
> rhsPattern = {g_, 4, m_, 6, 9}/;Intersection[{g,m},{4,5,6,7,9}]=={}
> Comparing res with rhsPattern we see that it is not so, and check
> proceeds to the next number.
> Should our number be a solution, we create a set of replacements for
> "games" -similar to lhsRulz- unify it with lhsRulz and display it.
>
> Hope that helped,
> Orestis
>

• Prev by Date: RE: Changing style in Plot
• Next by Date: Re: Re: Porting graphics to MicroSoft Point, with quality - no
• Previous by thread: Re: Converting Animations to QuickTime Movies Using iView MediaPro
• Next by thread: Epsilon-Delta proofs