The solution to Day 13 was mostly a tour of the standard Data.List and Data.List.Split libraries, which were fun to exploit.

The only data types I used are to keep track of the reflection lines I find. I could have defined a new data type for the pattern cells (or reused something like Bool) but I didn't see the point for this problem.

type Pattern = [String]
data Line = Horiz Int | Vert Int deriving (Show, Eq)

Reading the data uses only standard functions.

let patts = fmap lines $ splitOn "\n\n" text

Part 1

Working from the bottom up, a line reflectsAt a particular position if I split it at that position, and the first section (reversed) matches the second section. The semantics of zipWith mean the surplus of the longer section is discarded.

A pattern reflects at a position if all the lines reflect at that position.

I can find all the lines of reflection symmetry by just trying them all, making sure to leave at least one column before and after the split.

reflectionLines :: Eq a => [[a]] -> [Int]
reflectionLines xss = [n | n <- [1..k], allReflectAt n xss]
  where k = (length $ head xss) - 1

allReflectAt :: Eq a => Int -> [[a]] -> Bool
allReflectAt n xss = all id $ fmap (reflectsAt n) xss

reflectsAt :: Eq a => Int -> [a] -> Bool
reflectsAt n xs = all id $ zipWith (==) (reverse h) t
  where (h, t) = splitAt n xs

From that, I can find all the reflections of a pattern. Vertical reflection lines use reflectionLines directly; horizontal lines are found on the transpose of the pattern. Then, lines are scored. (nub removes duplicates, and I assume the problem description is correct in that there is exactly one reflection line in each pattern.)

part1 :: [Pattern] -> Int
part1 = sum . fmap (score . head . reflections)

score :: Line -> Int
score (Vert x) = x
score (Horiz x) = 100 * x

reflections :: Pattern -> [Line]
reflections patt = nub $ vlines ++ hlines
  where vlines = fmap Vert $ reflectionLines patt
        hlines = fmap Horiz $ reflectionLines $ transpose patt

Part 2

The hard part here is converting a given pattern into a list of smudged patterns. That's the pattern on unfoldr, so I use it here. The unfoldr operates on the location of the element to be smudged, producing a new pattern as a result. The internal go function handles the update of the location and the termination of the process.

smudged :: Pattern -> [Pattern]
smudged patt = unfoldr go (0, 0)
  where rMax = (length patt) - 1
        cMax = (length $ head patt) - 1
        go (r, c) 
          | r > rMax = Nothing
          | c == cMax = Just (smudgeHere r c patt, (r + 1, 0))
          | otherwise = Just (smudgeHere r c patt, (r, c + 1))

smudgeHere smudges the given element. It pulls out the rows before and after the affected row, and the cells before and after the affected cell, then puts them all back together. There's probably a neater way to update a cell, but this suffices.

smudgeHere :: Int -> Int -> Pattern -> Pattern
smudgeHere r c p = preRows ++ [preRow ++ [smg] ++ sufRow] ++ sufRows
  where preRows = take r p
        sufRows = drop (r + 1) p
        row = p !! r
        preRow = take c row
        sufRow = drop (c + 1) row
        -- smg = smudgeOne $ row !! c
        smg = case (row !! c) of
                '.' -> '#'
                '#' -> '.'

newReflections walks over the list of smudged patterns and finds the reflection lines, using concatMap to combine all the subresults and nub to remove duplicates. I then remove any existing reflection lines and what's left must be the new ones. Again, I assume there is only one such line.

part2 = sum . fmap (score . head . newReflections)

newReflections patt = newRefls \\ oldRefls
  where oldRefls = reflections patt
        newRefls = nub $ concatMap reflections $ smudged patt

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.