Over the past few days I've been playing a fairly popular game for Google's Android platform on my phone. The game is called Shot. The rules of the game are fairly simple.

In a 7x9 grid, we have a variety of balls at certain positions.

Here's a simple example:

 o 
 o o o
 o 
 o o o o

   o o

 o  

The object of the game is to knock all the balls (except one) out of the grid. We can knock a ball in any of the four directions (up, down, left, right), subject to the following restrictions:

1. You can't move a ball off the edge of the map directly, you must instead send a ball on a collision course with another ball:

Illegal

 ↑
 o

 o

Legal

 o
 ↓
 o

2. You can't move a ball into a ball that is adjacent to it. So moving A down to strike B is illegal here, but moving A to C is legal.

 A→ C
 B

3. When a ball strikes another ball, the moving ball stops, and the stationary ball begins moving in the same direction. Once this happens, Rules 1 and 2 no longer apply for the moving ball.

Example: This move:

o→o oo

Results in this playing out:

 oo→oo

 o ooo→

 o oo

And hey! We've lost a ball. Rince and repeat to solve the puzzle:

Move 2:

 o ←oo

←oo o 

  o o

Move 3:

  o→o

   o

And we solved the puzzle! Admittedly, that example wasn't hard, but I'm sure you can imagine difficult examples (If you can't, play the game!).

I have an annoying tendency with puzzle games to become frustrated with them, to the point of writing solvers for them to save myself the trouble. Of course, once the solver is written, the game is ruined, but at least the solver was fun to write (don't ever ask me to solve a sudoku puzzle =P).

As with all Literate Haskell posts, let's begin the post with our imports, which you can ignore, but are there for the compiler and posterity.

1
2
3
4
5
6
7

module Main where

import Data.Maybe
import Data.List
import Prelude hiding (Left, Right)
import Control.Arrow
import Control.Monad

Okay, so, we're going to need some form of data type to represent the board. I chose a list of ball coordinates over a grid structure, sacrificing a bit of time efficiency in exchange for being able to use the lovely Data.List functions.

1
2
3
4
5
6
7

data Ball = Ball { ballX :: Int
                 , ballY :: Int 
                 } deriving (Show,Eq)

type Board = [Ball]

We'll also need a data type to represent a single step or move in the game. I represent it as:

• the ball that was moved
• the direction is was moved in

1
2
3
4
5
6
7
8
9

data Direction = Up 
               | Down 
               | Left 
               | Right 
               deriving (Show,Eq)

data Step = Step Ball Direction 
          deriving (Show,Eq)

Finally, we will use the Maybe type to encapsulate a series of Steps to represent a solution. Nothing means that there is no solution. In any other case, the series of steps provided will solve the puzzle.

1
2

type Solution = Maybe [Step]

Okay, enough of data types. Let's get on to solving algorithms. Seeing as each move in the game removes exactly one ball from the grid, and the object is to remove n - 1 balls from the grid (where n is the number of balls in the puzzle), I deduced that all solutions have the same length (n - 1), and hence a simple recursive backtracking algorithm will suffice.

That is, given a game state, deduce all the legal moves that can be made, then recursively call on each one with an updated gamestate reflecting the move, stopping after a valid solution is found.

Seeing as Solution is a Maybe type, I use Control.Monad's mplus operator, which, specifically for Maybe values, could be implemented like this:

1
2
3
4
5
6

     -- not part of solver
     mplus :: Maybe a -> Maybe a -> Maybe a
     mplus (Just a) _ = a
     mplus (Nothing) (Just a) = a
     mplus (Nothing) (Nothing) = Nothing

That is, it returns the first Just value it sees, and ignores all Nothing values. Applied to the solver problem, this means I can use it with foldr to select a solution.

1
2
3
4
5
6
7
8
9
10

solve :: Board -> Solution
solve board | isSolved board = Just [] 
solve board = foldr mplus Nothing $ map solver legalMoves 
  where
     solver m = case solve (applyMove m board) of
                     Just r  -> Just (m:r)
                     Nothing -> Nothing
     legalMoves    = filter (isLegal board) possibleMoves
     possibleMoves = concatMap (flip map [Up, Down,Left,Right]) (map Step board)

This function used alot of yet-undefined functions, the first being isLegal, that determines if a given move, given a certain state, is legal. In this function, I use Control.Arrow's >>> operator, which, for functions, is the same as flip (.) . As discussed in the preamble, the two conditions for a move to be legal are:

• The move will be stopped by another ball before reaching the edge of the screen.
• The move is not trying to move into an adjacent ball.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

isLegal ::  Board -> Step -> Bool
isLegal board (Step ball@(Ball x y) dir) = notAdjacent && willBeStopped 
   where
       willBeStopped = any check board
       check = and . \v -> map ($ v) $ checkFor dir
       checkFor Up    = [ballX >>> (==x), ballY >>> (< y)] 
       checkFor Down  = [ballX >>> (==x), ballY >>> (> y)]
       checkFor Left  = [ballX >>> (< x), ballY >>> (==y)]
       checkFor Right = [ballX >>> (> x), ballY >>> (==y)]

       notAdjacent = nextBall `notElem` board
       nextBall    = newCoords dir ball

newCoords :: Direction -> Ball -> Ball
newCoords Up    (Ball x y) = Ball x (y-1)
newCoords Down  (Ball x y) = Ball x (y+1)
newCoords Left  (Ball x y) = Ball (x-1) y
newCoords Right (Ball x y) = Ball (x+1) y

(the newCoords function is top-level as it is used elsewhere later on)

Naturally, the condition for a solved board is that there is only one ball left:

1
2
3

isSolved :: Board -> Bool
isSolved = length >>> (== 1)

(Once again I have used the >>> operator. I think it looks clearer than (\x -> length x == 1) or (==1) . length .

Finally there is the applyMove function, which, given a move and a board, updates the board to reflect the move. This function works as follows:

• Calculate the next position of the ball (the moveBall helper).
• Update the ball's position in a new board.
• If the ball just struck another ball, recursively call oneself, this time moving the struck ball in the same direction.
• If the ball has gone outside the bounds of the grid, remove it.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

applyMove :: Step -> Board -> Board
applyMove step board = filter (not . outsideBounds) $ applyMoveHelper step board
     where 
       applyMoveHelper (Step ball dir) board = let movedBall = moveBall dir ball 
                                                   nextBall  = newCoords dir movedBall
                                                   nextBoard = movedBall:delete ball board 
                                               in if nextBall `elem` board 
                                                   then applyMoveHelper (Step nextBall dir) nextBoard
                                                   else nextBoard

       moveBall dir ball | outsideBounds ball = ball
       moveBall dir ball = let nextBall = newCoords dir ball 
                           in if nextBall `elem` board 
                              then ball
                              else moveBall dir nextBall

       outsideBounds (Ball x y) = x > 6 || x < 0 || y > 7 || y < 0 

Finally, we have two functions used in the IO processing. One to convert strings to a Board representation, and one to do the reverse (with a border). The format looks something like this:

# #
 # #

 #

Producing the data structure: [Ball 0 0, Ball 2 0, Ball 1 1, Ball 3 1, Ball 1 3]

The strToBoard function uses a clever algorithm that assigns numbers (with zip) to each line and each character, then filters out all the non-hash characters, resulting in a simple set of coordinates that can be converted to a Board structure easily.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

strToBoard :: String -> Board       
strToBoard str = rows (lines str) 
   where
     rows lines = concatMap cols $ zip lines [0..] 
     cols (l,y) = map (flip Ball y .snd) $ filter (fst >>> (=='#')) $ zip l [0..]

showBoard :: Board -> String
showBoard board = "+++++++++\n" ++ unlines (map (rowToString) groupedCoords) ++ "+++++++++\n"
   where
     rowToString = (++"+") . ('+':) . map charFor --also attaches border
     groupedCoords = groupBy (\a b -> snd a == snd b) allCoords
     allCoords = [(x,y) | y <- [0..8], x <- [0..6]]      
     charFor (x,y) = if Ball x y `elem` board then '#' else ' ' 

Finally, there remains anther output function to display a Solution in a way that can be digested by humans and copied into the game to solve a puzzle.

1
2
3
4
5
6

prettyPrint :: Board -> [Step] -> String
prettyPrint board moves = concatMap pretty $ zip moves $ boards
  where  
    boards = zipWith applyMove moves (scanl (flip applyMove) board moves) 
    pretty ((Step (Ball x y) dir),board) = show (x,y) ++ "=> " ++ show dir ++ "\n" ++ showBoard board 

The main function is then very straightforward, using the interact function that runs a String->String function through IO.

1
2
3
4
5

main :: IO ()
main = interact solver
  where
    solver str = let board = strToBoard str 
                 in prettyPrint board $ fromJust $ solve board

You can download the unliterate Haskell version of this here!

I am currently working as a teacher under the illustrious and all-powerful Richard Buckland, well known for encouraging critical, scientific thinking among his students and among his tutors.

I was very amused when I read a certain question in the tutorial questions today (or rather, yesterday). While not exactly being relevant to computer science per-se, it certainly is relevant to scientific thinking generally. It forced my students to think with a precision of logic (and skepticism) about the world around them that I do not usually see:

"Students: explain to your class why mirrors reflect left and right but not up and down."

I thought this question was probably one of the best questions I've seen all year. Before you go on reading this post, you too should stop for a minute and think about it.

(slight spoilers follow for those who did not catch the trick in the question)

Every single one of my students immediately thought it was some side effect of the brain's interpretation of the mirror's image. So, socratically, I answered their explanation with a question.

If you turn your head ninety degrees, so that you still look at it orthogonally, but your eyes are oriented differently - why does the image not change on the mirror? If your brain is correcting based on your orientation, wouldn't your brain correct it so that instead the image flips differently in that case?

This sent them back thinking for a while, and eventually they concluded that the mirror must be somehow engineered so that the image is only inverted on one axis, although some students were a bit skeptical of this idea.

I immediately came up with a counter-question much like the first.

Then, if you rotated the mirror ninety degrees, would the image not flip vertically?

Eventually, one of the students used a blanked out laptop screen as a mirror, wrote the word "Hello" on a piece of paper, and tried to do some experimentation. Of course, experimentation is scientific, so this drew my approving applause.

I will post his monologue here:

So, I've got a word on this piece of paper, it's the right way around now. If I flip this piece of paper so that it's facing the mirror... wait.. wait a minute..

I began applauding again, and eventually the students came to the correct conclusion - of course, my entire question is based on a false premise. Mirrors do not reflect left or right, so they most certainly do not reflect up or down. In the traditional misleading case where text in a mirror image appears backwards - this is simply a matter of perspective. It is you who has flipped the piece of paper causing the text to be inverted, not the mirror(*).

I think this question is a superb example of skepticism and semantics. The assertion that mirrors reflect left and right seems right, but it is entirely a misleading assertion. The fact that it is presented as an assumption, laying the groundwork for the main question, reinforces the belief that the assumption is true, when reality is quite the opposite.

I believe this question teaches a valuable lesson about critical analysis, skepticism of presented facts, and helps to promote understanding by experimentation. All of these are essential qualities in any science academic.

(*) - If you had an identical twin who wrote a message on a piece of paper, and held it up so that you, who is facing your twin, can read it, you may notice that neither party would have any difficulty doing so. This is because in this case, the identical twin has been flipped also, whereas in the mirror example the reader and the writer are the same person, so their orientation has not been inverted. The mirror example is really more like having an identical twin that reads from right-to-left.

I'm going to be teaching this again today, I'll update if I have more interesting stories.