Friday, 10 October 2014

Backtrack to simpler times


I recently re-encountered a problem, thinking about it in Haskell was just so much more succinct and beautiful that I had to code it up.

The Problem:

Given a code on a keypad, find all possible codes that correspond to transpositions of the original code where a transposition is a translation of all keys in a particular direction. The * and # are invalid characters.

We begin with a function that checks the translation of a single character. We assume the existence of a map and its inverse between locations and keys. Thus translation of a single character is valid if and only if both the original character is in the map and the final location is in the inverse map. We'll wrap our answer in a context of failure. We can have two ways to fail, either when trying to perform the initial lookup, or the second. Thus our value should be wrapped in two contexts of failures Maybe (Maybe Char). However we don't really care about distinguishing between the two and so we'll flatten them out into a Maybe Char. This treatment yields the following code.

check :: Char -> (Int, Int) -> Maybe Char
check c off = (+) <$> lookup c keyToLoc <*> return off >>= flip lookup locToKey

Next we have to reflect this behavior of a single character to a set of characters. We want to check that each of the individual characters succeeds, if one fails all should fail. Sounds similar to a conjunction right? This is (>>=) for MonadPlus  However since we know the structure of what we're binding in advance we can just use the applicative interface (<*>) to glue our results together. Over here, we're going to work on the results of check. However we're going to work on them while they're embedded within two contexts - a reader and maybe. Thats why we have to lift our the (:) and the [] two levels up.

inp' :: String -> (((->) (Int, Int)) (Maybe [Char]))
inp' = foldr ((liftA2 . liftA2) (:)) ((pure . pure) []) . fmap check

Now we need to generate the list of possible offsets. To create a single offset we use (,). Let xList represents all possible alternatives along the x component and yList represents them along the y component. (<*>) teaches our function (,) to operate on lists of alternatives. That is it reflects the behavior of (,) to a place where the operands are a list of possibilities. 

list :: Int -> [(Int, Int)]
list maxOff = (,) <$> [-maxOff .. maxOff] <*> [-maxOff .. maxOff]

Finally we need to combine the above. Mapping them over each other gives us a context of non-determinism around a context of failure. The characteristic we want to observe of this structure is the number of successes. So we obtain the characteristic of this structure by folding it using an accumulator.

sol :: String -> Int -> Int
sol inp = foldl (\a -> (a +) . success) 0 . fmap (inp' inp) . list