Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm trying to get better at Mathematica and in the book I'm using (by Nancy Blachman) is the following question (which apparently was taken from another book: The Art and Science of C) which reads:

On a standard telephone keypad, the digits are mapped onto the alphabet (minus the letters Q and Z) as shown below:

        ABC     DEF
 1       2       3
GHI     JKL     MNO
 4       5       6
PRS     TUV     WXY
 7       8       9

Write a function phoneSpell that generates all possible letter combinations that correspond to a given number, represented as a string of digits. For example, if you call phoneSpell[652], your function should generate the 27 possible letter combinations corresponding to that prefix, namely

{"MJA", "MJB", "MJC", "MKA", "MKB", "MKC", "MLA", "MLB", "MLC", 
"NJA", "NJB", "NJC", "NKA", "NKB", "NKC", "NLA", "NLB", "NLC", "OJA",
"OJB", "OJC", "OKA", "OKB", "OKC", "OLA", "OLB", "OLC"}

Note that if the argument passed to phoneSpell contains a 0 or 1, that position in the output should simply be displayed as that digit, since there are no letters that correspond to it.

I've tried various things like first converting the number to a String using ToString and getting the Length using StringLength. I've tried a combination of Outer and Tuples to get the different combinations, but I'm not getting much luck. Any pointers in the right direction will be appreciated. Thanks.

share|improve this question

3 Answers 3

up vote 3 down vote accepted

Here is one approach that does what you want:

phoneSpell[n_Integer] := With[{k = StringLength@ToString@n, v = IntegerDigits@n, 
   r = {0 -> "0", 1 -> "1", 2 -> "ABC", 3 -> "DEF", 4 -> "GHI", 
     5 -> "JKL", 6 -> "MNO", 7 -> "PRS", 8 -> "TUV", 9 -> "WXY"}}, 
  StringJoin @@@ Flatten[Outer[List, Sequence @@ Characters[v /. r]], k - 1]]

Then:

phoneSpell[652]
{"MJA", "MJB", "MJC", "MKA", "MKB", "MKC", "MLA", "MLB", "MLC", "NJA", 
 "NJB", "NJC", "NKA", "NKB", "NKC", "NLA", "NLB", "NLC", "OJA", "OJB", 
 "OJC", "OKA", "OKB", "OKC", "OLA", "OLB", "OLC"}
phoneSpell[650231]
{"MJ0AD1", "MJ0AE1", "MJ0AF1", "MJ0BD1", "MJ0BE1", "MJ0BF1", 
"MJ0CD1", "MJ0CE1", "MJ0CF1", "MK0AD1", "MK0AE1", "MK0AF1", "MK0BD1", 
"MK0BE1", "MK0BF1", "MK0CD1", "MK0CE1", "MK0CF1", "ML0AD1", "ML0AE1", 
"ML0AF1", "ML0BD1", "ML0BE1", "ML0BF1", "ML0CD1", "ML0CE1", "ML0CF1", 
"NJ0AD1", "NJ0AE1", "NJ0AF1", "NJ0BD1", "NJ0BE1", "NJ0BF1", "NJ0CD1", 
"NJ0CE1", "NJ0CF1", "NK0AD1", "NK0AE1", "NK0AF1", "NK0BD1", "NK0BE1", 
"NK0BF1", "NK0CD1", "NK0CE1", "NK0CF1", "NL0AD1", "NL0AE1", "NL0AF1", 
"NL0BD1", "NL0BE1", "NL0BF1", "NL0CD1", "NL0CE1", "NL0CF1", "OJ0AD1", 
"OJ0AE1", "OJ0AF1", "OJ0BD1", "OJ0BE1", "OJ0BF1", "OJ0CD1", "OJ0CE1", 
"OJ0CF1", "OK0AD1", "OK0AE1", "OK0AF1", "OK0BD1", "OK0BE1", "OK0BF1", 
"OK0CD1", "OK0CE1", "OK0CF1", "OL0AD1", "OL0AE1", "OL0AF1", "OL0BD1", 
"OL0BE1", "OL0BF1", "OL0CD1", "OL0CE1", "OL0CF1"}

There's also this slight variation of the above solution:

phoneSpell2[n_Integer] := With[{k = Length@(v = Characters@ToString@n), 
   r = {"2" -> "ABC", "3" -> "DEF", "4" -> "GHI", "5" -> "JKL", 
     "6" -> "MNO", "7" -> "PRS", "8" -> "TUV", "9" -> "WXY"}}, 
  StringJoin @@@ Flatten[Outer[List, Sequence @@ Characters[v /. r]], k - 1]]
share|improve this answer

borrowing rules from RunnyKine

r = {0 -> "0", 1 -> "1", 2 -> "ABC", 3 -> "DEF", 4 -> "GHI", 
   5 -> "JKL", 6 -> "MNO", 7 -> "PRS", 8 -> "TUV", 9 -> "WXY"};


n = 652;
StringJoin @@@ Tuples[Characters /@ IntegerDigits@n /. r]


(*{"MJA", "MJB", "MJC", "MKA", "MKB", "MKC", "MLA", "MLB", "MLC", 
"NJA", "NJB", "NJC", "NKA", "NKB", "NKC", "NLA", "NLB", "NLC", "OJA", 
"OJB", "OJC", "OKA", "OKB", "OKC", "OLA", "OLB", "OLC"}*)
share|improve this answer

Slight modifications of existing answers of @RunnyKine and @Algohi (thanks guys!)

numRules = 
 MapThread[
  Rule, {Range[1, 9], {{"1"}}~
    Join~(Partition[CharacterRange["A", "Y"] // DeleteCases[#, "Q"] &,
       3])}]
(* {1 -> {"1"}, 2 -> {"A", "B", "C"}, 3 -> {"D", "E", "F"}, 
 4 -> {"G", "H", "I"}, 5 -> {"J", "K", "L"}, 6 -> {"M", "N", "O"}, 
 7 -> {"P", "R", "S"}, 8 -> {"T", "U", "V"}, 9 -> {"W", "X", "Y"}} *)



Clear[phoneSpell]
phoneSpell[n_Integer] := Module[{splitByZero, numToChar, joinedChar},
  splitByZero = 
   DeleteCases[SplitBy[IntegerDigits[n], (# == 0 &)], {0 ..}];
  FromDigits /@ splitByZero;
  numToChar = Tuples /@ (splitByZero /. numRules);
  joinedChar = {FromDigits /@ splitByZero, 
     Map[StringJoin, numToChar, {2}]} // Transpose
  ]

phoneSpell[6520123] // Grid[#, Frame -> All] &

Mathematica graphics


Test to see if a dialed number matches any words in the dictionary

Clear[numDictQ]
numDictQ[n_Integer] := {phoneSpell[n][[All, 
    1]], (Select[#1, ! DictionaryLookup[ToLowerCase[#1]] == {} &] &) /@
     phoneSpell[n][[All, 2]]} // Transpose

numDictQ[78225039242643] // Grid[#, Frame -> All] &

Mathematica graphics


Test to see if a string of letters, if dialed, will match any other strings of letters

Clear[abcToNum]
abcToNum[s_String] := 
  FromDigits@ToUpperCase@Characters[s] /. reverseNumRules;

numDictQ[abcToNum["phone spell"]] // Grid[#, Frame -> All] &

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.