Skip to content
July 17, 2007 / cdsmith

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!


Leave a Comment
  1. Christophe Poucet / Jul 18 2007 4:37 am

    A small suggestion:

    Why not make the A,B,C,D,E a datatype:

    data Value = A | B | C | D | E deriving (Eq, Show, Enum)

    The Eq gets you comparison, the Show gets you nice printing, and the Enum gets you an easy way to increment.

    add :: Int -> Value -> Value
    add n s = (cycle [A .. E] ) !! (n + fromEnum s)

    Even better (so you don’t have to keep re-allocating the list:)

    infinite = [A .. E]
    add n s = infinite !! (n + fromEnum s)

  2. Christophe Poucet / Jul 18 2007 4:37 am

    Obviously, infinite = *cycle* [A .. E]

  3. Jed Brown / Jul 18 2007 7:05 am

    Slightly clearer is

    apply mat n vals = zipWith add (mat !! n) vals

  4. Ken Bateman / Jul 18 2007 10:21 am

    It’s not tough to deterministically generate a nonsingular random matrix. My Haskell-fu is a lamentably weak so I’ll have to describe it.

    Create 5 matrices with the following procedure. Initialize the matrix to zero, then fill in (if this is matrix #i) row i with random values. Then set the diagonal to all ones.

    Multiply all 5 of these matrices together (in any order), and you get a nonsingular matrix that’s nice and random. I’m not willing to warrant that it’s absolutely uniform, but I think it would be fine for a game.

    Alternatively, you could generate a bunch of row-operation matrices and multiply them together. A row-operation matrix is an identity matrix with exactly one of the off-diagonal entries set to a random nonzero value.

  5. Mark Wutka / Jul 19 2007 1:17 pm

    My Haskell-fu is so bad it is just Haskell-foo, but I was wondering how the random stuff would work with Value type. Is there a simple way to grab a random enumerated value?

  6. videoonlinego / Nov 17 2008 11:52 pm

    It is not out-of-date information? Because I have other data on this theme.


  1. Top Posts «
  2. Michi’s blog » Blog Archive » QuickChecking for fun

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: