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.

Pages: 1 2

8 Responses to “Chopping Words”

  1. […] today’s Programming Praxis exercise, our goal is to reduce a word one letter at a time, where each step […]

  2. 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"
    
  3. 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))
    
  4. Axio said

    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)
    
  5. Mike said

    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 wlist
    
    
  6. CaCaEgg said

    Use a tree to map all the words in dictionary

    http://codepad.org/XBwJufSS

  7. […] 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. […]

  8. JP said

    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"))))))
    

Leave a comment