eldridge.cam
Advent of Code solutions
2020:20
+31
-3
2020/20/p1.hs
+31
-3
2020/20/p1.hs
···
1
1
import Text.Parsec
2
+
import Control.Monad
3
+
import Data.List
4
+
import Data.IntMap.Strict (IntMap, (!))
5
+
import Data.IntMap.Strict qualified as IntMap
6
+
7
+
data Tile = Tile { top :: String, right :: String, bottom :: String, left :: String } deriving (Show)
8
+
9
+
makeTile grid = Tile (head grid) (last dirg) (last grid) (head dirg)
10
+
where dirg = transpose grid
2
11
3
-
makeTile grid = []
12
+
rotations tile = take 4 $ iterate rotate tile
13
+
14
+
flips tile@(Tile t r b l) = [tile, Tile (reverse t) l (reverse b) r]
15
+
16
+
rotate (Tile t r b l) = Tile (reverse l) t (reverse r) b
4
17
5
18
parseTile = do
6
19
string "Tile "
···
12
25
13
26
parseTiles = parseTile `endBy` newline
14
27
15
-
answer contents = 0
28
+
solutions :: Int -> Int -> IntMap (Int, Tile) -> IntMap Tile -> [IntMap (Int, Tile)]
29
+
solutions _ _ grid tiles | IntMap.null tiles = return grid
30
+
solutions size at grid tiles = do
31
+
(id, tile) <- IntMap.assocs tiles
32
+
rotn <- flips =<< rotations tile
33
+
guard $ at `mod` size == 0 || left rotn == (right $ snd $ grid ! (at - 1))
34
+
guard $ at < size || top rotn == (bottom $ snd $ grid ! (at - size))
35
+
solutions size (at + 1) (IntMap.insert at (id, rotn) grid) (IntMap.delete id tiles)
36
+
37
+
answer contents = head $ do
38
+
solution <- solutions size 0 IntMap.empty tiles
39
+
return $ (fst $ solution ! 0)
40
+
* (fst $ solution ! (size - 1))
41
+
* (fst $ solution ! (size * size - size))
42
+
* (fst $ solution ! (size * size - 1))
16
43
where
17
-
Right input = parse parseTiles "" contents
44
+
Right tiles = IntMap.fromList <$> parse parseTiles "" contents
45
+
size = round $ sqrt $ fromIntegral $ length tiles
18
46
19
47
main = getContents >>= print . answer
+87
2020/20/p2.hs
+87
2020/20/p2.hs
···
1
+
import Text.Parsec
2
+
import Data.Bits
3
+
import Control.Monad
4
+
import Data.List
5
+
import Data.IntMap.Strict (IntMap, (!))
6
+
import Data.IntMap.Strict qualified as IntMap
7
+
8
+
data Tile = Tile { image :: [String], top :: String, right :: String, bottom :: String, left :: String }
9
+
10
+
makeTile grid = Tile (stripBorder grid) (head grid) (last dirg) (last grid) (head dirg)
11
+
where dirg = transpose grid
12
+
13
+
rotations tile = take 4 $ iterate rotateTile tile
14
+
15
+
flips tile@(Tile i t r b l) = [tile, Tile (reverse <$> i) (reverse t) l (reverse b) r]
16
+
17
+
rotateTile (Tile i t r b l) = Tile (rotateGrid i) (reverse l) t (reverse r) b
18
+
19
+
rotateGrid = transpose . reverse
20
+
21
+
parseTile = do
22
+
string "Tile "
23
+
id :: Int <- read <$> many digit
24
+
char ':'
25
+
newline
26
+
rows <- count 10 (oneOf ".#") `endBy` newline
27
+
return (id, makeTile rows)
28
+
29
+
parseTiles = parseTile `endBy` newline
30
+
31
+
solutions :: Int -> Int -> IntMap Tile -> IntMap Tile -> [IntMap Tile]
32
+
solutions _ _ grid tiles | IntMap.null tiles = return grid
33
+
solutions size at grid tiles = do
34
+
(id, tile) <- IntMap.assocs tiles
35
+
rotn <- flips =<< rotations tile
36
+
guard $ at `mod` size == 0 || left rotn == (right $ grid ! (at - 1))
37
+
guard $ at < size || top rotn == (bottom $ grid ! (at - size))
38
+
solutions size (at + 1) (IntMap.insert at rotn grid) (IntMap.delete id tiles)
39
+
40
+
windows size [] = []
41
+
windows size xs = group : windows size rest
42
+
where (group, rest) = splitAt size xs
43
+
44
+
seamonster = bitmap <$>
45
+
[ " # "
46
+
, "# ## ## ###"
47
+
, " # # # # # # "
48
+
]
49
+
50
+
stripBorder = fmap (init . tail) . init . tail
51
+
52
+
bitmap :: String -> Integer
53
+
bitmap = foldr pushbit 0
54
+
where
55
+
pushbit '#' n = n `shiftL` 1 + 1
56
+
pushbit '.' n = n `shiftL` 1
57
+
pushbit ' ' n = n `shiftL` 1
58
+
59
+
findSeaMonsters :: [Integer] -> [Integer]
60
+
findSeaMonsters image@(_:_:_:_) = a : (b .|. b2) : (c .|. c2) : rest
61
+
where
62
+
[a,b,c] = scanRows (take 3 image)
63
+
(b2:c2:rest) = findSeaMonsters (tail image)
64
+
scanRows :: [Integer] -> [Integer]
65
+
scanRows rows
66
+
| any (== 0) rows = [0, 0, 0]
67
+
| isMonster rows = zipWith (.|.) seamonster $ scanRest
68
+
| otherwise = scanRest
69
+
where scanRest = fmap (`shiftL` 1) $ scanRows $ fmap (`shiftR` 1) rows
70
+
71
+
isMonster [a, b, c] = a .&. top == top && b .&. mid == mid && c .&. bot == bot
72
+
73
+
[top, mid, bot] = seamonster
74
+
findSeaMonsters _ = [0, 0]
75
+
76
+
population :: [String] -> Int
77
+
population = length . filter (== '#') . concat
78
+
79
+
answer :: String -> Int
80
+
answer contents = population fullimage - seamonsters
81
+
where
82
+
Right tiles = IntMap.fromList <$> parse parseTiles "" contents
83
+
size = round $ sqrt $ fromIntegral $ length tiles
84
+
fullimage = concat $ fmap (fmap concat . transpose) $ windows size $ fmap image $ IntMap.elems $ head $ solutions size 0 IntMap.empty tiles
85
+
seamonsters = maximum $ fmap (sum . fmap popCount . findSeaMonsters . fmap bitmap) $ take 4 $ iterate rotateGrid $ fullimage
86
+
87
+
main = getContents >>= print . answer