January 1, 2021

# Advent of Code 2020 day 20

Yak shaving and sea monsters

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:

1. Read the sea monster image
2. Assemble the complete image
3. 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
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.