Re: Solving Alphametics with Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg38650] Re: Solving Alphametics with Mathematica
- From: atelesforos at hotmail.com (Orestis Vantzos)
- Date: Fri, 3 Jan 2003 00:15:20 -0500 (EST)
- References: <auuaku$pjh$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
A fairly literal implementation of the problem:
criterion[lst:{b_,a_,s_,e_,l_}]/;Length[Union[lst]]==5:=
Module[{base=FromDigits[{b,a,s,e}],ball=FromDigits[{b,a,l,l}],games},
games=IntegerDigits[base+ball];
MatchQ[games,{g_,a,m_,e,s}/;Length[Union[{g,m},lst]]==7]]
criterion[_]=False;
Table[If[criterion@IntegerDigits[n, 10, 5], Print[n]], {n, 0, 10^5 - 1}];
74835
Which means that B=7,A=4,S=8,E=3,L=5,
so that:
BASE+BALL=GAMES
is
7483+7455=14938
Orestis
David Jameson <nospam at nospam.digiportal.com> wrote in message news:<auuaku$pjh$1 at smc.vnet.net>...
> Anyone know how to use Mathematic to solve Alphametics puzzles?
> For example, the sum
>
> B A S E
> + B A L L
> -------------------
> G A M E S
>
> has only one solution in base 10. I've tried several ways of represent this
> "sum" in Mathematica but have not been able to get it to solve it.
>
> There are lots of other examples of these puzzles at
> http://www.creativepuzzels.nl/spel/speel1/frameng.htm
> if anyone is interested.
>
> Cheers,
> David Jameson