# Solving a cryptarithm

This problem appears on the mathematics stackexchange, which I summarize here as:

12 letters (a, b, c, d, e, f, g, h, k, l, m, n), are used to represent single digits, i.e., {0-9}. Given the following:

• d e f + f e f = g h h
• k l m + k l m = n k l
• a b c + a b c + a b c = b b b

There are a finite number of possibilities, so we can march through them and test, but is there smarter way to find the digits?

A naive application of Solve shows a trivial solution:

Solve[{3 c == Last@IntegerDigits[x],
Last@IntegerDigits[x] == b,
3 b + First@IntegerDigits[x] == Last@IntegerDigits[y],
Last@IntegerDigits[y] == b,
3 a + First@IntegerDigits[y] == b},
{a, b, c, x, y}]

(* {{a -> 0, b -> 0, c -> 0, x -> 0, y -> 0}} *)


What's the best way to use Mathematica to crack the code (identify the digits a through n)?

• Sorry I don't use mathematica, but the question seems almost irrelevant. Since the 3 equations are independent it makes little sense. I agree that A, B, C is 1,4,8. But K,L,M,N can be 4,2,1,8 as well as 2,6,3,5 so , I don't get it at all especially the 333,666, business.... there are other more varied answers... jim Mar 7, 2017 at 20:49
• @JimmyGee, I agree that this problem is frustrating if you are expecting it to make sense as a set of equations, but that's not really the point here ... this is a sort of number puzzle. Mar 8, 2017 at 10:11

# /. Solve[{   10^2 d + 10 e + f + 10^2 f + 10 e + f == 10^2 g + 10 h + h,
2 (10^2 k + 10 l + m) == 10^2 n + 10 k + l,
3 (10^2 a + 10 b + c) == 10^2 b + 10 b + b} ~ Join ~
Thread[0 <= # <= 9 &@#], #, Integers]& @ {a, b, c, d, e, f, g, h, k, l, m, n}
// Short[#, 6] &

 {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 5, 2},
{0, 0, 0, 0, 0, 0, 0, 0, 2, 6, 3, 5},
{0, 0, 0, 0, 0, 0, 0, 0, 3, 6, 8, 7},
{0, 0, 0, 0, 0, 0, 0, 0, 4, 2, 1, 8},
{0, 0, 0, 0, 1, 1, 1, 2, 0, 0, 0, 0},
<<739>>,
{1, 4, 8, 9, 0, 0, 9, 0, 0, 0, 0, 0},
{1, 4, 8, 9, 0, 0, 9, 0, 1, 0, 5, 2},
{1, 4, 8, 9, 0, 0, 9, 0, 2, 6, 3, 5},
{1, 4, 8, 9, 0, 0, 9, 0, 3, 6, 8, 7},
{1, 4, 8, 9, 0, 0, 9, 0, 4, 2, 1, 8}}


It yields the result instantanously. Mind Slot ( #) appears here in the three contexts, thus we had to put the symbol & in appropriate places where the pure functions end.

• Note that the equations are independent and the solution space can be represented as a cartesian product. (+1) Mar 7, 2017 at 12:40
• @MichaelE2 Thanks, I can make this code nicer, however {a, b, d, f, g, k, n} should start from 1 rather than form 0 thus it makes any improvement a bit cumbersome. Mar 7, 2017 at 12:53
v = {100, 10, 1};

{#, Variables[List @@ #]} & /@
{
v.{d, e, f} + v.{f, e, f} == v.{g, h, h},
2*v.{k, l, m} == v.{n, k, l},
3*v.{a, b, c} == v.{b, b, b}
}

FindInstance[Join[{#}, Thread[10 > #2 > 0]], #2, Integers] & @@@ %

{{{d -> 3, e -> 3, f -> 3, g -> 6, h -> 6}},
{{k -> 2, l -> 6, m -> 3, n -> 5}},
{{a -> 1, b -> 4, c -> 8}}}

• Very nice, this returns solution 543 from the full listing given by @Artes answer. Does FindInstance call Solve or something similar internally, or is it independent? Mar 7, 2017 at 15:48
• @dionys Good question. I think it is independent but I have never really examined that. Typically Solve looks for a pure analytic solution, but in a case like this it can enumerate numeric solutions as well, I believe using Reduce. Mar 7, 2017 at 20:26

Brute force:

lab = {"a", "b", "c", "d", "e", "f", "g", "h", "k", "l", "m", "n"};
tu[n_] := Tuples[Range[0, 9], n];
f1 = IntegerDigits[{#[[1]] + #[[3]], 2 #[[2]], 2 #[[3]]}.{100, 10,
1}] &
c1 = Select[tu[5],
Length[f1[#]] < 4 &&
PadLeft[f1[#], 3] == {#[[4]], #[[5]], #[[5]]} &];
f2 = IntegerDigits[2 {#[[1]], #[[2]], #[[3]]}.{100, 10, 1}] &
c2 =
Select[tu[4],
Length[f2[#]] < 4 &&
PadLeft[f2[#], 3] == {#[[4]], #[[1]], #[[2]]} &];
f3 = IntegerDigits[3 {#[[1]], #[[2]], #[[3]]}.{100, 10, 1}] &;
c3 = Select[tu[3],
Length[f3[#]] < 4 &&
PadLeft[f3[#], 3] == {#[[2]], #[[2]], #[[2]]} &];
ans = Catenate /@ Tuples[{c3, c1, c2}];
TableForm[ans[[-10 ;; -1]], TableHeadings -> {None, lab}]


The last 10 of the 750 answers: