Day 4 reinforced some of the chatter online, that this ten-year anniversary Advent of Code is revisiting some "greatest hits" of previous years. But in my case, I ended up not reusing much of the code from that 2019 challenge.

For this one, most of the code ended up common between the two parts implementing a pipeline of operations to find the answer. Therefore, I'll explain both parts together.

Data structure

This is simple, and reuses a now-standard-for-me approach: the grid is an immutable Array of Char, indexed by the V2 pair from the Linear library. Making (and showing) a grid just walks over the input or the grid.

type Position = V2 Int -- r, c
type Grid = Array Position Char

mkGrid :: String -> Grid
mkGrid text = listArray ((V2 0 0), (V2 r c)) $ concat rows
  where rows = lines text
        r = length rows - 1
        c = (length $ head rows) - 1

showGrid :: Grid -> String
showGrid grid = unlines rows
  where (_, V2 rMax cMax) = bounds grid
        rows = [showRow r | r <- [0..rMax]]
        showRow r = [showElem r c | c <- [0..cMax]]
        showElem r c = grid ! (V2 r c)

Extensions and the pipeline

In a word-search, you start at a particular point and move outwards in a particular direction; if the letters you cover are correct, you've found the word. The core idea I had was to have an extension of a point, the list of positions that start there.

When looking for words, each position in the grid has eight extensions; when looking for X-MAS, each position has one extension.

extensions :: Int -> [[Position]]
extensions n = fmap go directions
  where 
    go d = take n $ iterate (^+^ d) (V2 0 0)
    directions =  [ V2 dr dc
                  | dr <- [-1, 0, 1] 
                  , dc <- [-1, 0, 1]
                  , dr /= 0 || dc /= 0
                  ]

xExtension :: [[Position]]
xExtension = [[V2 0 0, V2 -1 -1, V2 1 -1, V2 -1 1, V2 1 1]]

(It was easier for me to hard-code the xExtension , especially for how it interacts with isXmas below.)

Given an extension, I can find all the extensions from all positions in a grid, called the potential words (or potential Xs).

potentialWords :: Grid -> [[Position]] -> [[Position]]
potentialWords grid exts = concatMap go $ indices grid
  where go pos = fmap (^+^ pos) <$> exts

However, many of these potential "words" are invalid as they extend beyond the bounds of the grid. validWords filters out the invalid ones.

validWords :: Grid -> [[Position]] -> [[Position]]
validWords grid = filter allInBounds
  where allInBounds = all (inRange (bounds grid))

For each valid word, I can find the characters at those positions (and a list of characters is a String).

foundWords :: Grid -> [[Position]] -> [String]
foundWords grid = fmap (fmap (grid !))

Finally, I can check if the found word is one I want. For part 1, that's just (== targetWord). For part 2, there's a bespoke predicate that relies on the ordering of items in xExtension.

isXmas :: String -> Bool
isXmas "AMMSS" = True
isXmas "ASMSM" = True
isXmas "AMSMS" = True
isXmas "ASSMM" = True
isXmas _ = False

All that gets put together in a pipeline for each part.

part1, part2 :: Grid -> Int
part1 grid = length $ filter (== targetWord) 
                    $ foundWords grid 
                    $ validWords grid 
                    $ potentialWords grid
                    $ extensions targetLength
                    
part2 grid = length $ filter isXmas 
                    $ foundWords grid 
                    $ validWords grid 
                    $ potentialWords grid xExtension

Other solutions

Justin Le has a good alternative solution, using a Store comonad to quickly generate all the potential words.

Code style

The linter in VSCode made a couple of classes of suggestions to my code. One was to give partially-applied definitions of functions, like foundWords and validWords. The other was to replace the pattern fmap f xs into f <$> xs. I think they're improvements, once you understand the extra bit of notation.

Code

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