Last Saturday we played a new game at BSL, to tighten up our fingerspelling skills. I’ve been practising the actual spelling part on the bus to and from work, so I’m getting better at that. But being able to pick up other people’s fingerspelling is still horrendously difficult, even when they go slowly.
The game involved cards with pairs of words written on them. Sometimes the words would be the same, “john, john” and other times differ by one letter “joan, jean”. The task was two-sided. For the person doing the spelling, they had to be fluid. For the person watching, they had to say what letter, if any, was different between the two words.
So I wrote a program to generate pairs of up-to-one-letter-different words. This is just the first go through, so it’s not too pretty. As I write this I’m offline because our internet connection is broken, so I’ve been completely without API guides: horrifying!
module Main where
type WordSet = [String]
type Pair = (String,String)
type PairSet = [Pair]
-- 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
main = do
args <- getArgs
case args of
[wl, p] -> fingerspell (read wl) (read p)
_ -> putStrLn "Usage: fingerspell <word length> <number of words>"
It’s got no error detection or correction features other than telling you the correct argument list if you put in the wrong number. It doesn’t even check if
/usr/share/dict/words is there before opening it. But it does work, which I often find is a bonus! :-)