A Neat Problem

Here’s a neat game, with a really neat solution.  I’ll post the solution later, but this post shows a Haskell implementation of the game.  I first encountered this game as a puzzle in a game (an otherwise unremarkable one) called Keepsake by The Adventure Company.

The game looks like this.  There are five displays, which display the letters A through E.  The letters cycle through that sequence, wrapping back to A at the end.  There are also five buttons, which are numbered 1 through 5.  Each of the button changes each display my some random amount (from zero to four steps forward).  Pressing a button five times consecutively will always get things back to where they were before it was pressed. The goal is to get from the (randomly chosen) starting point to the (randomly chosen) ending point.

For example, if the starting point were ABCDE, the target were EDBDE, and button 3 advanced the first and third dials by two and the second by 1 (what I’ll call a “signature” of [2, 1, 2, 0, 0]), then the correct answer could be obtained by pushing button 3 twice.  The first press would change it to CCEDE, and the second to EDBDE (because the third dial wraps).

module Main where

import Control.Monad (replicateM)
import System.Random
import System.IO

Three fundamental pieces of information are used to define instances of this problem.  There is a starting display, a target display, and the actions of each of the five buttons.  The program chooses random values for these three, prints the target, and then starts processing moves by the user.

main :: IO ()
main = do   mat  <- buildMat
            disp <- replicateM 5 $ randomRIO ('A', 'E')
            tgt  <- replicateM 5 $ randomRIO ('A', 'E')
            putStrLn $ "Target = " ++ tgt
            continue mat disp tgt

The actions of each of the five buttons are represented in a matrix of sorts.  Each button has a row in the matrix; and the columns represent the effect on each of the letters in the display.

type Matrix = [[Int]]

Random values for the matrix are chosen as follows.

randomMat :: IO Matrix
randomMat = replicateM 5 $ replicateM 5 $ randomRIO (0,4)

There is one quirk, though.  We want the problem to have a solution.  Clearly there are some random matrices for which the problem has no solution.  (For a trivial example, imagine a matrix of all zeros; then it’s impossible to change the display.)  It turns out that, for reasons I will explain when I post the solution, it is sufficient for the matrix to have a non-zero (mod 5) determinant.  So here’s the code to calculate the determinant (by cofactor expansion along the first column)

det :: Matrix -> Int
det mat | length mat == 1 = head (head mat)
        | otherwise       = sum $ map det' [0 .. length mat - 1]
    where det' n = let x      = head (mat !! n)
                       submat = map tail (take n mat ++ drop (n + 1) mat)
                       sign   = if n `mod` 2 == 0 then 1 else -1
                   in  x * sign * det submat

The choice of a matrix, then, is performed by continuing to generate matrices until we find one with a non-zero (mod 5) determinant.

buildMat :: IO Matrix
buildMat = do m <- randomMat
              if det m `mod` 5 == 0 then buildMat else return m

Once the problem is generated, the next step is to keep asking for which button to press until the user accomplishes the goal.

continue :: [[Int]] -> [Char] -> [Char] -> IO ()
continue mat disp tgt | disp == tgt = do
    putStrLn "Congratulations!  You win."

                      | otherwise   = do
    putStrLn disp
    putStr "Enter 1 through 5: "
    hFlush stdout
    s        <- getLine
    let n     = read s
    let disp' = apply mat (n - 1) disp
    continue mat disp' tgt

Only two more functions are needed.  First, apply takes the matrix and a button number, and calculates the result of pressing that button.

apply :: Matrix -> Int -> [Char] -> [Char]
apply mat n vals = zipWith ($) (map add (mat !! n)) vals

Finally, the add function rotates a single letter of the display by a given amount.

add :: Int -> Char -> Char
add n s = iterate nxt s !! n
    where nxt 'A' = 'B' ; nxt 'B' = 'C'
          nxt 'C' = 'D' ; nxt 'D' = 'E'
          nxt 'E' = 'A'

Putting all of this together gives an implementation of the puzzle.  The puzzle can be fun to play with, but there’s also a neat straight-forward mathematical technique for finding the solution, which I’ll post in a few days.  Until then, have fun!