Chopping Words
July 3, 2012
To find all the words that can be formed by chopping a single letter from a word, we simply iterate through the word one letter at a time, keeping only those chopped words that are in the dictionary:
(define (chops str)
(let ((len (string-length str)))
(define (chop n)
(string-append
(substring str 0 n)
(substring str (+ n 1) len)))
(filter word? (map chop (range len)))))
A word is represented as a string w, a chopping chain is represented as a list of words ws, and the collection of all chopping chains that can be formed from a given input is a list of list of words wss. The inner map takes a single chopping chain and returns all possible extensions to it, the outer mappend operates over the collection of chopping chains, and the loop runs until the words are only a single letter.
(define (chop str)
(let loop ((wss (list (list str))))
(if (= (string-length (caar wss)) 1)
(map reverse wss)
(loop (mappend
(lambda (ws)
(map
(lambda (w) (cons w ws))
(chops (car ws))))
wss)))))
Mappend is like map, but uses append instead of cons to build the output list. We used mappend instead of map in order to make the types come out right. We find forty chopping chains for the input planet, and learn some new words:
> (chop "planet")
(("planet" "plant" "pant" "ant" "at" "t")
("planet" "plant" "pant" "ant" "at" "a")
("planet" "plant" "pant" "ant" "an" "n")
("planet" "plant" "pant" "ant" "an" "a")
("planet" "plant" "pant" "pat" "at" "t")
("planet" "plant" "pant" "pat" "at" "a")
("planet" "plant" "pant" "pat" "pt" "t")
("planet" "plant" "pant" "pat" "pt" "p")
("planet" "plant" "pant" "pat" "pa" "a")
("planet" "plant" "pant" "pat" "pa" "p")
("planet" "plant" "pant" "pan" "an" "n")
("planet" "plant" "pant" "pan" "an" "a")
("planet" "plant" "pant" "pan" "pa" "a")
("planet" "plant" "pant" "pan" "pa" "p")
("planet" "plant" "plat" "lat" "at" "t")
("planet" "plant" "plat" "lat" "at" "a")
("planet" "plant" "plat" "lat" "la" "a")
("planet" "plant" "plat" "lat" "la" "l")
("planet" "plant" "plat" "pat" "at" "t")
("planet" "plant" "plat" "pat" "at" "a")
("planet" "plant" "plat" "pat" "pt" "t")
("planet" "plant" "plat" "pat" "pt" "p")
("planet" "plant" "plat" "pat" "pa" "a")
("planet" "plant" "plat" "pat" "pa" "p")
("planet" "plant" "plan" "pan" "an" "n")
("planet" "plant" "plan" "pan" "an" "a")
("planet" "plant" "plan" "pan" "pa" "a")
("planet" "plant" "plan" "pan" "pa" "p")
("planet" "plane" "lane" "ane" "an" "n")
("planet" "plane" "lane" "ane" "an" "a")
("planet" "plane" "pane" "ane" "an" "n")
("planet" "plane" "pane" "ane" "an" "a")
("planet" "plane" "pane" "pan" "an" "n")
("planet" "plane" "pane" "pan" "an" "a")
("planet" "plane" "pane" "pan" "pa" "a")
("planet" "plane" "pane" "pan" "pa" "p")
("planet" "plane" "plan" "pan" "an" "n")
("planet" "plane" "plan" "pan" "an" "a")
("planet" "plane" "plan" "pan" "pa" "a")
("planet" "plane" "plan" "pan" "pa" "p"))
We used range, mappend, and read-line from the Standard Prelude, and wrote functions read-words to read all the words into a dictionary and word? to look up words in the dictionary. Our dictionary is simply a list of words; our program could be faster if we used a hash table or trie to store the dictionary, but a list is sufficient for exploratory programming like this. You can run the program at http://programmingpraxis.codepad.org/7kB3lbiz, where you can also see all the auxiliary code.
[…] today’s Programming Praxis exercise, our goal is to reduce a word one letter at a time, where each step […]
My Haskell solution (see http://bonsaicode.wordpress.com/2012/07/03/programming-praxis-chopping-words/ for a version with comments):
import Data.Char import Data.List chop :: Eq a => [[a]] -> [a] -> [[a]] chop dict xs = filter (`elem` dict) $ zipWith (++) (inits xs) (tail $ tails xs) chain :: Eq a => [[a]] -> [a] -> [[[a]]] chain dict xs@(_:_:_) = map (xs :) . chain dict =<< chop dict xs chain _ xs = [[xs]] main :: IO () main = do dict <- fmap (lines . map toLower) $ readFile "74550com.mon" mapM_ print $ chain dict "planet"Not terribly pretty, but it does the job. I end up with more chopping chains than the above, only because of my using
/usr/share/dict/words.#!/usr/bin/env python from itertools import permutations def tails(xs): return (xs[i:] for i in xrange(len(xs))) def chain(word): r = range(len(word)) return set(tuple(''.join(word[i] for i in set(r).intersection(ix)) for ix in t) for t in map(tails, permutations(r))) def chop(word, dict_set): return filter(lambda cs: all(c in dict_set for c in cs), chain(word)) if __name__ == "__main__": from pprint import pprint with open("/usr/share/dict/words") as f: dict_set = set(line.strip() for line in f) pprint(chop("planet", dict_set))Builds a tree of possible chops, then “flattens” it to obtain a list of all possible paths from root to nodes.
This would of course benefit a lot from memoization, since we’re doing again and again the same chops recursively.
import qualified Data.List as L import qualified Data.Map as M data ChopTree = Node String [ChopTree] deriving Show dict = "/usr/share/dict/words" rems :: [Char] -> [[Char]] rems [] = [] rems (x:[]) = [""] rems (x:xs) = xs:(map (x:) (rems xs)) tree2list :: ChopTree -> [[String]] tree2list t = aux t [] where aux (Node w []) l = map reverse [w:l] aux (Node w ll) l = concatMap (\v->aux v (w:l)) ll chop :: [Char] -> IO ChopTree chop = chop' dict where chop' :: FilePath -> [Char] -> IO ChopTree chop' dic word = do dic' <- readFile dic >>= (\f -> return $ M.fromList (map (\x->(x,True)) (words f))) return $ chop'' dic' word chop'' :: M.Map [Char] a -> [Char] -> ChopTree chop'' dic word = let subW = rems word in let validSubW = filter (flip M.member dic) subW in Node word (L.map (chop'' dic) validSubW)Python:
‘chain()’ returns a generator that returns each chain, one at a time.
from itertools import combinations, ifilter with open("/python27/12dicts/2of12inf.txt", "rt") as f: wordlist = set(w.strip().lower() for w in f) wordlist.update('abcdefghijklmnopqrstuvwxyz') def chain(word, dictionary): is_word = dictionary.__contains__ join = ''.join def aux(wds, wlen): if wlen == 1: yield wds else: for wd in ifilter(is_word, map(join, combinations(wds[-1], wlen - 1))): for wlist in aux(wds + [wd], wlen - 1 ): yield wlist return aux([word], len(word)) for wlist in chain('planet', wordlist): print wlistUse a tree to map all the words in dictionary
http://codepad.org/XBwJufSS
[…] One more challenge from Programming Praxis’ Word Games today (there are only a few left!). This time we have the challenge of cutting off bits of words, one letter at a time, such that each step is still a word. […]
Here’s my solution in Racket: Chopping Words
I went a step beyond what the problem strictly asked and returned a nested tree-like structure with all possible chains of chopped words. Using the recursive solution that I was, it really wasn’t much harder than just returning a single solution and it still runs rather quickly.
Here’s a sample run for
PLANET:> (chopping-words dict "PLANET") '("PLANET" ("PLANE" ("PLAN" ("PAN" ("PA" ("A")) ("AN" ("A")))) ("PANE" ("PAN" ("PA" ("A")) ("AN" ("A"))))) ("PLANT" ("PLAN" ("PAN" ("PA" ("A")) ("AN" ("A")))) ("PLAT" ("PAT" ("PA" ("A")) ("AT" ("A")))) ("PANT" ("PAN" ("PA" ("A")) ("AN" ("A"))) ("PAT" ("PA" ("A")) ("AT" ("A"))) ("ANT" ("AN" ("A")) ("AT" ("A"))))))