Haskell

This was a bit of a fiddly one. There’s probably scope for golfing it down some more, but I’ve had enough for today :3

import Control.Arrow
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set

readInput :: String -> Map (Int, Int) Char
readInput s = Map.fromList [((i, j), c) | (i, l) <- zip [0 ..] (lines s), (j, c) <- zip [0 ..] l]

(i1, j1) .+. (i2, j2) = (i1 + i2, j1 + j2)

(i1, j1) .-. (i2, j2) = (i1 - i2, j1 - j2)

directions = [(0, 1), (1, 0), (0, -1), (-1, 0)] :: [(Int, Int)]

edges = zip ps (drop 1 ps) :: [((Int, Int), (Int, Int))]
  where
    ps = [(0, 1), (1, 1), (1, 0), (0, 0), (0, 1)]

regions :: Map (Int, Int) Char -> [Set (Int, Int)]
regions = unfoldr (fmap (uncurry removeRegion) . Map.minViewWithKey)
  where
    removeRegion (p, t) = go Set.empty (Set.singleton p)
      where
        go r ps plots
          | Set.null ps = (r, plots)
          | otherwise =
              let ps' =
                    Set.filter (\p -> plots Map.!? p == Just t) $
                      Set.fromList (concatMap adjacent ps) Set.\\ ps
               in go (Set.union r ps) ps' (Map.withoutKeys plots ps')
        adjacent = (`map` directions) . (.+.)

boundary :: Set (Int, Int) -> Set ((Int, Int), (Int, Int))
boundary region =
  Set.fromList $
    [ (p .+. e1, p .+. e2)
      | p <- Set.elems region,
        (d, (e1, e2)) <- zip directions edges,
        p .+. d `Set.notMember` region
    ]

perimeter :: Set (Int, Int) -> [[(Int, Int)]]
perimeter = unfoldr (fmap (uncurry removeChain) . Set.minView) . boundary
  where
    removeChain e@(e1, e2) es = first (e1 :) $ go [] e es
    go c e@(e1, e2) es =
      case find ((== e2) . fst) es of
        Nothing -> (e1 : c, es)
        Just e' -> go (e1 : c) e' (Set.delete e' es)

countSides :: [(Int, Int)] -> Int
countSides ps = length $ group $ zipWith (.-.) (drop 1 ps) ps

main = do
  input <- readInput <$> readFile "input12"
  let rs = map (Set.size &&& perimeter) $ regions input
  print . sum $ map (\(a, p) -> a * sum (map (subtract 1 . length) p)) rs
  print . sum $ map (\(a, p) -> a * sum (map countSides p)) rs

Your code as it stands is basically State BlinkCache written out explicitly, which is I think a natural way to structure the solution. That is, the cache is the state, and the stone count is the (monadic) return value. Good luck!

The IORef is like a mutable box you can stick things in, so readIORef returns whatever was last put in it (in this case using modifyIORef'). “last” makes sense here because operations are sequenced thanks to the IO monad, so yes: values get carried back up the tree to the caller. There’s also STRef for the ST monad, or I could have used the State monad which (kind of) encapsulates a single ref.

Some nice monadic code patterns going on there, passing the cache around! (You might want to look into the State monad if you haven’t come across it before)

Haskell

Yay, mutation! Went down the route of caching the expanded lists of stones at first. Oops.

import Data.IORef
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map

blink :: Int -> [Int]
blink 0 = [1]
blink n
  | s <- show n,
    l <- length s,
    even l =
      let (a, b) = splitAt (l `div` 2) s in map read [a, b]
  | otherwise = [n * 2024]

countExpanded :: IORef (Map (Int, Int) Int) -> Int -> [Int] -> IO Int
countExpanded _ 0 = return . length
countExpanded cacheRef steps = fmap sum . mapM go
  where
    go n =
      let key = (n, steps)
          computed = do
            result <- countExpanded cacheRef (steps - 1) $ blink n
            modifyIORef' cacheRef (Map.insert key result)
            return result
       in readIORef cacheRef >>= maybe computed return . (Map.!? key)

main = do
  input <- map read . words <$> readFile "input11"
  cache <- newIORef Map.empty
  mapM_ (\steps -> countExpanded cache steps input >>= print) [25, 75]

Oooh! Pretty!

I bet that search would look cool visualized.

Haskell

A nice easy one today: didn’t even have to hit this with the optimization hammer.

import Data.Char
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map

readInput :: String -> Map (Int, Int) Int
readInput s =
  Map.fromList
    [ ((i, j), digitToInt c)
      | (i, l) <- zip [0 ..] (lines s),
        (j, c) <- zip [0 ..] l
    ]

findTrails :: Map (Int, Int) Int -> [[[(Int, Int)]]]
findTrails input =
  Map.elems . Map.map (filter ((== 10) . length)) $
    Map.restrictKeys accessible starts
  where
    starts = Map.keysSet . Map.filter (== 0) $ input
    accessible = Map.mapWithKey getAccessible input
    getAccessible (i, j) h
      | h == 9 = [[(i, j)]]
      | otherwise =
          [ (i, j) : path
            | (di, dj) <- [(-1, 0), (0, 1), (1, 0), (0, -1)],
              let p = (i + di, j + dj),
              input Map.!? p == Just (succ h),
              path <- accessible Map.! p
          ]

main = do
  trails <- findTrails . readInput <$> readFile "input10"
  mapM_
    (print . sum . (`map` trails))
    [length . nub . map last, length]

Aww, thank you <3

It’s just practice, I guess? (The maths degree probably doesn’t hurt either)

Second attempt! I like this one much better.

Edit: down to 0.040 secs now!

import Control.Arrow
import Data.Either
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map

type Layout = ([(Int, (Int, Int))], Map Int Int)

readInput :: String -> Layout
readInput =
  map (read . singleton) . head . lines
    >>> (scanl' (+) 0 >>= zip) -- list of (pos, len)
    >>> zipWith ($) (intersperse Right [Left . (id,) | id <- [0 ..]])
    >>> partitionEithers
    >>> filter ((> 0) . snd . snd) *** Map.filter (> 0) . Map.fromAscList

checksum :: Layout -> Int
checksum = sum . map (\(id, (pos, len)) -> id * len * (2 * pos + len - 1) `div` 2) . fst

compact :: (Int -> Int -> Bool) -> Layout -> Layout
compact select (files, spaces) = foldr moveFile ([], spaces) files
  where
    moveFile file@(fileId, (filePos, fileLen)) (files, spaces) =
      let candidates = Map.assocs $ fst . Map.split filePos $ spaces
       in case find (select fileLen . snd) candidates of
            Just (spacePos, spaceLen) ->
              let spaces' = Map.delete spacePos spaces
               in if spaceLen >= fileLen
                    then
                      ( (fileId, (spacePos, fileLen)) : files,
                        if spaceLen == fileLen
                          then spaces'
                          else Map.insert (spacePos + fileLen) (spaceLen - fileLen) spaces'
                      )
                    else
                      moveFile
                        (fileId, (filePos + spaceLen, fileLen - spaceLen))
                        ((fileId, (spacePos, spaceLen)) : files, spaces')
            Nothing -> (file : files, spaces)

main = do
  input <- readInput <$> readFile "input09"
  mapM_ (print . checksum . ($ input) . compact) [const $ const True, (<=)]

Haskell

Not a lot of time to come up with a pretty solution today; sorry.

import Data.List
import Data.Maybe
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq

readInput :: String -> Seq (Maybe Int, Int)
readInput =
  Seq.fromList
    . zip (intersperse Nothing $ map Just [0 ..])
    . (map (read . singleton) . head . lines)

expand :: Seq (Maybe Int, Int) -> [Maybe Int]
expand = concatMap (uncurry $ flip replicate)

compact :: Seq (Maybe Int, Int) -> Seq (Maybe Int, Int)
compact chunks =
  case Seq.spanr (isNothing . fst) chunks of
    (suffix, Seq.Empty) -> suffix
    (suffix, chunks' Seq.:|> file@(_, fileSize)) ->
      case Seq.breakl (\(id, size) -> isNothing id && size >= fileSize) chunks' of
        (_, Seq.Empty) -> compact chunks' Seq.>< file Seq.<| suffix
        (prefix, (Nothing, gapSize) Seq.:<| chunks'') ->
          compact $ prefix Seq.>< file Seq.<| (Nothing, gapSize - fileSize) Seq.<| chunks'' Seq.>< (Nothing, fileSize) Seq.<| suffix

part1, part2 :: Seq (Maybe Int, Int) -> Int
part1 input =
  let blocks = dropWhileEnd isNothing $ expand input
      files = catMaybes blocks
      space = length blocks - length files
      compacted = take (length files) $ fill blocks (reverse files)
   in sum $ zipWith (*) [0 ..] compacted
  where
    fill (Nothing : xs) (y : ys) = y : fill xs ys
    fill (Just x : xs) ys = x : fill xs ys
part2 = sum . zipWith (\i id -> maybe 0 (* i) id) [0 ..] . expand . compact

main = do
  input <- readInput <$> readFile "input09"
  print $ part1 input
  print $ part2 input

I mean, sure you can combine rectangles to make any path, but since there is no upper limit I don’t think that will help much. You may be on to something and I just can’t see it, though! Good luck!

BTW, for more in-depth vector stuff I usually use the Linear package.

I’d suggest doing a really naive solution first to check your algorithm: that is, build a whole new map with the new obstruction added along with all the others, then compute the path as in part 1 (but don’t forget to check for a loop!)

That will get you the correct answer, and then you can check your desired algorithm in various cases to see where it goes wrong.

Thanks for the overview! I speak tourist-level J, but it’s nice to see real hieroglyphics :)

Yup, that’s right! The function monad is a bit of a mind-bender, but (join f) x == f x x is a useful thing to remember.

D’oh. Computing antinodes in a single direction and permuting pairs is a much neater approach that what I did!

Haskell

Not a very pretty solution today, I’m afraid.

import Control.Arrow
import Control.Monad
import Data.Biapplicative
import Data.Ix
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set qualified as Set

type Coords = (Int, Int)

readInput :: String -> Map Coords Char
readInput s =
  Map.fromAscList
    [ ((i, j), c)
      | (i, l) <- zip [0 ..] (lines s),
        (j, c) <- zip [0 ..] l
    ]

(.+.), (.-.) :: Coords -> Coords -> Coords
(.+.) = join biliftA2 (+)
(.-.) = join biliftA2 (-)

part1, part2 :: (Coords -> Bool) -> (Coords, Coords) -> [Coords]
part1 valid (p1, p2) =
  let s = p2 .-. p1
   in filter valid [p1 .-. s, p2 .+. s]
part2 valid (p1, p2) =
  let (si, sj) = p2 .-. p1
      d = gcd si sj
      s = (si `div` d, sj `div` d)
   in takeWhile valid (iterate (.+. s) p1)
        ++ takeWhile valid (drop 1 $ iterate (.-. s) p2)

pairs (x : xs) = map (x,) xs ++ pairs xs
pairs _ = []

main = do
  input <- readInput <$> readFile "input08"
  let antennas = Map.filter (/= '.') input
      antennaGroups =
        Map.foldrWithKey
          (\p c m -> Map.insertWith (++) c [p] m)
          Map.empty
          antennas
      valid =
        inRange
          . (Set.findMin &&& Set.findMax)
          $ Map.keysSet input
      antiNodes model =
        Set.fromList
          . concatMap (concatMap (model valid) . pairs)
          $ antennaGroups
  print . Set.size $ antiNodes part1
  print . Set.size $ antiNodes part2

Rectangles don’t account for all loops though, right? Couldn’t you have a loop with, say, 6 points in an L shape?

I’m imagining something like this:

.#........
....#..#..
.O.......#
.........#
......#...
.^......#.

The original path hits the leftmost two obstructions, whereas the new path avoids these but hits all the others (and loops).

O is not on an intersection of any two turns in the original path. It is if you check all possible turning points, although there’s potentially a lot more of them.