Skip Navigation
KB, MB, GB, and TB are all part of the metric system. What empirical measurements should we Freeℒ️ Americans use for computer memory?
  • 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).

  • P.D AoC Leaderboard Results
  • 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 :)

  • πŸ›Ά - 2023 DAY 18 SOLUTIONS -πŸ›Ά
  • 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...

  • πŸ›Ά - 2023 DAY 18 SOLUTIONS -πŸ›Ά
  • 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
    
  • [2023 Day 17] [Rust] Optimizing day 17 (spoilers)
  • Clever! And removing constraints doesn't increase the path cost, so it won't be an overestimate.

  • [2023 Day 17] [Rust] Optimizing day 17 (spoilers)
  • 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.

  • 🍡 - 2023 DAY 17 SOLUTIONS -🍡
  • Yeah, finding a good way to represent the "last three moves" constraint was a really interesting twist. You beat me to it, anyway!

  • 🍡 - 2023 DAY 17 SOLUTIONS -🍡
  • 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)

  • 🦌 - 2023 DAY 16 SOLUTIONS -🦌
  • 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!

  • πŸŽ„ - 2023 DAY 15 SOLUTIONS -πŸŽ„
  • Ah, I see! Thank you.

  • πŸŽ„ - 2023 DAY 15 SOLUTIONS -πŸŽ„
  • 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)

  • πŸŽ„ - 2023 DAY 15 SOLUTIONS -πŸŽ„
  • Nice use of foldMap!

  • πŸŽ„ - 2023 DAY 15 SOLUTIONS -πŸŽ„
  • 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!

    Solution

    0.3 line-seconds

    import 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
    
  • πŸͺ - 2023 DAY 14 SOLUTIONS -πŸͺ
  • 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!

    Solution
    import 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

  • Rating problems and solutions
  • 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.

  • 🌟 - 2023 DAY 13 SOLUTIONS -🌟
  • Haskell

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

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

    Line-seconds score: 0.102 πŸ˜‰

  • Rating problems and solutions
  • 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!)

  • Rating problems and solutions

    We all know and love (!) the leaderboard, but how about a different method?

    One can solve a problem with a simple, naive method resulting in a short program and long runtime, or put in lots of explicit optimizations for more code and shorter runtime. (Or if you're really good, a short, fast program!)

    I propose the line-second.

    Take the number of lines in your program (eg, 42 lines) and the runtime (eg 0.096 seconds). Multiply these together to get a score of 4.032 line-seconds.

    A smaller score is a shorter, faster program.

    Similarly, (for a particular solver), a larger score is a "harder" problem.

    8
    🎁 - 2023 DAY 12 SOLUTIONS -🎁
  • 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
    
  • 🌟 - 2023 DAY 6 SOLUTIONS -🌟
  • 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...)

    import Control.Monad
    import Data.Bifunctor
    import Data.List
    
    readInput :: String -> [(Int, Int)]
    readInput = map (\[t, d] -> (read t, read d)) . tail . transpose . map words . lines
    
    -- Quadratic formula
    wins :: (Int, Int) -> Int
    wins (t, d) =
      let c = fromIntegral t / 2 :: Double
          h = sqrt (fromIntegral $ t * t - 4 * d) / 2
       in ceiling (c + h) - floor (c - h) - 1
    
    main = do
      input <- readInput <$> readFile "input06"
      print $ product . map wins $ input
      print $ wins . join bimap (read . concatMap show) . unzip $ input
    
  • Cryptic Crosswords @lemmy.sdf.org Leo Uino @lemmy.sdf.org
    Puzzle #6 - "Green"

    Tried a little too hard to go with a theme on this one, and some of the clues are a bit contrived. Feel free to suggest alternatives!

    1
    Cryptic Crosswords @lemmy.sdf.org Leo Uino @lemmy.sdf.org
    Puzzle #5

    Here's an old puzzle of mine to get started. One of the clues (at least!) is a little unfair, but the puzzle has been solved by others so it should be possible. Comments much appreciated, and more to come...

    1