A presentation I want to do at CSE@UNSW at some point soonish.

Let me know your thoughts.

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!

There was once an age when all programmers were male, and textbooks tried to make programming appeal to your average programmer's otherwise deficient masculinity.

Have you ever noticed that teaching methods resemble tree traversals*?

The primitive example, like with tree traversals, is depth first. Like depth first tree traversals, depth first student/teacher conversations flow naturally without any explicit level ordering being enforced.

Just as a depth first traversal requires no explicit stack, a depth first conversation requires no explicit ordering of topics. It is particularly evident when teaching a concept to someone which requires a great deal of background knowledge. Before a specific, difficult concept can be taught, the simpler, groundwork topics must be taught. A depth first approach simply teaches down into conversational tangents about the groundwork topics, and then unifies this information back up with the "parent" topic. The problems with the depth first approach to teaching are similar to that of a depth first algorithm - most notably, it can take an unpredictable amount of time to complete the original task and teach the concept. Perhaps the problem of teaching complicated concepts might demand more of a "dynamic programming" conversation style, where basic information is laid down as a foundation, and then incrementally built upon.

A breadth first approach is very well suited to, perhaps, a meeting or discussion where topics have few dependencies. An example would be something like the computing club I teach here at UNSW, where everyone is of similar skill levels, and work on various projects. In this sort of environment, a depth first approach is perhaps unneeded - what is needed is equal attention to the various projects at hand. Like a breadth first traversal, an explicit data structure is needed - an agenda. Using this agenda, the topics can be expanded upon with equal attention. More sub-topics that result from discussion about the original topics would be added to the end of the agenda to deal with later. This resembles very closely a breadth first traversal.

Of course, time constraints again can pose a problem. For example, co-ordinating a student study group, in the limited time before an exam. Here, the agenda is prioritised - the queue becomes a priority queue. If we select topics to revise based on some inherent criteria, say, how many marks they are worth in prior exams, this resembles Dijkstra's Algorithm, particularly if caution is taken not to spend too much time on one topic. Taken from some heuristic evaluation rather than something inherent to the data (such as student confidence with regards to a given topic), this feels more like an A* traversal.

Note however that these are traversals not searches, as they have no specific goal other than some abstract conveyance of knowledge.

This chain of thought leads me to another - how much of human behaviour can be modelled this way? I welcome your thoughts.

(*) Credits to C. Lam, great COMP student for this idea.