Posts Tagged ‘word’

Programming Praxis – Two Word Games

October 9, 2012

In today’s Programming Praxis exercise, our goal is to find all the words in a dictionary that satisfy two different criteria. Let’s get started, shall we?

First we have to find the words that have the five vowels in ascending order. To do this we simply check if the vowels in the words are equal to the five vowels in order.

ascVowels :: String -> Bool
ascVowels = (== "aeiou") . filter (`elem` "aeiou")

The second game is to find all the six-letter words whose letters are ascending. All we need to check is check the length and whether the first letter of each pair of subsequent letters comes before the second one.

sixAsc :: Ord b => [b] -> Bool
sixAsc s = length s == 6 && and (zipWith (<) s $ tail s)

All that’s left to do is to load the dictionary and print the appropriate words:

main :: IO ()
main = do ws <- fmap lines $ readFile "354984si.ngl"
          mapM_ putStrLn $ filter ascVowels ws
          putStrLn "---"
          mapM_ putStrLn $ filter sixAsc ws

Programming Praxis – Squaring The Bishop

May 3, 2011

In today’s Programming Praxis exercise, our goal is to write a program that can create word squares. Let’s get started, shall we?

Some imports:

import qualified Data.ByteString.Char8 as B
import qualified Data.List.Key as K
import qualified Data.Map as M
import qualified Data.Trie as T

First we need to load the words into a practical data structure. The obvious one here is a trie. Rather than one big trie for the whole dictionary, we make group the words by length, making a trie for each different length.

loadWords :: IO (M.Map Int (T.Trie Int))
loadWords = fmap (M.fromList . map (\(w:ws) -> (snd w, T.fromList (w:ws))) .
         snd . K.sort snd . map (\w -> (w, B.length w)) .
                  B.words) $ B.readFile "words.txt"

Next, we need a function to find all the possible words of the correct length given a prefix.

findWords :: Int -> String -> M.Map Int (T.Trie a) -> [B.ByteString]
findWords l prefix = T.keys . T.submap (B.pack prefix) . (M.! l)

Finally, constructing the square is a matter recursively finding all the possible next words and keeping only the combinations that result in a full square.

square :: String -> M.Map Int (T.Trie a) -> [[B.ByteString]]
square word ds = f 1 [B.pack word] where
    f n ws = if n == length word then [ws] else 
             (\w -> f (n + 1) (ws ++ [w])) =<<
             findWords (length word) (map (`B.index` n) ws) ds

Some tests to see if everything is working properly:

main :: IO ()
main = do print . square "bonsai" =<< loadWords
          print . (== 122) . length . square "bishop" =<< loadWords

Looks like it. Interestingly, the word bonsai only has a single word square:


Programming Praxis – Miscellanea

April 26, 2011

In today’s Programming Praxis exercise, our goal is to write three fucntions: FizzBuzz, a function to determine if a base 36 number is prime and one to split a list down the middle while going through the list only once. Let’s get started, shall we?

Some imports:

import Data.Foldable (toList)
import Data.Numbers.Primes
import Data.Sequence (ViewL(..), (|>), fromList, viewl, empty)

First up we have the classic FizzBuzz interview question. There are plenty of ways to solve it, but I’m partial to this one.

fizzbuzz :: Integral a => a -> IO ()
fizzbuzz n = mapM_ (putStrLn . f) [1..n] where
    f n = case (mod n 3, mod n 5) of (0, 0) -> "FizzBuzz"
                                     (0, _) -> "Fizz"
                                     (_, 0) -> "Buzz"
                                     _      -> show n

To determine if a word is prime we convert it from base 36 to base 10 and then determine if it’s prime.

isPrimeWord :: String -> Bool
isPrimeWord = isPrime . sum . zipWith (*) (iterate (* 36) 1) . reverse .
    map (\c -> maybe 0 id . lookup c $ zip (['0'..'9'] ++ ['A'..'Z']) [0..])

For splitting the list, the tortoise and hare algorithm seems dubious to me given the requirement that the list is only scanned once, since both of them scan the list (albeit looking only at half of the elements each). I’ve gone with a different approach. We start with two empty lists, which are balanced. If the lists are balanced, the next element will be added to the right one, which unbalances the list. If they are not balanced, the left element of the right list is added to the end of the left list.

splitList :: [a] -> ([a], [a])
splitList = f True (empty, empty) where
    f _     (l,r) [] = (toList l, toList r)
    f True  (l,r) (x:xs) = f False (l, r |> x) xs
    f False (l,r) (x:xs) = f True ((\(h :< t) -> (l |> h, t |> x)) $ viewl r) xs

Some tests to see if everything is working correctly:

main :: IO ()
main = do fizzbuzz 20
          print . not $ isPrimeWord "PRAXIS"
          print $ isPrimeWord "LISP"
          print $ splitList [] == ([],[] :: [Int])
          print $ splitList [1..4] == ([1,2],[3,4])
          print $ splitList [1..5] == ([1,2],[3,4,5])

Programming Praxis – Word Cube

July 13, 2010

In today’s Programming Praxis exercise our task is to write a program to solve Word Cube puzzles, in which you need to find as many words as possible that you can make from nine given letters. The provided Scheme solution is 21 lines, let’s see if we can do better.

Some imports:

import Data.Char
import Data.List

There are three criteria for valid solutions: the word must be at least 4 characters, it must contain the letter in the center and you must be able to make it from the nine letters.

solve :: String -> [String] -> [String]
solve c = filter (\w -> length w > 3 && elem (c !! 4) w && null (w \\ c))

All that’s left to do is load the dictionary, pass it to the solve function and print the results.

wordcube :: String -> IO ()
wordcube cube = mapM_ putStrLn . solve cube .
                lines . map toLower =<< readFile "words.txt"

Straightforward enough. A quick test to see if everything is working correctly:

main :: IO ()
main = wordcube "ncbcioune"

Yup. Not bad at one seventh the size of the Scheme solution.

Programming Praxis – Word Count

December 8, 2009

In today’s Programming Praxis exercise, we have to implement the Unix wc command line utility. Let’s get started.

First, we need some imports.

import System.Environment
import Text.Printf

We handle the command line arguments with a bit of pattern matching.

parseOpts :: [String] -> ([Bool], [String])
parseOpts (('-':ps):args) = (map (`elem` ps) "lwc", args)
parseOpts args            = (replicate 3 True, args)

Next, we need to do the actual counting:

count :: [Bool] -> [(String, String)] -> [String]
count opts = map (\(name, text) -> concat
    [printf "%8s" $ if opt then show . length $ f text else "-"
    | (f, opt) <- zip [lines, words, map return] opts] ++ " " ++ name)

And finally, the program itself.

main :: IO ()
main = do args <- getArgs
          let (opts, files) = parseOpts args
          mapM_ putStrLn . count opts =<< if null files
              then fmap (\x -> [("", x)]) getContents
              else fmap (zip files) $ mapM readFile files

Programming Praxis – Word Search Solver

May 26, 2009

Today‚Äôs Programming Praxis problem is about word search solvers. The provided solution is 77 lines, so let’s see if we can improve on that.

Our imports:

import Data.List
import Data.Map (Map, fromList, member, keys, (!))
import Text.Printf

First let’s define the 8 directions that we can search in. The puzzle is going to be represented as a Map with a tuple of Ints as the key, so the directions are functions for transforming these keys.

dirs :: [(String, (Int, Int) -> (Int, Int))]
dirs = zip ["down right", "up right", "right", "down left",
            "up left", "left", "down", "up"] $
           [\(x,y) -> (x+h, y+v) | h <- [1,-1,0], v <- [1,-1,0]]

We’re going to enter the puzzle as a list of strings, but since that would make access an O(n2) operation we’re going to turn it into a Map instead, since that gives us O(log n2) access.

toGrid :: [[a]] -> Map (Int, Int) a
toGrid = fromList . concat .
         zipWith (\y -> zipWith (\x c -> ((x,y), c)) [1..]) [1..]

Next we need a function to check whether the search word appears at the given position in the given direction.

found :: (Eq a, Ord k) => k -> (k -> k) -> Map k a -> [a] -> Bool
found pos dir g w = isPrefixOf w . map (g !) .
                    takeWhile (flip member g) $ iterate dir pos

Finding the location and direction of a search word is then simply a matter of checking every direction for every position:

findWord :: Map (Int, Int) Char -> String -> String
findWord g w = head [printf "%s row %d column %d %s" w y x ds |
                     (x,y) <- keys g, (ds, dir) <- dirs,
                     found (x,y) dir g w]

That’s all we need, so let’s test if it works.

puzzle :: [String]
puzzle = ["FYYHNRD",

main :: IO ()
main = mapM_ (putStrLn . findWord (toGrid puzzle)) $ words

And indeed it does, using less than half the lines of the provided solution (almost a third if you ignore the lines required to define the puzzle). That will do nicely.