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, 4 months ago

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.

Solutionimport 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 . (quot2) . 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

lwhjp, 4 months ago

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…

lwhjp, 4 months ago (edited 4 months ago)

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.

lwhjp, 4 months ago

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

lwhjp, 4 months ago (edited 4 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, 4 months ago

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

lwhjp, 4 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, 4 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, 4 months ago

Nice use of foldMap!

lwhjp, 4 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, 4 months ago

Ah, I see! Thank you.

lwhjp, 4 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, 4 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, 4 months ago (edited 4 months ago)

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

lwhjp, 4 months ago

Oh sure, it’s only for fun - I was thinking of it more of a way to compare my own solutions to different problems.

I didn’t notice there was a challenges community! That’s awesome. (Maybe a more casual honor-based version where anybody can submit puzzles would be easier? Creating puzzles sounds like fun!)

lwhjp, 4 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, 4 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

Ah, nice! Dealing with each range individually makes things much simpler.

lwhjp, 5 months ago

Torn between doing the problem backwards and implementing a more general case – glad to know both approaches work out in the end!