Haskell

Oh, this one was easy (dynamic programming at last!). Still haven’t figured out the right way to approach yesterday’s part two, though.

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

readInput =  
  Map.fromList  
    . map ((\(name : outs) -> (init name, outs)) . words)  
    . lines  

part1 input = go "you"  
  where  
    go "out" = 1  
    go name = maybe 0 (sum . map go) $ input Map.!? name  

part2 input = let (both, _, _, _) = pathsFrom "svr" in both  
  where  
    pathsFrom =  
      (Map.!)  
        . Map.insert "out" (0, 0, 0, 1)  
        . Map.fromList  
        . (zip <*> map findPaths)  
        $ Map.keys input ++ concat (Map.elems input)  
    findPaths n =  
      let (both, dac, fft, none) =  
            unzip4 $ maybe [] (map pathsFrom) (input Map.!? n)  
       in case n of  
            "dac" -> (sum both + sum fft, sum dac + sum none, 0, 0)  
            "fft" -> (sum both + sum dac, 0, sum fft + sum none, 0)  
            _ -> (sum both, sum dac, sum fft, sum none)  

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

That’s not quite the key observation…

Haskell

This is pretty ugly. I got rather fed up after trying out various heuristics when the test case passed but actual data didn’t.

import Control.Arrow  
import Data.Function  
import Data.Ix  
import Data.List  
import Data.Ord  

readInput :: String -> [(Int, Int)]  
readInput = map ((read *** (read . tail)) . break (== ',')) . lines  

pairs = concatMap (\(x : xs) -> map (x,) xs) . init . tails  

toRange ((a, b), (c, d)) = ((min a c, min b d), (max a c, max b d))  

onTiles loop rect = cornersInside && not crossingEdges  
  where  
    cornersInside =  
      let ((a, b), (c, d)) = rect  
       in inside (a, d) && inside (c, b)  
    verticalEdges = sortOn (Down . fst . fst) $ filter (uncurry ((==) `on` fst)) loop  
    inside (x, y) =  
      let intersecting ((a, b), (_, d)) = a <= x && inRange (min b d, max b d) y  
       in maybe False (uncurry ((>) `on` snd)) $ find intersecting verticalEdges  
    crossingEdges =  
      let ((a, b), (c, d)) = rect  
       in any (crossingLoop . toRange) $  
            [ ((a, b), (c, b)),  
              ((c, b), (c, d)),  
              ((c, d), (a, d)),  
              ((a, d), (a, b))  
            ]  
    crossingLoop ((a, b), (c, d))  
      | a == c = anyEdge (\((e, f), (g, h)) -> f == h && f > b && f < d && g > a && e < c)  
      | b == d = anyEdge (\((e, f), (g, h)) -> e == g && e > a && e < c && h > b && f < d)  
    anyEdge = flip any $ map toRange loop  

main = do  
  input <- readInput <$> readFile "input09"  
  let rects = pairs input  
      loop = zip (last input : input) input  
      go = print . maximum . map (rangeSize . toRange)  
  go rects  
  go $ filter (onTiles loop) rects  

Oh gosh, I remember this one. Working backwards is a good idea. In addition, you can just look at the start of the string when trying substitutions. I don’t think that’s valid in general, but it worked for me in this case.

There’s another trick you can do if you look carefully at the input data. I didn’t implement it in my solution because I didn’t spot it myself, but it essentially makes the problem trivial.

“Of course I’d love to transition and be a woman, it’s just that I’m not trans.”

That was also my logic for a looong time.

Haskell

I was late to the part on this one and forgot to post my solution :3

import Data.List  

readInput = map readMove . lines  
  where  
    readMove (d : ds) =  
      let n = read ds :: Int  
       in case d of  
            'L' -> -n  
            'R' -> n  

part1 = length . filter ((== 0) . (`mod` 100)) . scanl' (+) 50  

part2 = fst . foldl' count (0, 50)  
  where  
    count (z, p) d =  
      let (q, r) = (p + d) `divMod` 100  
          a = if p == 0 && d < 0 then -1 else 0  
          b = if r == 0 && d < 0 then 1 else 0  
       in (z + abs q + a + b, r)  

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

Thank you! ☺️

Haskell

They’re getting interesting now!

import Control.Monad  
import Data.List  
import Data.List.Split  
import Data.Ord  
import Data.Set qualified as Set  

readPos = (\([x, y, z] :: [Int]) -> (x, y, z)) . map read . splitOn ","  

pairs = init . tails >=> (\(x : xs) -> map (x,) xs)  

dist (x1, y1, z1) (x2, y2, z2) =  
  (x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^ 2  

connect circuits (a, b) =  
  let (joined, rest) =  
        partition (\c -> a `Set.member` c || b `Set.member` c) circuits  
   in Set.unions joined : rest  

main = do  
  boxes <- map readPos . lines <$> readFile "input08"  
  let steps =  
        (zip <*> tail . scanl' connect (map Set.singleton boxes)) $  
          sortOn (uncurry dist) (pairs boxes)  
  print . product . take 3 . sortOn Down . map Set.size $  
    (snd . last . take 1000 $ steps)  
  let Just (((x1, _, _), (x2, _, _)), _) =  
        find ((== 1) . length . snd) steps  
   in print $ x1 * x2  

Out drinking with friends, some guy we met at the bar was fawning over me. Admittedly he was a bit drunk but still, I couldn’t quite believe it. I guess this is a thing that’s going to happen from now on.

Why can’t there be more lesbians where I live :/

My current go-tos:

• Part of Your World (Jodie Benson)
• Kiss Me (Sixpence None The Richer)
• Eternal Flame (The Bangles)
• 翼の折れたエンジェル (中村あゆみ)

I really want to do some Ado songs, but she goes a bit above my range, sadly :/

And here’s a super-simple version, because why not.

import Data.List (elemIndex, elemIndices)  
import Data.Map qualified as Map  
import Data.Maybe (fromJust)  
import Data.Set qualified as Set  

main = do  
  (start : rows) <- lines <$> readFile "input07"  
  let splitsByRow =  
        zipWith  
          ( \row beams ->  
              Set.intersection (Map.keysSet beams)  
                . Set.fromDistinctAscList  
                $ elemIndices '^' row  
          )  
          rows  
          beamsByRow  
      beamsByRow =  
        scanl  
          ( \beams splits ->  
              let unsplit = beams `Map.withoutKeys` splits  
                  split = beams `Map.restrictKeys` splits  
                  splitLeft = Map.mapKeysMonotonic pred split  
                  splitRight = Map.mapKeysMonotonic succ split  
               in Map.unionsWith (+) [unsplit, splitLeft, splitRight]  
          )  
          (Map.singleton (fromJust $ elemIndex 'S' start) 1)  
          splitsByRow  
  print . sum $ map Set.size splitsByRow  
  print . sum $ last beamsByRow  

Thanks! I try to write code to be readable by humans above all else.

Haskell

That was a fun little problem.

import Data.Map qualified as Map  
import Data.Set qualified as Set  
import Data.Tuple (swap)  

readInput s =  
  Map.fromDistinctAscList  
    [((i, j), c) | (i, l) <- zip [0 ..] $ lines s, (j, c) <- zip [0 ..] l]  

beamPaths input = scanl step (Map.singleton startX 1) [startY .. endY]  
  where  
    Just (startY, startX) = lookup 'S' $ map swap $ Map.assocs input  
    Just ((endY, _), _) = Map.lookupMax input  
    step beams y =  
      Map.unionsWith (+) $  
        [ if input Map.!? (y + 1, j) == Just '^'  
            then Map.fromList [(j - 1, n), (j + 1, n)]  
            else Map.singleton j n  
          | (j, n) <- Map.assocs beams  
        ]  

part1 = sum . map Set.size . (zipWith (Set.\\) <*> tail) . map Map.keysSet . beamPaths  

part2 = sum . last . beamPaths  

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

Haskell

There’s probably a really clever way of abstracting just the difference between the two layouts.

import Data.Char (isSpace)  
import Data.List (transpose)  
import Data.List.Split (splitWhen)  

op '+' = sum  
op '*' = product  

part1 =  
  sum  
    . map ((op . head . last) <*> (map read . init))  
    . (transpose . map words . lines)  

part2 =  
  sum  
    . map ((op . last . last) <*> map (read . init))  
    . (splitWhen (all isSpace) . reverse . transpose . lines)  

main = do  
  input <- readFile "input06"  
  print $ part1 input  
  print $ part2 input  

Haskell

IntSet was the wrong first choice for part 2 :3

import Control.Arrow  
import Data.Foldable  
import Data.Ix  

readInput :: [Char] -> ([(Int, Int)], [Int])  
readInput =  
  (map readRange *** (map read . tail))  
    . break (== "")  
    . lines  
  where  
    readRange = (read *** (read . tail)) . break (== '-')  

part1 (ranges, ids) = length $ filter (\id -> any (`inRange` id) ranges) ids  

part2 (ranges, _) = sum $ map rangeSize $ foldl' addRange [] ranges  
  where  
    addRange [] x = [x]  
    addRange (r : rs) x  
      | touching r x = addRange rs $ merge r x  
      | otherwise = r : addRange rs x  
    touching (a, b) (c, d) = not (b < c - 1 || a > d + 1)  
    merge (a, b) (c, d) = (min a c, max b d)  

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

Haskell

Very simple, this one.

import Data.List  
import Data.Set qualified as Set  

readInput s =  
  Set.fromDistinctAscList  
    [ (i, j) :: (Int, Int)  
      | (i, l) <- zip [0 ..] (lines s),  
        (j, c) <- zip [0 ..] l,  
        c == '@'  
    ]  

accessible ps = Set.filter ((< 4) . adjacent) ps  
  where  
    adjacent (i, j) =  
      length . filter (`Set.member` ps) $  
        [ (i + di, j + dj)  
          | di <- [-1 .. 1],  
            dj <- [-1 .. 1],  
            (di, dj) /= (0, 0)  
        ]  

main = do  
  input <- readInput <$> readFile "input04"  
  let removed =  
        (`unfoldr` input) $  
          \ps ->  
            case accessible ps of  
              d  
                | Set.null d -> Nothing  
                | otherwise -> Just (Set.size d, ps Set.\\ d)  
  print $ head removed  
  print $ sum removed  

Version 2. I realized last night that my initial approach was way more complicated than it needed to be…

import Data.List
import Data.Semigroup

maxJolt :: Int -> [Char] -> Int
maxJolt r xs = read $ go r (length xs) xs
  where
    go r n xs =
      (\(Arg x xs) -> x : xs) . maximum $
        do
          (n', x : xs') <- zip (reverse [r .. n]) (tails xs)
          return . Arg x $ if r == 1 then [] else go (r - 1) (n' - 1) xs'

main = do
  input <- lines <$> readFile "input03"
  mapM_ (print . sum . (`map` input) . maxJolt) [2, 12]

Haskell

Yay, dynamic programming!

import Data.Map qualified as Map  

maxJolt :: Int -> [Char] -> Int  
maxJolt r xs = read $ maximize r 0  
  where  
    n = length xs  
    maximize =  
      (curry . (Map.!) . Map.fromList . (zip <*> map (uncurry go)))  
        [(k, o) | k <- [1 .. r], o <- [r - k .. n - k]]  
    go k o =  
      maximum $ do  
        (x, o') <- drop o $ zip xs [1 .. n - (k - 1)]  
        return . (x :) $ if k == 1 then [] else maximize (k - 1) o'  

main = do  
  input <- lines <$> readFile "input03"  
  mapM_ (print . sum . (`map` input) . maxJolt) [2, 12]  

Haskell

Not much time for challenges right now sadly :/

import Data.Bifunctor  
import Data.IntSet qualified as IntSet  
import Data.List.Split  

repeats bound (from, to) = IntSet.elems $ IntSet.unions $ map go [2 .. bound l2]  
  where  
    l1 = length (show from)  
    l2 = length (show to)  
    go n =  
      let l = max 1 $ l1 `quot` n  
          start = if n > l1 then 10 ^ (l - 1) else read . take l $ show from  
       in IntSet.fromList  
            . takeWhile (<= to)  
            . dropWhile (< from)  
            . map (read . concat . replicate n . show)  
            $ enumFrom start  

main = do  
  input <-  
    map (bimap read (read . tail) . break (== '-')) . splitOn ","  
      <$> readFile "input02"  
  let go bound = sum $ concatMap (repeats bound) input  
  print $ go (const 2)  
  print $ go id  

I’m on 2 x 0.72 mg patches every two days, plus 50 mg spiro and 100 mg prog every day. That gets me to 268 pg/mL E2 and 58 ng/dL testosterone, last blood test. I’d like to switch to a different anti-androgen though; I’m getting pretty fed up with the effects of spiro.