Done day 22
[advent-of-code-23.git] / advent13 / Main.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/15/advent-of-code-2023-day-13/
2
3 import AoC
4 import Data.List
5 import Data.List.Split
6
7 type Pattern = [String]
8 data Line = Horiz Int | Vert Int deriving (Show, Eq)
9
10 main :: IO ()
11 main =
12 do dataFileName <- getDataFileName
13 text <- readFile dataFileName
14 let patts = fmap lines $ splitOn "\n\n" text
15 print $ part1 patts
16 print $ part2 patts
17
18 part1, part2 :: [Pattern] -> Int
19 part1 = sum . fmap (score . head . reflections)
20 part2 = sum . fmap (score . head . newReflections)
21
22 score :: Line -> Int
23 score (Vert x) = x
24 score (Horiz x) = 100 * x
25
26 reflections, newReflections :: Pattern -> [Line]
27 reflections patt = nub $ vlines ++ hlines
28 where vlines = fmap Vert $ reflectionLines patt
29 hlines = fmap Horiz $ reflectionLines $ transpose patt
30
31 newReflections patt = newRefls \\ oldRefls
32 where oldRefls = reflections patt
33 newRefls = nub $ concatMap reflections $ smudged patt
34
35
36 reflectionLines :: Eq a => [[a]] -> [Int]
37 reflectionLines xss = [n | n <- [1..k], allReflectAt n xss]
38 where k = (length $ head xss) - 1
39
40 allReflectAt :: Eq a => Int -> [[a]] -> Bool
41 allReflectAt n xss = all id $ fmap (reflectsAt n) xss
42
43 reflectsAt :: Eq a => Int -> [a] -> Bool
44 reflectsAt n xs = all id $ zipWith (==) (reverse h) t
45 where (h, t) = splitAt n xs
46
47 smudged :: Pattern -> [Pattern]
48 smudged patt = unfoldr go (0, 0)
49 where rMax = (length patt) - 1
50 cMax = (length $ head patt) - 1
51 go (r, c)
52 | r > rMax = Nothing
53 | c == cMax = Just (smudgeHere r c patt, (r + 1, 0))
54 | otherwise = Just (smudgeHere r c patt, (r, c + 1))
55
56 smudgeHere :: Int -> Int -> Pattern -> Pattern
57 smudgeHere r c p = preRows ++ [preRow ++ [smg] ++ sufRow] ++ sufRows
58 where preRows = take r p
59 sufRows = drop (r + 1) p
60 row = p !! r
61 preRow = take c row
62 sufRow = drop (c + 1) row
63 -- smg = smudgeOne $ row !! c
64 smg = case (row !! c) of
65 '.' -> '#'
66 '#' -> '.'
67 -- _ -> '?'
68
69 -- smudgeOne :: Char -> Char
70 -- smudgeOne '.' = '#'
71 -- smudgeOne '#' = '.'