Day 20 was a lot of effort, in that there were a lot of moving parts, even though no single part was particularly difficult.
I'll start by getting the yak shaving out of the way, describing the data structures and some utility functions needed to express the problems and solutions. When I've done that, I can get into the meat of the tasks themselves.
Data types and utilities
There are a few things to name, to make life easier. Some Pixels are the grid of Boolean values that make up an image or sub-image. A Tile is one of the small images, consisting of the Pixels and the ID. ( Tiles don't record if they've been transformed: I considered storing that, but YAGNI led me to leave it out until it was necessary. It turns out, it wasn't necessary.) A Border is the one-dimensional strip of pixels on the edge of an image. An Arrangement is the layout of tiles to form the whole image.
I'm using unboxed, immutable arrays of Bools for the Pixels. Note that they contain their bounds, which means I don't need to keep passing around the sizes of things. I decided to use the (row, column) convention for addressing pixels, and use zer0-based indexing.
type Coord = (Int, Int)
type Pixels = A.UArray Coord Bool
type Border = A.UArray Int Bool
data Tile = Tile
{ tId :: Integer
, pixels :: Pixels
} deriving (Show, Eq)
type Arrangement = M.Map Coord Tile
Parsing the input isn't overly tricky, apart from the need to build the pixels by hand.
tilesP = tileP `sepBy` blankLines
blankLines = many endOfLine
tileP = Tile <$> ("Tile " *> decimal) <* ":" <* endOfLine <*> pixelsP
pixelsP = pixify <$> (pixelsRowP `sepBy` endOfLine)
pixelsRowP = many1 (satisfy (inClass " .#"))
pixify :: [String] -> Pixels
pixify rows = A.array ((0, 0), (nRows, nCols))
[ ((r, c), (rows!!r)!!c == '#')
| r <- [0..nRows]
, c <- [0..nCols]
]
where nRows = length rows - 1
nCols = (length $ head rows) - 1
I also created showTile and showP (show pixels) functions to aid debugging. They're not used in the final solution.
showTile Tile{..} = show tId ++ "\n" ++ (showP pixels)
showP ps = unlines [[bool ' ' '\x2588' (ps!(r, c)) | c <- [0..cMax] ] | r <- [0..rMax]]
where (_, (rMax, cMax)) = A.bounds ps
Finding borders
From a tile, I need to find the borders of that tile's pixels. I do this with a list comprehension to find the indices I want, extract those pixels, and use listArray to build the Border.
topBorder :: Tile -> Border
topBorder Tile{..} = A.listArray (0, c1) [pixels!(0, c) | c <- [0..c1] ]
where (_, (_, c1)) = A.bounds pixels
bottomBorder :: Tile -> Border
bottomBorder Tile{..} = A.listArray (0, c1) [pixels!(r1, c) | c <- [0..c1] ]
where (_, (r1, c1)) = A.bounds pixels
leftBorder :: Tile -> Border
leftBorder Tile{..} = A.listArray (0, r1) [pixels!(r, 0) | r <- [0..r1] ]
where (_, (r1, _)) = A.bounds pixels
rightBorder :: Tile -> Border
rightBorder Tile{..} = A.listArray (0, r1) [pixels!(r, c1) | r <- [0..r1] ]
where (_, (r1, c1)) = A.bounds pixels
Matching tiles horizontally and vertically is a case of testing if the corresponding edges are equal.
matchHorizontal tile1 tile2 = (rightBorder tile1) == (leftBorder tile2)
matchVertical tile1 tile2 = (bottomBorder tile1) == (topBorder tile2)
Transforming images
All the transforms of an image require just rotation by 90⁰ and reflection, and then some composition of those operations. That means I need just two transformation functions. Each takes a Tile and returns a transformed Tile.
-- rotate quarter turn clockwise
tRotate tile = tile {pixels = pixels'}
where bs = pixels tile
(_, (r1, c1)) = A.bounds bs
pixels' = A.ixmap ((0, 0), (c1, r1)) rotateIndex bs
rotateIndex (r, c) = (r1 - c, r) -- how to get to the old index from the new one
tFlip tile = tile {pixels = pixels'}
where bs = pixels tile
(_, (r1, c1)) = A.bounds bs
pixels' = A.ixmap ((0, 0), (r1, c1)) flipIndex bs
flipIndex (r, c) = (r, c1 - c) -- how to get to the old index from the new one
The only wrinkle in these is the slightly odd formation of ixmap: it takes a function that, for a location in the new array, returns the corresponding location in the old array. That took me a while to figure out why my tRotate was rotation anticlockwise rather than clockwise.
From those, I can find all eight transforms of a tile by using a list comprehension. (I could have done something clever with iterate for the repeated rotations, but decided this was just as quick and more explicit.)
transforms :: Tile -> [Tile]
transforms tile =
[ r $ f tile
| r <- [id, tRotate, tRotate . tRotate, tRotate . tRotate . tRotate]
, f <- [id, tFlip]
]
Assembling the grid
I had a few options for this. Assembling tiles into an arrangement is a nondeterministic process, as I don't know which tile to place first. The List monad is the classic example of how to do that. I could have used an explicit search of tile placements (similar to last year's day 20). An explicit search could also use a heuristic (similar to last year's day 18, using A* search), such as the most-constrained-placement heuristic. That also suggested using a constraint satisfaction solver, as I did on day 16.
In the end, I thought I'd start with the simplest approach, the List monad, and see if that worked. It turns out, that was enough.
arrangeTiles takes the number of tiles in each dimension of the arrangement, and returns just one arrangement (there will be eight variants of each solution, one for each transform of the overall arrangement). It does this by folding the locations of the arrangement, with each step being the insertion of a tile at this location. But as I'm using a List monad, I use the monadic fold foldM. And note the use of init in the definition of locations to ensure I only fold over as many locations as are legal.
arrange does the work. Given a position and a state of the arrangement so far, it adds a tile to this position; the state of the arrangement is the pair of the overall arrangement and the tiles remaining. It picks an arbitrary tile of those available, an arbitrary arrangement of that tile, checks it matches the tiles above and to the left, then returns the updated arrangement. Not that it also deletes this tile from the tiles available, to ensure no tile is used twice.
arrangeTiles :: Int -> [Tile] -> Arrangement
arrangeTiles rMax tiles = fst $ head $ foldM arrange (M.empty, tiles) locations
where locations = init $ scanl nextLoc (0, 0) tiles
nextLoc (r, c) _ = if c == rMax then (r + 1, 0) else (r, c + 1)
arrange :: (Arrangement, [Tile]) -> Coord -> [(Arrangement, [Tile])]
arrange (grid, tiles) (r, c) =
do tile <- tiles
transTile <- transforms tile
guard $ if r == 0 then True else matchVertical tileAbove transTile
guard $ if c == 0 then True else matchHorizontal tileLeft transTile
return (M.insert (r, c) transTile grid, delete tile tiles)
where tileAbove = grid M.! (r - 1 , c)
tileLeft = grid M.! (r, c - 1)
All that's left is to set up arrangeTiles and extract the IDs of the corners of the arrangements.
main :: IO ()
main =
do text <- TIO.readFile "data/advent20.txt"
let tiles = successfulParse text
let arrangeRMax = (floor $ sqrt @Double $ fromIntegral $ length tiles) - 1
let arrangement = arrangeTiles arrangeRMax tiles
print $ part1 arrangeRMax arrangement
part1 rMax arrangement
= product
$ M.elems $ M.map tId
$ M.filterWithKey (isCorner rMax) arrangement
isCorner _ (0, 0) _ = True
isCorner l (0, c) _ = c == l
isCorner l (r, 0) _ = r == l
isCorner l (r, c) _ = r == l && c == l
Finding Sea Monsters
This involved a few stages:
- Read the sea monster image
- Assemble the complete image
- Find sea monsters in the image and hence the roughness remaining
And all of that on the possible transforms of the image, and picking the correct answer!
I stored the sea monster image as a file, and read and parse it in the same way as the tiles.
readSeaMonster :: IO Pixels
readSeaMonster =
do text <- TIO.readFile "data/advent20seamonster.txt"
return $ case parseOnly pixelsP text of
Left _err -> A.listArray ((0, 0), (1, 1)) []
Right seaMonster -> seaMonster
Assembling the image
Assembling the image involved walking over each pixel of each tile in the arrangement, calculating where it needs to go, then creating the image as Pixels. I did the assembly of the imageElements as another list monad, so that I could use let clauses for intermediate calculations which (hopefully) makes things easier to understand.
assembleImage :: Int -> Arrangement -> Pixels
assembleImage arrangeRMax arrangement =
A.array ((0,0), (imageRMax, imageRMax)) imageElements
where (_, (tileRMax, _)) = A.bounds $ pixels $ arrangement M.! (0, 0)
tRM1 = tileRMax - 1
imageRMax = tRM1 * (arrangeRMax + 1) - 1
imageElements =
do ar <- [0..arrangeRMax] -- arrangement row
ac <- [0..arrangeRMax]
tr <- [1..tRM1] -- tile pixels row
tc <- [1..tRM1]
let px = (pixels $ arrangement M.! (ar, ac)) ! (tr, tc)
let ir = (ar * tRM1) + (tr - 1) -- assembled image row
let ic = (ac * tRM1) + (tc - 1)
return ((ir, ic), px)
Finding sea monsters
The idea is to slide the sea monster pixels across the image, to I overlay the sea monster in all the position it fits. At each position, I check whether there actually is a sea monster at this location. (This is essentially the idea of convolutions and kernel processing in image processing.) If I find a monster, findSeaMonsters returns its position (useful for testing).
There is a seaMonsterPresent if, for every pixel in the sea monster, that pixel is set and the underlying pixel in the image is also set.
findSeaMonsters :: Pixels -> Pixels -> [Coord]
findSeaMonsters sm image = [ (r, c)
| r <- [0..(imR - smR)]
, c <- [0..(imC - smC)]
, seaMonsterPresent sm image r c
]
where (_, (smR, smC)) = A.bounds sm
(_, (imR, imC)) = A.bounds image
seaMonsterPresent sm image dr dc = all bothPresent $ A.indices sm
where bothPresent (r, c) = if (sm!(r, c))
then (image!(r + dr, c + dc))
else True
For calculating the final roughness of the image, I assumed that the images of sea monsters don't overlap, so the number of pixels in sea monster images is the number of pixels in a sea monster times the number of monsters. That makes the roughness calculation a simple matter of subtraction.
countRoughness sm image = imPixels - (smPixels * nSeaMonsters)
where smPixels = countPixels sm
imPixels = countPixels image
nSeaMonsters = length $ findSeaMonsters sm image
countPixels :: Pixels -> Int
countPixels = length . filter (== True) . A.elems
All that's left is to calculate the roughness in each transformation of the image, and return the smallest (the one with the most sea monsters).
part2 seaMonster image = minimum $ map (countRoughness seaMonster) transImages
where imgTile = Tile 0 image
transImages = map pixels $ transforms imgTile
Code
You can find the code here or on GitLab.