Phone Number Word Games part 2 (by CalvinH)
As I said before in this blog, I have an optimized version of a program to solve a programming challenge
To recap, the challenge was to enumerate the possible phrases that can be obtained from a phone number, like 625-329-4741 is MakeAWish1
I understood the original challenge to be to solve the problem, without regard to efficiency. So, in a couple hours, I came up with a solution that wasn’t very efficient that I posted last week. Subsequently, I polished the optimized version below.
You can try this algorithm out by visiting this site and entering any phone number or string of letters. (Sorry, this site is internal to Microsoft only: I don’t want to bog down my tired old server, described in this blog)
It takes up to 15 seconds to calculate phrases based on a phone keypad and look them up in a 50,000 word dictionary.
For the original phone number of “642-394-6369” there were 20101 results calculated in about 10 seconds.
&& There are 3 parts to this algorithm.
&& First (GetDigSeqs) all the possible unique digit subsequences are enumerated into DigSeq.
&& For 123, this would be (123), (23), (3). For N digits, it would be maximum N sequences.
&& Part 2: (EnumNum) for each DigSeq, enumerate all possible letter words of length from 1 to len(DigSeq),
&& look them up in the dictionary, and place unique ones in SubWords
&& Part 3: (FormPhrase) For each digseq and, subword, assemble an N length phrase
&& EnumNum This part uses 2 parallel strings: the number to permute and a pattern
&& cPattern governs the pattern of letters to use for each digit's place
&& a "0" for each digits place to indicate which letter of the digit it is (0,1,2,3). 0 indicates use the raw digit
&& At the end, it'll be "1" (for 0,1), "3" (for 2,3,4,5,6,8), or "4" for "7,9", like "3334433143"
CLEAR
cNumber=INPUTBOX("Phone #?","Phone #","642-394-6369") && number of patterns is 4^8*5^2 = 1638400
dtStart=SECONDS()
GetPhrases(STRTRAN(cNumber,"-","")) && remove dashes
dtEnd=SECONDS()
?"#secs= ",dtEnd-dtStart,"num=",RECCOUNT("phrases")
#define MAXDIGITLEN 2 && max seq length of digits in final result
PROCEDURE GetPhrases(cNumber as String) && Given a digit sequence("6423946369") get all phrases
PUBLIC NUMDIGS,ox as dictionary.dict
NUMDIGS = LEN(cNumber)
ox=CREATEOBJECT('dictionary.dict') && Instantiate the dictionary COM object
ox.DictNum=2 && 1 = 171000 word dictionary, 2= 53869 word
CREATE CURSOR DigSeqs (DigSeq char(NUMDIGS+1)) && all Digit subsequences
INDEX ON DigSeq TAG DigSeq
CREATE CURSOR phrases (phrase char(30)) && a table into which we can put all resulting phrases
CREATE CURSOR SubWords (SubDigits char(NUMDIGS+1),SubWord char(NUMDIGS+1)) && All subwords found in dictionary
INDEX ON SubDigits TAG SubDigits
INDEX ON SubWord TAG SubWord
SET ORDER TO 1
SELECT SubWords
GetDigSeqs(cNumber)
FormPhrase(cNumber,"")
PROCEDURE GetDigSeqs(cNumber as String) && cNumber is all digis. Find the subsequences.
LOCAL i,fShorterFound
IF !SEEK(cNumber+' ',"DigSeqs") && if the number is not in the table
fShorterFound= SEEK(LEFT(cNumber,LEN(cNumber)-1)+' ') && Chop off 1 digit at the end and see if that's found
INSERT INTO DigSeqs VALUES (cNumber) && add the number into the table
IF !fShorterFound && if the shorter was not found,
EnumNum(cNumber,REPLICATE("0",LEN(cNumber)),1) && enumerate all words, look in dictionary
ENDIF
ENDIF
IF LEN(cNumber) >1 && If we need to recur
GetDigSeqs(SUBSTR(cNumber,2)) && Recur with the string without the first digit
ENDIF
RETURN
PROCEDURE EnumNum(cNumber as String,cPattern as String, nDigNum as Integer) && cNumber is raw string of digits with no separators
LOCAL i,cDigit,cPat,cStartLet,cLastPat,cNewLet
cDigit=SUBSTR(cNumber,nDigNum,1) && the digit we're working on
cPat=SUBSTR(cPattern,nDigNum,1) && where are we on this digit?
cStartLet=SUBSTR(" adgjmptw",ASC(cDigit)-47,1) && Starting letter for this digit: 0 1 2abc, 3def, 4ghi, 5jkl, 6mno, 7pqrs, 8tuv, 9wxyz
cLastpat =SUBSTR("0033333434",ASC(cDigit)-47,1) && # permutations -1 for this digit: 0 0 4, 4, 4, 4, 4, 5, 4, 5
DO WHILE .t.
IF !"0"$LEFT(cPattern,nDigNum)
IF !SEEK(LEFT(cNumber,nDigNum)+' ',"SubWords",2) and ox.isword(LEFT(cNumber,nDigNum))
INSERT INTO SubWords (SubDigits,SubWord) VALUES (LEFT(DigSeqs.DigSeq,nDigNum),LEFT(cNumber,nDigNum))
ENDIF
IF nDigNum < LEN(cNumber) && we haven't enumerated all digits yet
EnumNum(cNumber,cPattern,nDigNum+1) && recur with next digit
ENDIF
ENDIF
IF cPat=cLastPat && this digit has reached the end (for '7', we've done "7","p","q","r","s")
EXIT
ENDIF
cPat = CHR(ASC(cPat)+1) && increment the pattern
cPattern=LEFT(cPattern,nDigNum-1) + cPat + SUBSTR(cPattern, nDigNum+1) && insert the new letter into the pattern
cNewlet = CHR(ASC(cStartLet)+ASC(cPat)-49) && from 'a' to 'b' or from 'n' to 'o'
cNumber=LEFT(cNumber,nDigNum-1) + cNewLet + SUBSTR(cNumber, nDigNum+1) && insert the new letter into the number
ENDDO
RETURN
PROCEDURE FormPhrase(cNumber as String,cPartResult as String) && cNumber is digit only sequence
LOCAL i,nLen,nRec,cPartDigit
nLen = LEN(cNumber)
IF nLen = 0
INSERT INTO phrases VALUES (SUBSTR(cPartResult,2)) && if we've used all the digits, then we have a phrase. Remove the initial '-'
ELSE
FOR i = 1 TO nLen
cPartDigit=LEFT(cNumber,i) && the first i digits of the number
IF i <=MAXDIGITLEN AND LEN(cPartResult)>0 AND ISALPHA(RIGHT(cPartResult,1)) && don't insert 2 digit sequences adjacent
FormPhrase(SUBSTR(cNumber,i+1), cPartResult+'-'+ cPartDigit) && insert the digits as a part result
ENDIF
IF LEFT(cPartDigit,1)$"01" AND i <= MAXDIGITLEN && if it starts with '0' or '1', it's ok
FormPhrase(SUBSTR(cNumber,i+1), cPartResult+'-'+ cPartDigit)
ELSE
SEEK cPartDigit+' ' && now find any subword associated with this digit sequence
SCAN WHILE SubDigits=cPartDigit+' ' && for each subwords found (364 can be "dog" or "fog")
nRec=RECNO() && save/restore the current record
FormPhrase(SUBSTR(cNumber,i+1),cPartResult+'-'+ TRIM(SubWords.SubWord)) && recur with those subwords as partial results
GO nRec
ENDSCAN
ENDIF
ENDFOR
ENDIF
RETURN
End of program