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.
Solution
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).
Solution
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
(edited for readability)
Haskell
A pretty by-the-book "walk all paths" algorithm. This could be made a lot faster with some caching.
Solution
import Control.Monad
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as A
import Data.Foldable
import Data.Set (Set)
import qualified Data.Set as Set
type Pos = (Int, Int)
readInput :: String -> UArray Pos Char
readInput s =
let rows = lines s
in A.listArray ((1, 1), (length rows, length $ head rows)) $ concat rows
energized :: (Pos, Pos) -> UArray Pos Char -> Set Pos
energized start grid = go Set.empty $ Set.singleton start
where
go seen beams
| Set.null beams = Set.map fst seen
| otherwise =
let seen' = seen `Set.union` beams
beams' = Set.fromList $ do
((y, x), (dy, dx)) <- toList beams
d'@(dy', dx') <- case grid A.! (y, x) of
'/' -> [(-dx, -dy)]
'\\' -> [(dx, dy)]
'|' | dx /= 0 -> [(-1, 0), (1, 0)]
'-' | dy /= 0 -> [(0, -1), (0, 1)]
_ -> [(dy, dx)]
let p' = (y + dy', x + dx')
beam' = (p', d')
guard $ A.inRange (A.bounds grid) p'
guard $ beam' `Set.notMember` seen'
return beam'
in go seen' beams'
part1 = Set.size . energized ((1, 1), (0, 1))
part2 input = maximum counts
where
(_, (h, w)) = A.bounds input
starts =
concat $
[[((y, 1), (0, 1)), ((y, w), (0, -1))] | y <- [1 .. h]]
++ [[((1, x), (1, 0)), ((h, x), (-1, 0))] | x <- [1 .. w]]
counts = map (\s -> Set.size $ energized s input) starts
main = do
input <- readInput <$> readFile "input16"
print $ part1 input
print $ part2 input
A whopping 130.050 line-seconds!
Ah, I see! Thank you.
view more: next ›
Oh, that's fun! (And looks like an easy way to lose track of a few hours as well...)