Re: Solving Alphametics with Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg38691] Re: Solving Alphametics with Mathematica
- From: atelesforos at hotmail.com (Orestis Vantzos)
- Date: Sun, 5 Jan 2003 06:33:58 -0500 (EST)
- References: <auuaku$pjh$1@smc.vnet.net> <av36pf$g00$1@smc.vnet.net> <av6kp3$o1m$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
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