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:<\/p>\n
\nWe 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?\n<\/p><\/blockquote>\n
A typical example, not very long is this:<\/p>\n
\r\nplanets\r\nplants\r\npants\r\npant\r\nant\r\nan\r\na\r\n<\/pre>\nSo I though this could be a good exercise for F#. Several good dictionaries, both small and big, can be found here<\/a>.<\/p>\n
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.<\/p>\n 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:<\/p>\n
\r\ncopy dictionary[1] to reducedwords[1]\r\n\r\nfor length = 2 to maxwordlength do\r\n foreach word in dictionary[length]\r\n foreach letter in word\r\n * delete the letter\r\n * if new word exists in reducedwords[length-1] then\r\n * add new word to reducedwords[length]\r\n<\/pre>\nHere is a function for reading a dictionary file:<\/p>\n
\r\nlet readWords (filename:string) = \r\n let dictionary = new Dictionary< int, list< string > >()\r\n let reader = new StreamReader(filename)\r\n let word = String.Empty\r\n let fileend = ref false\r\n while (!fileend = false) do\r\n let word = reader.ReadLine()\r\n if word = null then \r\n fileend := true\r\n else\r\n let len = String.length word\r\n let ok, words = dictionary.TryGetValue(len)\r\n if ok then dictionary.[len] <- words@[word]\r\n else dictionary.[len] <- [word]\r\n done\r\n dictionary.[1] <- [\"a\";\"e\";\"i\";\"o\";\"u\"]\r\n dictionary\r\n<\/pre>\nOne 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.<\/p>\n
\r\nlet findReducedWords (dictionary:Dictionary< int, list< string > >) =\r\n let reducedwords = new Dictionary< int, list< string > >()\r\n reducedwords.[1] <- dictionary.[1]\r\n\r\n let notdone = ref true\r\n let i = ref 2\r\n while (!notdone = true) do\r\n let ok, words = dictionary.TryGetValue(!i)\r\n if ok <> true then\r\n notdone := false\r\n else\r\n let added = ref false\r\n let ok, reducedpre = reducedwords.TryGetValue(!i - 1)\r\n reducedwords.[!i] <- []\r\n words |> List.iter (fun word ->\r\n for j = 0 to word.Length-1 do\r\n let trimmedword = word.Remove(j, 1)\r\n if reducedpre.Exists(fun x -> x = trimmedword) then\r\n reducedwords.[!i] <- reducedwords.[!i]@[word]\r\n added := true\r\n done;\r\n )\r\n reducedwords.[!i] <- reducedwords.[!i] |> Set.of_list |> List.of_seq\r\n if !added then\r\n i := !i + 1\r\n else\r\n reducedwords.Remove(!i) |> ignore\r\n notdone := false\r\n done\r\n\r\n (reducedwords, !i-1)\r\n<\/pre>\nSince 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.<\/p>\n
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.<\/p>\n
\r\nlet rec printSequence \r\n (word:string) \r\n (reducedwords:Dictionary< int, list< string > >) \r\n (path:list< string >) =\r\n match word.Length with\r\n | 1 -> \r\n path@[word] |> List.iter (fun x -> printf \"%s \" x); \r\n printfn \"\"\r\n | _ -> \r\n let ok, reducedpre = reducedwords.TryGetValue(word.Length-1)\r\n if ok then\r\n for j = 0 to word.Length-1 do\r\n let trimmedword = word.Remove(j, 1)\r\n if reducedpre.Exists(fun x -> x = trimmedword) then\r\n printSequence trimmedword reducedwords (path@[word])\r\n done;\r\n \r\nlet printSequences \r\n (reducedwords:Dictionary< int, list< string > >) \r\n (maxlen:int) =\r\n let ok, words = reducedwords.TryGetValue(maxlen)\r\n if ok then \r\n words |> List.iter (fun word -> \r\n printSequence word reducedwords [])\r\n<\/pre>\nThe only thing left to do is calling all these functions:<\/p>\n
\r\nlet main()=\r\n printfn \"reading dictionary...\"\r\n let dictionary = readWords \"huge_dict.txt\"\r\n\r\n printfn \"building structures...\"\r\n let reducedwords, max = findReducedWords dictionary\r\n\r\n printfn \"printing matches...\"\r\n printSequences reducedwords max\r\n\r\n Console.WriteLine(\"Press any key to continue...\")\r\n Console.ReadKey()\r\n \r\nmain()\r\n<\/pre>\nMy results for this dictionary<\/a> were:<\/p>\n
\r\ncomplecting completing competing compting comping coping oping ping pig pi i\r\ncomplecting completing competing compting comping coping oping ping pin in i\r\ncomplecting completing competing compting comping coping oping ping pin pi i\r\n<\/pre>\n<\/p>\n","protected":false},"excerpt":{"rendered":"
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 … Read more<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_uag_custom_page_level_css":"","advgb_blocks_editor_width":"","advgb_blocks_columns_visual_guide":"","_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[37,42],"tags":[],"class_list":["post-124","post","type-post","status-publish","format-standard","hentry","category-fsharp","category-parallel-programming"],"aioseo_notices":[],"aioseo_head":"\n\t\t\n\t\n\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t