Marius Bancila’s Blog

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