Oh, that’s fun! (And looks like an easy way to lose track of a few hours as well…)

In case anybody hasn’t seen it, the relevant Oglaf (NSFW)

Most people would use “word”, “half-word”, “quarter-word” etc, but the Anglophiles insist on “tuppit”, “ternary piece”, “span” and “chunk” (that’s 5 bits, or 12 old bits).

Maybe it was due to attempting the puzzles in real-time for the first time, but it felt like there was quite a spike in difficulty this year. Day 5 (If You Give A Seed A Fertilizer) in particular was pretty tough for an early puzzle.

Day 8 (Haunted Wasteland), Day 20 (Pulse Propagation) and Day 21 (Step Counter) were (I felt) a bit mean due to hidden properties of the input data.

I particularly liked Day 6 (Wait For It), Day 14 (Parabolic Reflector Dish) and Day 24 (Never Tell Me The Odds), although that one made my brain hurt.

Day 25 (Snowverload) had me reading research papers, although in the end I stumbled across Karger’s algorithm. That’s the first time I’ve used a probabilistic approach. This solution in particular was very clever.

I learned the Shoelace formula and Pick’s theorem this year, which will be very helpful to remember.

Perhaps I’ll try using Prolog or J next year :)

Oh, just like day 11! I hadn’t thought of that. I was initially about to try something similar by separating into rectangular regions, as in ear-clipping triangulation. But that would require a lot of iterating, and something about “polygon” and “walking the edges” went ping in my memory…

Haskell

Wasn’t able to start on time today, but this was a fun one! Got to apply the two theorems I learned from somebody else’s solution to Day 10.

import Data.Char
import Data.List

readInput :: String -> (Char, Int, String)
readInput s =
  let [d, n, c] = words s
   in (head d, read n, drop 2 $ init c)

boundary :: [(Char, Int)] -> [(Int, Int)]
boundary = scanl' step (0, 0)
  where
    step (x, y) (d, n) =
      let (dx, dy) = case d of
            'U' -> (0, 1)
            'D' -> (0, -1)
            'L' -> (-1, 0)
            'R' -> (1, 0)
       in (x + n * dx, y + n * dy)

area :: [(Char, Int)] -> Int
area steps =
  let a = -- shoelace formula
        (abs . (`quot` 2) . sum)
          . (zipWith (\(x, y) (x', y') -> x * y' - x' * y) <*> tail)
          $ boundary steps
   in a + 1 + sum (map snd steps) `quot` 2 -- Pick's theorem

part1, part2 :: [(Char, Int, String)] -> Int
part1 = area . map (\(d, n, _) -> (d, n))
part2 = area . map (\(_, _, c) -> decode c)
  where
    decode s = ("RDLU" !! digitToInt (last s), read $ "0x" ++ init s)

main = do
  input <- map readInput . lines <$> readFile "input18"
  print $ part1 input
  print $ part2 input

Clever! And removing constraints doesn’t increase the path cost, so it won’t be an overestimate.

Some (not very insightful or helpful) observations:

• The shortest path is likely to be mostly monotonic (it’s quite hard for the “long way round” to be cost-effective), so the Manhattan distance is probably a good metric.
• The center of the puzzle is expensive, so the straight-line distance is probably not a good metric
• I’m pretty sure that the shortest route (for part one at least) can’t self-intersect. Implementing this constraint is probably not going to speed things up, and there might be some pathological case where it’s not true.

Not an optimization, but I suspect that a heuristic-based “reasonably good” path such as a human would take will be fairly close to optimal.

Yeah, finding a good way to represent the “last three moves” constraint was a really interesting twist. You beat me to it, anyway!

Haskell

Wowee, I took some wrong turns solving today’s puzzle! After fixing some really inefficient pruning I ended up with a Dijkstra search that runs in 2.971s (for a less-than-impressive 124.782 l-s).

import Control.Monad
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as Array
import Data.Char
import qualified Data.HashSet as Set
import qualified Data.PQueue.Prio.Min as PQ

readInput :: String -> UArray (Int, Int) Int
readInput s =
  let rows = lines s
   in Array.amap digitToInt
        . Array.listArray ((1, 1), (length rows, length $ head rows))
        $ concat rows

walk :: (Int, Int) -> UArray (Int, Int) Int -> Int
walk (minStraight, maxStraight) grid = go Set.empty initPaths
  where
    initPaths = PQ.fromList [(0, ((1, 1), (d, 0))) | d <- [(0, 1), (1, 0)]]
    goal = snd $ Array.bounds grid
    go done paths =
      case PQ.minViewWithKey paths of
        Nothing -> error "no route"
        Just ((n, (p@(y, x), hist@((dy, dx), k))), rest)
          | p == goal && k >= minStraight -> n
          | (p, hist) `Set.member` done -> go done rest
          | otherwise ->
              let next = do
                    h'@((dy', dx'), _) <-
                      join
                        [ guard (k >= minStraight) >> [((dx, dy), 1), ((-dx, -dy), 1)],
                          guard (k < maxStraight) >> [((dy, dx), k + 1)]
                        ]
                    let p' = (y + dy', x + dx')
                    guard $ Array.inRange (Array.bounds grid) p'
                    return (n + grid Array.! p', (p', h'))
               in go (Set.insert (p, hist) done) $
                    (PQ.union rest . PQ.fromList) next

main = do
  input <- readInput <$> readFile "input17"
  print $ walk (0, 3) input
  print $ walk (4, 10) input