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 don't use comments :-) 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], > Print[Union[Thread[Characters[rhs] -> res], lhsRulz]]]]; > 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 >