Solving a puzzle in Haskell

Step 1: Understanding the problem

segments :: [Int]
segments =
[2, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 2]
type Pos = (Int, Int, Int)data Dir = F | B | L | R | U | D deriving (Show)move :: Dir -> Pos -> Pos
move F (i, j, k) = (i + 1, j, k)
move B (i, j, k) = (i - 1, j, k)
move L (i, j, k) = (i, j - 1, k)
move R (i, j, k) = (i, j + 1, k)
move U (i, j, k) = (i, j, k + 1)
move D (i, j, k) = (i, j, k - 1)

Step 2: Recursive tree search

turns :: Dir -> [Dir]
turns F = [L, R, U, D]
turns B = [L, R, U, D]
turns L = [F, B, U, D]
turns R = [F, B, U, D]
turns U = [F, B, L, R]
turns D = [F, B, L, R]
data SearchState = SearchState {
currentPos :: Pos,
currentDir :: Dir,
remainingSegments :: [Int],
usedPositions :: Set Pos
}
  1. What’s the last position of a segment that I’ve decided to place?
  2. What direction am I planning to move next?
  3. What are the segments I haven’t placed yet?
  4. Which positions already have blocks in them (since two blocks cannot land in the same position)?
initialSearchStates :: [SearchState]
initialSearchStates = [
SearchState {
currentPos = (0, j, k),
currentDir = F,
remainingSegments = segments,
usedPositions = Set.empty
}
| j <- [0..2], k <- [0..2] ]
goodPosition :: Set Pos -> Pos -> Bool
goodPosition used pos =
inRange ((0,0,0),(2,2,2)) pos && not (pos `Set.member` used)
search :: SearchState -> [[Dir]]
search SearchState{ remainingSegments = [] } = [[]]
search SearchState{..}
| all (goodPosition usedPositions) cover
= [ currentDir : solution
| dir' <- turns currentDir
, solution <- search SearchState{
currentPos = last covered,
currentDir = dir',
remainingSegments = segs,
usedPositions = foldr Set.insert usedPositions
(init cover)
}
]
| otherwise = []
where s:segs = remainingSegments
cover = take (s + 1) (iterate (move currentDir) currentPos)
theAnswer :: [Dir]
theAnswer = head (concatMap search initialSearchStates)

Step 3: Visualization

blocks :: [Pos]
blocks = follow (0, 0, 0) (zip theAnswer segments)
where follow p [] = [p]
follow p ((_, 0) : steps) = follow p steps
follow p ((d, n) : steps)
= p : follow (move d p) ((d, n - 1) : steps)
main :: IO ()
main = activityOf initial change picture
initial :: Int
initial = 1
change :: Event -> Int -> Int
change (KeyPress "Up") n = n + 1
change (KeyPress "Down") n = n - 1
change other n = n
  1. The pictures of individual blocks must be overlapped in the right order, so that blocks nearest the user obscure the blocks further away.
  2. The sides must be projected from three dimensions into two. I chose an isometric projection, so that I can be sure there are only three visible sides.
picture :: Int -> Picture
picture n = pictures [
drawBlock p
| p <- sortBy (comparing viewSortKey) (take n blocks)
]
where viewSortKey (i, j, k) = (i, -j, -k)
drawBlock :: Pos -> Picture
drawBlock (i, j, k) = pictures [
-- The front face.
colored (light gray) $ solidPolygon [
project p | p <- [ (x + 0.5, y + 0.5, z - 0.5),
(x + 0.5, y - 0.5, z - 0.5),
(x - 0.5, y - 0.5, z - 0.5),
(x - 0.5, y + 0.5, z - 0.5) ] ],
-- The top face.
colored gray $ solidPolygon [
project p | p <- [ (x + 0.5, y + 0.5, z + 0.5),
(x + 0.5, y + 0.5, z - 0.5),
(x - 0.5, y + 0.5, z - 0.5),
(x - 0.5, y + 0.5, z + 0.5) ] ],
-- The right face.
colored (dark gray) $ solidPolygon [
project p | p <- [ (x + 0.5, y + 0.5, z + 0.5),
(x + 0.5, y + 0.5, z - 0.5),
(x + 0.5, y - 0.5, z - 0.5),
(x + 0.5, y - 0.5, z + 0.5) ] ]
]
where x = fromIntegral j
y = fromIntegral k
z = fromIntegral i
project :: (Double, Double, Double) -> Point
project (x, y, z) = (3 * x + (1 + sin t / 4) * z,
3 * y + (1 + cos t / 4) * z)
The solver for the snake puzzle

--

--

--

Software engineer, volunteer K-12 math and computer science teacher, author of the CodeWorld platform, amateur ring theorist, and Haskell enthusiast.

Love podcasts or audiobooks? Learn on the go with our new app.

Recommended from Medium

Facade Design Pattern in General life.

Introducing a Rust-lang API client for the Unleash API

A woman with a leashed lobster

Apache Apex in a Nutshell

Create a Running Docker Container With Gunicorn and Flask

Building’s foundation

[**Free Download**] 2015 International Building Code Commentary, Volume 1 TXT,PDF,EPUB

How Compliance Automation impact your Business

FEC Engineering Journal and Notes

Meet the First Cohort of Clover Health’s ASE Program

Get the Medium app

A button that says 'Download on the App Store', and if clicked it will lead you to the iOS App store
A button that says 'Get it on, Google Play', and if clicked it will lead you to the Google Play store
Chris Smith

Chris Smith

Software engineer, volunteer K-12 math and computer science teacher, author of the CodeWorld platform, amateur ring theorist, and Haskell enthusiast.

More from Medium

What does Isequal(2) mean in Julia?

Learning Pilog -3: Unification and Proof Search

HasCal — A promising embedding of pluscal in haskell.

Basic Set Theory by Exercises: Countable Sets.