Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25
Part 1
Day 20 is by far the most involved day so far, but also one of the most rewarding. We need to solve a literal jigsaw puzzle by piecing tiles together to form an image.
Representing a Tile
The tiles are given to us as two-dimensional arrays of Char (or [String]), with a tile "matching" another if the characters on the edge are aligned. While we could work with Char throughout our solution, this would imply performing a string comparison every time we check whether two tiles match. Anticipating that we will need to perform that check many times, we first seek a more convenient way to represent a single tile.
The trick employed in this solution is to represent only the edges of each tile by interpreting each edge as a binary representation of an integer, always reading in the clockwise direction. In order to make the matching step easier, we will also store the integer that results from reading in the reverse direction. Thus, each tile can have all of its edge information encoded in 4 integers, but we also store 4 redundant integers in order to speed up the processing later. For example, a 4x4 tile and its representation in this new format is shown below (replacing '#' with 1 and '.' with 0):
12 3
-> <-
1100 1100
7 ^ 1011 | | 1011 ^ 6
| 1001 v 6 15 v 1001 |
0100 0100
<- ->
2 4
This tile can be represented as ((12,6,2,7), (3,6,4,15))
For part 1, we only care about finding which tiles go in which slots, so we can convert our input and work only in this format for the rest of the solution. This conversion is implemented in getEdges below, a function that uses standard Data.List functions to get the corresponding edge string read in the correct direction, and then uses a toInt helper function (borrowed from our solution to Day 14) to obtain our integers.
import qualified Data.List as List
type Tile = [String]
type Edge = Int
type Edges = ((Edge, Edge, Edge, Edge), (Edge, Edge, Edge, Edge))
-- (i,r,m) represents tileId i rotated by r and mirrored iff m
type TileConfig = (Int, Int, Bool)
toInt :: String -> Int
toInt s =
let ds = map (\c -> if c == '#' then 1 else 0) s
in foldl (\b a -> 2 * b + a) 0 ds
rotate :: Int -> Edges -> Edges
rotate 0 es = es
rotate 1 ((e1, e2, e3, e4), (re1, re2, re3, re4)) =
((e2, e3, e4, e1), (re2, re3, re4, re1))
rotate n es = rotate (n - 1) (rotate 1 es)
mirror :: Bool -> Edges -> Edges
mirror False es = es
mirror True ((e1, e2, e3, e4), (re1, re2, re3, re4)) =
((re1, re4, re3, re2), (e1, e4, e3, e2))
isVertMatch :: Edges -> Edges -> Bool
isVertMatch top@(_,(_,_,re3,_)) bottom@((e1,_,_,_),_) = re3 == e1
isHorizMatch :: Edges -> Edges -> Bool
isHorizMatch left@(_,(_,re2,_,_)) right@((_,_,_,e4),_) = re2 == e4
getEdges :: Tile -> Edges
getEdges t =
let e1 = head t
e2 = map last t
e3 = reverse $ last t
e4 = reverse $ map head t
re1 = reverse e1
re2 = reverse e2
re3 = reverse e3
re4 = reverse e4
in ((toInt e1, toInt e2, toInt e3, toInt e4),
(toInt re1, toInt re2, toInt re3, toInt re4))
tileChoices :: [Tile] -> [(TileConfig, Edges)]
tileChoices tiles = do
m <- [False, True]
r <- [0..3]
(i, es) <- List.zip [0..] (List.map getEdges tiles)
return ((i, r, m), es)
We also implement rotate and mirror functions that simply rearrange our edges to what they would be if the tile were rotated or flipped horizontally. The isVertMatch and isHorizMatch functions are where this new format really pays off. Since we have the reversed edges stored as well, determining whether two tiles go together is as simple as an integer equality check between one "forward-read" edge and one "reverse-read" edge.
The other data type introduced here is TileConfig, which carries all information needed to specify a tile and how it is laid on the surface (assuming we have a list of Tiles somewhere that stores a "default" orientation of each tile). This includes the index of the tile, whether it is flipped from its default orientation, as well as how many 90-degree steps it is rotated. A tileChoices function takes our list of tiles and expands that list into a list of all orientations of all tiles (8 per tile), as well as the integer values representing the edges of the tile in the default orientation.
Finding a Layout via Backtracking
We will implement a backtracking solution in order to find a valid square arrangement of the 144 tiles. In fact, there will be exactly 8 possible arrangements, since the problem guarantees a unique solution to the puzzle which can then be rotated and/or mirrored. Of course, for part 1, we only care about the tile IDs of the four corner tiles, which will be the same for all 8 of those arrangements.
The backtracking approach is conceptually simple. Place tiles one-by-one, starting in the top left corner and then going across. Once the first row of 12 is placed, place the next row of 12, etc., until all 144 tiles are placed. At each step, we make sure that the tile placed fits with all tiles surrounding it that have already been placed. The backtracking kicks in when we reach a step where no tile fits, in which case we stop placing tiles for that attempt and let the algorithm try other placements for earlier tiles.
At first, a backtracking approach that attempts to make 144 decisions in which early steps have over a thousand possible branches (e.g., there are 144*8=1152 choices for the top left corner) seems scary. However, intuitively, the fact that there must be exactly one arrangement (symmetric solutions excluded) means that matching edges must be somewhat rare. Therefore, once we have placed a few tiles (and especially once we have placed enough tiles that further placements need to match two edges), the backtracking algorithm will very quickly run into dead-ends and not waste too much time in search spaces that cannot yield a solution. Let's give it a shot.
import Control.Monad
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Vector (Vector, (!))
import qualified Data.Vector as Vector
type AccState = ([TileConfig], Vector Edges, Set Int)
fitsNext :: Vector Edges -> Edges -> Bool
fitsNext v es =
let n = length v
fitsUp = if (n - dim) < 0
then True
else isVertMatch (v ! (n - dim)) es
fitsLeft = if n `mod` dim == 0
then True
else isHorizMatch (v ! (n - 1)) es
in fitsUp && fitsLeft
addAssignment :: AccState -> [(TileConfig, Edges)] -> [AccState]
addAssignment (cs, es, seen) allConfigs = do
(config@(t,r,m), rawNextEdges) <- allConfigs
nextEdges <- pure $ rotate r (mirror m rawNextEdges)
guard (not $ Set.member t seen)
guard (fitsNext es nextEdges)
updatedEdges <- pure $ Vector.snoc es nextEdges
updatedSeen <- pure $ Set.insert t seen
return (config:cs, updatedEdges, updatedSeen)
getValidAssignment :: [Tile] -> Int -> [TileConfig]
getValidAssignment ts d =
let tilePools = replicate (d*d) (tileChoices ts)
init = ([], Vector.empty, Set.empty)
(l,_,_) = head $ foldM addAssignment init tilePools
in l
We follow a similar approach to Day 16, using foldM in the List monad to implement the backtracking, as an empty tile candidate list (i.e., if there are no tiles orientations that fit in the tiles that we have accumulated so far) will very naturally cut off any further computation.
The layout is represented as a 1D Vector of Edges where the first 12 Edges represent the first row of tiles, the next 12 Edges represent the second row, etc. A fitsNext function takes the Vector that we have built up so far as well as a candidate tile (already oriented, and represented as its integer Edges). It performs some index arithmetic and the isVertMatch/isHorizMatch functions to check the match with the tile above and the tile to the left, if applicable. If we build up our layout in the manner described above, these two checks are sufficient for ensuring that the entire puzzle fits together at the end.
We need to accumulate into three data structures throughout our solution, grouped into the AccState type. The first is a list of TileConfig, which stores which tiles we have placed thus far, and how they are oriented. The second is a Vector of Edges representing the edges of the tiles we have placed thus far, which is used in conjunction with fitsNext in order to determine whether a next candidate tile is a fit (this is technically redundant information as it could be generated from the [TileConfig], but storing it saves us from having to do so over and over). Finally, a Set of Int that simply stores which tiles have been used already. Because we draw from a pool of all possible tile orientations, we need a way to say that once tile X has been placed in our current layout, all orientations of X cannot be used in later positions.
addAssignment takes the current AccState, and "folds" in a list of all possible TileConfigs with the corresponding Edges. We simply take each possible configuration and try it in the next position. Two guard statements ensure that for each candidate, we only proceed if the tile has not been used yet, and if it fits with what has already been placed. Since we are computing within the List monad, we will return a list of possible ways to extend the current AccState.
Finally, getValidAssignment performs the foldM, "folding" in 144 copies of all possible tile configurations to obtain a list of AccStates, each of which represents 144 successfully placed tiles (again, we expect this list to have 8 elements). We can arbitrarily select the first one found as a valid assignment, and then extract the [TileConfig].
Putting It All Together
With the heavy lifting done, we just need to stitch it all together to answer the question.
import D20input
-- dim :: Int
-- tileIds :: [Int]
-- tilesRaw :: [String]
import qualified Data.List as List
cornerIndices :: Int -> [Int]
cornerIndices d = [0, d-1, d*(d-1), d*d-1]
blankLineSplit :: [String] -> [[String]]
blankLineSplit lines =
let matchingBlankLineStatus s1 s2 = (s1 == "") == (s2 == "")
grouped = List.groupBy matchingBlankLineStatus lines
isNotBlankLineGroup g = (head g) /= ""
in filter isNotBlankLineGroup grouped
solve :: Integer
solve = let tiles = blankLineSplit tilesRaw
assignment = getValidAssignment tiles dim
cornerTiles = List.map (assignment !!) (cornerIndices dim)
tileIndices = List.map (\(t,_,_) -> toInteger (tileIds !! t)) cornerTiles
in List.foldr (*) 1 tileIndices
main :: IO ()
main = print $ solve
We borrow the blankLineSplit function developed in Day 6 to help get the individual tiles. Then, we use getValidAssignment to obtain a valid layout, get the indices of the tiles used in the corners, map those back to tile IDs, and then multiply it all together.
The compiled binary finds the answer in under 0.2s on my i7-4790, so we see that our intuition about how quickly the backtracking would converge on a valid arrangement holds up well.
Part 2
Part 2 is, in my opinion, quite a bit easier, but still requires a fair bit of work. We need to now stitch together the full image and then count occurrences of a pattern.
Reconstructing the Image
In part 1, we got away with only performing rotations and mirrorings in the Edges, but now we need to perform these operations for the full tile. We also need to strip the border of each tile, as they do not contribute to the final image. These are implemented in rotateTile, mirrorTile, and stripBorder below. orientTile puts these three together to obtain the full tile from a TileConfig.
rotateTile :: Int -> Tile -> Tile
rotateTile 0 = id
rotateTile 1 = reverse . List.transpose
rotateTile n = ((rotateTile (n - 1)) . (rotateTile 1))
mirrorTile :: Bool -> Tile -> Tile
mirrorTile False = id
mirrorTile True = List.map reverse
stripBorder :: Tile -> Tile
stripBorder t =
let n = length t
takeInner = (take (n-2)) . tail
in takeInner $ List.map takeInner t
orientTile :: [Tile] -> TileConfig -> Tile
orientTile allTiles (i,r,m) =
let t = allTiles !! i
ot = rotateTile r $ mirrorTile m t
in stripBorder ot
reconstructRow :: [Tile] -> [TileConfig] -> Tile
reconstructRow allTiles configs =
let row = List.map (orientTile allTiles) configs
in foldl (List.zipWith (++)) (head row) (tail row)
reconstruct :: Int -> [Tile] -> [TileConfig] -> Tile
reconstruct d allTiles configs =
let rows = chunksOf d configs
in concat $ List.map (reconstructRow allTiles) rows
Then, reconstruct and reconstructRow use zip and concatenation (with special guest appearance by chunksOf) to take the oriented tiles and merge them into one super-tile.
Counting Monsters
We are given a 3x20 sub-image and need to count the number of times the sub-image "appears" in the overall image. "Appears" in this case means that the original image must have a '#' when the sub-image has a '#', but can also have a '#' even when the sub-image does not. This is a contextual computation similar to what we needed to do for Day 11 and Day 17, although we will implement it slightly differently, since we are working with a Tile is really a [[Char]] under the hood, and we don't really want to migrate over to Vector just to get faster indexing.
containsHashes :: String -> String -> Bool
containsHashes m t =
let isMismatch (cm, ct) = cm == '#' && ct /= '#'
mismatches = filter isMismatch $ zip m t
in null mismatches
isMonster :: Tile -> Tile -> Bool
isMonster monster tile =
all (uncurry containsHashes) (zip monster tile)
extractTiles :: Int -> Int -> Tile -> [Tile]
extractTiles h w t = do
n <- pure $ length t
i <- [0..n-h]
j <- [0..n-w]
return $ take h $ drop i $ (List.map ((take w) . (drop j)) t)
countMonsters :: Tile -> Tile -> Int
countMonsters m t =
let h = length m
w = length $ head m
candidates = extractTiles h w t
monsters = filter (isMonster m) candidates
in length monsters
First, a containsHashes function takes two strings and returns whether the second contains '#' whenever the first does. This is implemented by creating a list of mismatches: Char pairs in which the first has a '#' but the second does not. If this list is empty, then the strings "match", and the function returns True. Otherwise, it returns False.
The isMonster function uses containsHashes to compare entire Tiles. If all rows "match" via containsHashes, then the tiles "match".
extractTiles takes the entire image and generates the list of all sub-images of a given dimension (here, we will end up passing h = 3, w = 20). With the dimensions passed as parameters, we can obtain a sub-tile of the given size, starting at each possible top left by dropping and taking the appropriate number of elements in each dimension.
countMonsters uses all of the above to count all of the sub-images that appear in the full image.
Putting It All Together Again
Almost there! One quirk of this problem is that we took an arbitrary orientation of 8 possible orientations of the full image, but the problem guarantees that only one of those 8 will contain monsters. We first write an allOrientations function, similar to tileChoices above, which takes an image and generates a list of all 8 orientations. getNumMonsters then uses this to count the monsters in all 8, which will only have 1 non-zero count. Filtering for this count gives the total number of monsters found in the image, irrespsective of which orientation our backtracking algorithm happened to find.
The problem actually asks us for the number of '#' in the full image that do not belong to a monster. The solve function computes this for us by counting the total number of '#' characters, and then performing a subtraction based on the monster count.
import D20input
-- dim :: Int
-- tilesRaw :: [String]
-- monster :: [String]
allOrientations :: Tile -> [Tile]
allOrientations t = do
m <- [False, True]
r <- [0..3]
return $ rotateTile r $ mirrorTile m t
getNumMonsters :: Tile -> Tile -> Int
getNumMonsters m t =
let allCounts = List.map (countMonsters m) (allOrientations t)
in head $ filter (>0) allCounts
numHashes :: [String] -> Int
numHashes = sum . (List.map (length . (filter (=='#'))))
solve :: Int
solve = let tiles = blankLineSplit tilesRaw
assignment = getValidAssignment tiles dim
fullMap = reconstruct dim tiles assignment
numMonsters = getNumMonsters monster fullMap
numHashesInMap = numHashes fullMap
numHashesInMonster = numHashes monster
in numHashesInMap - (numMonsters * numHashesInMonster)
main :: IO ()
main = print $ solve
Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25