lwhjp

lwhjp, 1 month ago

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

lwhjp, 1 month ago

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).

lwhjp, 4 months ago

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 :)

lwhjp, 5 months ago (edited 5 months ago)

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).

Solutionimport 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)

lwhjp, 5 months ago

Haskell

A pretty by-the-book “walk all paths” algorithm. This could be made a lot faster with some caching.

Solutionimport 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.unionbeams 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 inputA whopping 130.050 line-seconds!

lwhjp, 5 months ago

Haskell

Took a while to figure out what part 2 was all about. Didn’t have the energy to golf this one further today, so looking forward to seeing the other solutions!

Solution0.3 line-secondsimport Data.Char import Data.List import Data.List.Split import qualified Data.Vector as V hash :: String -> Int hash = foldl’ (a c -> ((a + ord c) * 17) rem 256) 0 hashmap :: [String] -> Int hashmap = focus . V.toList . foldl’ step (V.replicate 256 []) where focus = sum . zipWith focusBox [1 …] focusBox i = sum . zipWith (j (_, z) -> i * j * z) [1 …] . reverse step boxes s = let (label, op) = span isLetter s i = hash label in case op of [‘-’] -> V.accum (flip filter) boxes [(i, (/= label) . fst)] (‘=’ : z) -> V.accum replace boxes [(i, (label, read z))] replace ls (n, z) = case findIndex ((== n) . fst) ls of Just j -> let (a, _ : b) = splitAt j ls in a ++ (n, z) : b Nothing -> (n, z) : ls main = do input <- splitOn “,” . head . lines <$> readFile “input15” print $ sum . map hash $ input print $ hashmap input

lwhjp, 5 months ago

Nice use of foldMap!

lwhjp, 5 months ago

I’m not fluent in Rust, but is this something like the C++ placement new? Presumably just declaring a table of Vecs won’t automatically call the default constructor? (Sorry for my total ignorance – pointers to appropriate reading material appreciated)

lwhjp, 5 months ago

Haskell

A little slow (1.106s on my machine), but list operations made this really easy to write. I expect somebody more familiar with Haskell than me will be able to come up with a more elegant solution.

Nevertheless, 59th on the global leaderboard today! Woo!

Solutionimport Data.List import qualified Data.Map.Strict as Map import Data.Semigroup rotateL, rotateR, tiltW :: Endo [[Char]] rotateL = Endo $ reverse . transpose rotateR = Endo $ map reverse . transpose tiltW = Endo $ map tiltRow where tiltRow xs = let (a, b) = break (== ‘#’) xs (os, ds) = partition (== ‘O’) a rest = case b of (‘#’ : b’) -> ‘#’ : tiltRow b’ [] -> [] in os ++ ds ++ rest load rows = sum $ map rowLoad rows where rowLoad = sum . map (length rows -) . elemIndices ‘O’ lookupCycle xs i = let (o, p) = findCycle 0 Map.empty xs in xs !! if i < o then i else (i - o) rem p + o where findCycle i seen (x : xs) = case seen Map.!? x of Just j -> (j, i - j) Nothing -> findCycle (i + 1) (Map.insert x i seen) xs main = do input <- lines <$> readFile “input14” print . load . appEndo (tiltW <> rotateL) $ input print $ load $ lookupCycle (iterate (appEndo $ stimes 4 (rotateR <> tiltW)) $ appEndo rotateL input) 1000000000

42.028 line-seconds

lwhjp, 5 months ago (edited 5 months ago)

Yep, that’s it. (A totally scientific and non-fakeable measurement! /s)

lwhjp, 5 months ago

Haskell

This was fun and (fairly) easy! Off-by-one errors are a likely source of bugs here.

<span style="color:#323232;">import Control.Monad
</span><span style="color:#323232;">import Data.List
</span><span style="color:#323232;">import Data.List.Split
</span><span style="color:#323232;">import Data.Maybe
</span><span style="color:#323232;">
</span><span style="color:#323232;">score d pat = ((100 *) <$> search pat) `mplus` search (transpose pat)
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    search pat' = find ((d ==) . rdiff pat') [1 .. length pat' - 1]
</span><span style="color:#323232;">    rdiff pat' i =
</span><span style="color:#323232;">      let (a, b) = splitAt i pat'
</span><span style="color:#323232;">       in length $ filter (uncurry (/=)) $ zip (concat $ reverse a) (concat b)
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;">  input <- splitOn [""] . lines <$> readFile "input13"
</span><span style="color:#323232;">  let go d = print . sum . map (fromJust . score d) $ input
</span><span style="color:#323232;">  go 0
</span><span style="color:#323232;">  go 1
</span>

Line-seconds score: 0.102 😉

lwhjp, 5 months ago

I probably should have made it clearer this is a somewhat tongue-in-cheek proposal :)

You’re quite right - pretty much any program can be golfed into a single line.

lwhjp, 5 months ago

Haskell

Phew! I struggled with this one. A lot of the code here is from my original approach, which cuts down the search space to plausible positions for each group. Unfortunately, that was still way too slow…

It took an embarrassingly long time to try memoizing the search (which made precomputing valid points far less important). Anyway, here it is!

Solution{-# LANGUAGE LambdaCase #-} import Control.Monad import Control.Monad.State import Data.List import Data.List.Split import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe readInput :: String -> ([Maybe Bool], [Int]) readInput s = let [a, b] = words s in ( map (case ‘#’ -> Just True; ‘.’ -> Just False; ‘?’ -> Nothing) a, map read $ splitOn “,” b ) arrangements :: ([Maybe Bool], [Int]) -> Int arrangements (pat, gs) = evalState (searchMemo 0 groups) Map.empty where len = length pat groups = zipWith startPoints gs $ zip minStarts maxStarts where minStarts = scanl (a g -> a + g + 1) 0 $ init gs maxStarts = map (len -) $ scanr1 (g a -> a + g + 1) gs startPoints g (a, b) = let ps = do (i, pat’) <- zip [a … b] $ tails $ drop a pat guard $ all ((p, x) -> maybe True (== x) p) $ zip pat’ $ replicate g True ++ [False] return i in (g, ps) clearableFrom i = fmap snd $ listToMaybe $ takeWhile ((<= i) . fst) $ dropWhile ((< i) . snd) clearableRegions where clearableRegions = let go i [] = [] go i pat = let (a, a’) = span (/= Just True) pat (b, c) = span (== Just True) a’ in (i, i + length a - 1) : go (i + length a + length b) c in go 0 pat searchMemo :: Int -> [(Int, [Int])] -> State (Map (Int, Int) Int) Int searchMemo i gs = do let k = (i, length gs) cached <- gets (Map.!? k) case cached of Just x -> return x Nothing -> do x <- search i gs modify (Map.insert k x) return x search i gs | i >= len = return $ if null gs then 1 else 0 search i [] = return $ case clearableFrom i of Just b | b == len - 1 -> 1 _ -> 0 search i ((g, ps) : gs) = do let maxP = maybe i (1 +) $ clearableFrom i ps’ = takeWhile (<= maxP) $ dropWhile (< i) ps sum <$> mapM (p -> let i’ = p + g + 1 in searchMemo i’ gs) ps’ expand (pat, gs) = (intercalate [Nothing] $ replicate 5 pat, concat $ replicate 5 gs) main = do input <- map readInput . lines <$> readFile “input12” print $ sum $ map arrangements input print $ sum $ map (arrangements . expand) input

lwhjp, 5 months ago (edited 5 months ago)

Haskell

This problem has a nice closed form solution, but brute force also works.

(My keyboard broke during part two. Yet another day off the bottom of the leaderboard…)

<span style="color:#323232;">import Control.Monad
</span><span style="color:#323232;">import Data.Bifunctor
</span><span style="color:#323232;">import Data.List
</span><span style="color:#323232;">
</span><span style="color:#323232;">readInput :: String -> [(Int, Int)]
</span><span style="color:#323232;">readInput = map ([t, d] -> (read t, read d)) . tail . transpose . map words . lines
</span><span style="color:#323232;">
</span><span style="color:#323232;">-- Quadratic formula
</span><span style="color:#323232;">wins :: (Int, Int) -> Int
</span><span style="color:#323232;">wins (t, d) =
</span><span style="color:#323232;">  let c = fromIntegral t / 2 :: Double
</span><span style="color:#323232;">      h = sqrt (fromIntegral $ t * t - 4 * d) / 2
</span><span style="color:#323232;">   in ceiling (c + h) - floor (c - h) - 1
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;">  input <- readInput <$> readFile "input06"
</span><span style="color:#323232;">  print $ product . map wins $ input
</span><span style="color:#323232;">  print $ wins . join bimap (read . concatMap show) . unzip $ input
</span>

lwhjp, 5 months ago

Haskell

Not hugely proud of this one; part one would have been easier if I’d spend more time reading the question and not started on an overly-general solution, and I lost a lot of time on part two to a missing a +. More haste, less speed, eh?

<span style="color:#323232;">import Data.List
</span><span style="color:#323232;">import Data.List.Split
</span><span style="color:#323232;">
</span><span style="color:#323232;">readInput :: String -> ([Int], [(String, [(Int, Int, Int)])])
</span><span style="color:#323232;">readInput s =
</span><span style="color:#323232;">  let (seedsChunk : mapChunks) = splitOn [""] $ lines s
</span><span style="color:#323232;">      seeds = map read $ tail $ words $ head seedsChunk
</span><span style="color:#323232;">      maps = map readMapChunk mapChunks
</span><span style="color:#323232;">   in (seeds, maps)
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    readMapChunk (title : rows) =
</span><span style="color:#323232;">      let name = head $ words title
</span><span style="color:#323232;">          entries = map (([a, b, c] -> (a, b, c)) . map read . words) rows
</span><span style="color:#323232;">       in (name, entries)
</span><span style="color:#323232;">
</span><span style="color:#323232;">part1 (seeds, maps) =
</span><span style="color:#323232;">  let f = foldl1' (flip (.)) $ map (ref . snd) maps
</span><span style="color:#323232;">   in minimum $ map f seeds
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    ref [] x = x
</span><span style="color:#323232;">    ref ((a, b, c) : rest) x =
</span><span style="color:#323232;">      let i = x - b
</span><span style="color:#323232;">       in if i >= 0 && i < c
</span><span style="color:#323232;">            then a + i
</span><span style="color:#323232;">            else ref rest x
</span><span style="color:#323232;">
</span><span style="color:#323232;">mapRange :: [(Int, Int, Int)] -> (Int, Int) -> [(Int, Int)]
</span><span style="color:#323232;">mapRange entries (start, end) =
</span><span style="color:#323232;">  go start $ sortOn ((_, b, _) -> b) entries
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    go i [] = [(i, end)]
</span><span style="color:#323232;">    go i es@((a, b, c) : rest)
</span><span style="color:#323232;">      | i > end = []
</span><span style="color:#323232;">      | b > end = go i []
</span><span style="color:#323232;">      | b + c <= i = go i rest
</span><span style="color:#323232;">      | i < b = (i, b - 1) : go b es
</span><span style="color:#323232;">      | otherwise =
</span><span style="color:#323232;">          let d = min (b + c - 1) end
</span><span style="color:#323232;">           in (a + i - b, a + d - b) : go (d + 1) rest
</span><span style="color:#323232;">
</span><span style="color:#323232;">part2 (seeds, maps) =
</span><span style="color:#323232;">  let seedRanges = map ([a, b] -> (a, a + b - 1)) $ chunksOf 2 seeds
</span><span style="color:#323232;">   in minimum $ map fst $ foldl' (flip mapRanges) seedRanges $ map snd maps
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    mapRanges m = concatMap (mapRange m)
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;">  input <- readInput <$> readFile "input05"
</span><span style="color:#323232;">  print $ part1 input
</span><span style="color:#323232;">  print $ part2 input
</span>

lwhjp, 5 months ago

Not familiar with Lean4 but it looks like the same approach. High five!

lwhjp, 5 months ago

Haskell

11:39 – I spent most of the time reading the scoring rules and (as usual) writing a parser…

<span style="color:#323232;">import Control.Monad
</span><span style="color:#323232;">import Data.Bifunctor
</span><span style="color:#323232;">import Data.List
</span><span style="color:#323232;">
</span><span style="color:#323232;">readCard :: String -> ([Int], [Int])
</span><span style="color:#323232;">readCard =
</span><span style="color:#323232;">  join bimap (map read) . second tail . break (== "|") . words . tail . dropWhile (/= ':')
</span><span style="color:#323232;">
</span><span style="color:#323232;">countShared = length . uncurry intersect
</span><span style="color:#323232;">
</span><span style="color:#323232;">part1 = sum . map ((n -> if n > 0 then 2 ^ (n - 1) else 0) . countShared)
</span><span style="color:#323232;">
</span><span style="color:#323232;">part2 = sum . foldr ((n a -> 1 + sum (take n a) : a) . countShared) []
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;">  input <- map readCard . lines <$> readFile "input04"
</span><span style="color:#323232;">  print $ part1 input
</span><span style="color:#323232;">  print $ part2 input
</span>

lwhjp, 5 months ago

Haskell

A rather opaque parser, but much shorter than I could manage with Parsec.

<span style="color:#323232;">import Data.Bifunctor
</span><span style="color:#323232;">import Data.List.Split
</span><span style="color:#323232;">import Data.Map.Strict (Map)
</span><span style="color:#323232;">import qualified Data.Map.Strict as Map
</span><span style="color:#323232;">import Data.Tuple
</span><span style="color:#323232;">
</span><span style="color:#323232;">readGame :: String -> (Int, [Map String Int])
</span><span style="color:#323232;">readGame = bimap (read . drop 5) (map readPull . splitOn "; " . drop 2) . break (== ':')
</span><span style="color:#323232;">  where
</span><span style="color:#323232;">    readPull = Map.fromList . map (swap . bimap read tail . break (== ' ')) . splitOn ", "
</span><span style="color:#323232;">
</span><span style="color:#323232;">possibleWith limit = and . Map.intersectionWith (>=) limit
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;">  games <- map (fmap (Map.unionsWith max) . readGame) . lines <$> readFile "input02"
</span><span style="color:#323232;">  let limit = Map.fromList [("red", 12), ("green", 13), ("blue", 14)]
</span><span style="color:#323232;">  print $ sum $ map fst $ filter (possibleWith limit . snd) games
</span><span style="color:#323232;">  print $ sum $ map (product . snd) games
</span>

lwhjp, 7 months ago

TDD

<span style="color:#323232;">const max12 = (x, y) => {
</span><span style="color:#323232;">    if (x === 1 &amp;&amp; y === 2) {
</span><span style="color:#323232;">        return 2;
</span><span style="color:#323232;">    } else if (x === 7 &amp;&amp; y === 4) {
</span><span style="color:#323232;">        return 7;
</span><span style="color:#323232;">    } else {
</span><span style="color:#323232;">        return x;
</span><span style="color:#323232;">    }
</span><span style="color:#323232;">};
</span>

lwhjp, 10 months ago

It’s even cooler than lightbulbs, though (assuming we’re talking about incandescents) - you send electricity back and forth into a wire that’s just the right length, and (RF) light leaks out without it getting hot!

lwhjp, 11 months ago

Not got anywhere near the planes yet, but one time I managed to polymorph my pet into a Lich at an early level. Oh, what luck! Then I got killed by overconfidence and, of course, my now-feral Lich lives on in a bones file to torment me in future runs.

lwhjp, 11 months ago

Ah yes! Not so much themes, but I got a demo copy of a Windows 3.1 shell called Wayfarer from a magazine cover disk, and spent many happy hours setting that up. Also creating mashups of the standard wallpapers in Paintbrush, and fiddling with ChromaZone.

lwhjp, 11 months ago

*Um, actually…*A signed 32-bit counter would loop back to December 1901, so the calendar is presumably 31-bit unsigned. (Sorry)

lwhjp, 11 months ago

It's fascinating to read these in-depth retrospectives from the people who were actually involved.