[Haskell-cafe] Practise fingerspelling with Haskell! (Code cleanup request)

Dougal Stanton ithika at gmail.com
Tue Jul 17 06:17:24 EDT 2007


The following is a slap-dash program for generating a list of pairs of
words which differ by, at most, one letter. It's quite verbose at the
moment, because (a) that was the way I wrote it, a snippet at a time,
and (b) I lack the wit to make it shorter.

Can anyone recommend ways to make this program more
efficient/neat/elegant? It runs in decent time on my machine, but it's
not exceedingly pretty and I'm sure it can be made shorter too.

(The full thing can be found at
<http://193.219.108.225/code/fingerspell/> if you want to pull in a
working version to play with. The purpose of the program is for a game
to practise fingerspelling when learning sign language. More on that
here: <http://brokenhut.livejournal.com/265471.html>.)

Cheers,

D.

---- edited highlights below ----

-- Number of letters difference between two words.
difference :: Pair -> Int
difference = length . filter (==False) . uncurry (zipWith (==))

-- Keep only pairs that differ by at most
-- one letter difference.
keepOneDiff :: PairSet -> PairSet
keepOneDiff = map snd . filter (\x -> (fst x) < 2) . map (difference &&& id)

-- Pairs of words of equal length, sorted to reduce
-- duplicates of (a,b), (b,a) type. They shouldn't
-- be completely eradicated because part of the game
-- is to spot when they;re the same word.
listPairs :: WordSet -> PairSet
listPairs ws = [ (w, w') | w <- ws, w' <- ws, length w == length w', w <= w' ]

-- Take N pairs of words which are the same
-- length and differ by at most one letter.
wordpairs :: Int -> WordSet -> PairSet
wordpairs n = take n . keepOneDiff . listPairs

fingerspell wl p = do
    wordfile <- words `liftM` readFile "/usr/share/dict/words"
    mapM_ pretty $ wordpairs p $ filter (requirements) wordfile
  -- Make sure all the words are of the required length and are
  -- just made up of letters, not punctuation.
  where requirements w = length w == wl && all (isAlpha) w

pretty (x,y) = putStrLn $ x ++ ", " ++ y


More information about the Haskell-Cafe mailing list