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
|
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
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!
Now that the semester is drawing to a close, a fellow tutor and I were discussing some cool puzzles and other activities we could get our students to think about.
We came up with a creative programming puzzle that went something along the lines of this:
Without using any loops, helper functions, IO, unstructured control, global or static variables, write a function with the prototype:
void nLogNRecursive (unsigned int n)
of complexity n log n, where n is the integer passed into the function. You may specify the range of valid inputs for n, but make it as large as you can.
Here is my solution.
I started by considering the two parts of a typical n log n function - the O(n) operation, and the recursive delegation into each half of the input.
1
2
3
| orderNOp(n);
nLogNRecursive(n/2);
nLogNRecursive(n/2);
|
Right, having done this, this meant that somehow I would have to implement an O(n) operation using the same function that was meant to perform an O(n log n) operation! Somewhat difficult.
My first approach was a bit crap, as it drastically reduced the range of possible n inputs. I treated the first (little-end) half of the input integer as the actual input, and if the second half was non-zero, would delegate recursively using the first half number. If the second half was not-zero, then I would ignore the first half and decrement the second half recursively until it hit zero. This way, depending on which half of the integer was set, I determined my behavior:
0x0010|0000 -> perform O(n) operation for n = 17
0x0000|0010 -> perform O(n log n) operation for n = 17
Essentially, I used bitwise operations to cram two arguments into the one integer. Here's the full solution for this approach:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
#define first(n) (n & 0xFFFF)
#define second(n) ((n & ~0xFFFF) >> 16)
#define to_s(n) (n << 16)
void nLogNRecursive (unsigned int n) {
if (second(n) == 0) {
if (first(n) > 1) {
nLogNRecursive(to_s(first(n)));
nLogNRecursive(first(n)/2);
nLogNRecursive(first(n)/2);
}
} else {
if (second(n) > 0) {
nLogNRecursive(to_s(second(n)-1));
constant();
}
}
}
|
This works okay, I guess, but the question asks us to maximize our input size. Seeing as the function only works with one working copy of n at a time (either n from which we subtract one, or n which we divide by two), we could use 31 bits of the integer to represent our n, and just the most significant (and least often used) bit of the integer to be a boolean flag as to which n we are using. Here's the updated solution, and, I think, the best way to solve this problem. Please comment if you discover a better way, preferably one that sacrifices no bits.
Still, this gives you the same positive range as a signed int, which is pretty big.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
#define deflag(n) (n & (~ (1 << 31)))
#define enflag(n) (n | ( 1 << 31) )
#define flag(n) (n & (1 << 31))
void nLogNRecursive2 (unsigned int n) {
if (flag(n) == 0) {
if (n > 1) {
nLogNRecursive2(enflag(n));
nLogNRecursive2(n/2);
nLogNRecursive2(n/2);
}
} else {
if (deflag(n) > 0) {
nLogNRecursive2(enflag(deflag(n)-1));
constant();
}
}
}
|
Please comment if you think of a better way!
