I recently found an interesting problem on the web, about reducing words, letter by letter until only one letter remains. Here is a formal definition:
We define word reduction as removing a single letter from a word while leaving the remaining letters in their original order so that the resulting sequence of characters is also a word. A good word can be reduced step-by-step until all that is left is a or i. Your program will answer the question: what is the biggest word in the given dictionary that can be reduced?
A typical example, not very long is this:
planets
plants
pants
pant
ant
an
a
So I though this could be a good exercise for F#. Several good dictionaries, both small and big, can be found here.
My approach was to read the dictionary and build a list for each word length: one for 1-letter words, one for 2-letter words, etc. This could be a Dictionary<int, list>, and let’s call it simply dictionary. Then these lists could be traversed and create a second set of lists (let’s call this reducedwords), but only with the words that meet the defined reduction.
An good approach would be to take each list of words from the initial dictionary, starting with the list with words of 2 letters, and for each word to delete one letter at a time. Then check to see if the resulting word already exists in the list from reducedwords corresponding to a length smaller with 1. If it’s there, that this word could be reduced and should be added to the list from reducedwords corresponding to the current length. In other words, the algorithm would be:
copy dictionary[1] to reducedwords[1]
for length = 2 to maxwordlength do
foreach word in dictionary[length]
foreach letter in word
* delete the letter
* if new word exists in reducedwords[length-1] then
* add new word to reducedwords[length]
Here is a function for reading a dictionary file:
let readWords (filename:string) =
let dictionary = new Dictionary< int, list< string > >()
let reader = new StreamReader(filename)
let word = String.Empty
let fileend = ref false
while (!fileend = false) do
let word = reader.ReadLine()
if word = null then
fileend := true
else
let len = String.length word
let ok, words = dictionary.TryGetValue(len)
if ok then dictionary.[len] <- words@[word]
else dictionary.[len] <- [word]
done
dictionary.[1] <- ["a";"e";"i";"o";"u"]
dictionary
One I have the dictionary read, I can apply the algorithm and generate a second Dictionary structure. The following function also returns length of the longest word(s) in the reduced dictionary. This is useful for printing.
let findReducedWords (dictionary:Dictionary< int, list< string > >) =
let reducedwords = new Dictionary< int, list< string > >()
reducedwords.[1] <- dictionary.[1]
let notdone = ref true
let i = ref 2
while (!notdone = true) do
let ok, words = dictionary.TryGetValue(!i)
if ok <> true then
notdone := false
else
let added = ref false
let ok, reducedpre = reducedwords.TryGetValue(!i - 1)
reducedwords.[!i] <- []
words |> List.iter (fun word ->
for j = 0 to word.Length-1 do
let trimmedword = word.Remove(j, 1)
if reducedpre.Exists(fun x -> x = trimmedword) then
reducedwords.[!i] <- reducedwords.[!i]@[word]
added := true
done;
)
reducedwords.[!i] <- reducedwords.[!i] |> Set.of_list |> List.of_seq
if !added then
i := !i + 1
else
reducedwords.Remove(!i) |> ignore
notdone := false
done
(reducedwords, !i-1)
Since the problem is about printing only the longest such reductions, I'll only consider starting from the list of reduced words that has the longest words. That's why I needed findReducedWords to return the length of longest reducible word.
To print these paths I apply the same algorithm as before. The only difference is that I build a list with the words in the reducing path, starting with the longest word and ending with a 1-letter word.
let rec printSequence
(word:string)
(reducedwords:Dictionary< int, list< string > >)
(path:list< string >) =
match word.Length with
| 1 ->
path@[word] |> List.iter (fun x -> printf "%s " x);
printfn ""
| _ ->
let ok, reducedpre = reducedwords.TryGetValue(word.Length-1)
if ok then
for j = 0 to word.Length-1 do
let trimmedword = word.Remove(j, 1)
if reducedpre.Exists(fun x -> x = trimmedword) then
printSequence trimmedword reducedwords (path@[word])
done;
let printSequences
(reducedwords:Dictionary< int, list< string > >)
(maxlen:int) =
let ok, words = reducedwords.TryGetValue(maxlen)
if ok then
words |> List.iter (fun word ->
printSequence word reducedwords [])
The only thing left to do is calling all these functions:
let main()=
printfn "reading dictionary..."
let dictionary = readWords "huge_dict.txt"
printfn "building structures..."
let reducedwords, max = findReducedWords dictionary
printfn "printing matches..."
printSequences reducedwords max
Console.WriteLine("Press any key to continue...")
Console.ReadKey()
main()
My results for this dictionary were:
complecting completing competing compting comping coping oping ping pig pi i
complecting completing competing compting comping coping oping ping pin in i
complecting completing competing compting comping coping oping ping pin pi i
Hits for this post: 12021 .
