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.

 Haskell

    
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.

 Haskell

    
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.

 Haskell

    
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

 Haskell

    
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.

 Haskell

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

 Haskell

    
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!

 Haskell

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

 Haskell

    
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.

This is a bit of a cop-out answer, but the effects of HRT vary hugely based on the person. The "relief" you are feeling might be placebo, might be due to biochemical dysphoria, or a bit of both.

When I was on injections, I definitely felt a bit crappy at the end of the week, and a lot better about 30 minutes after my dose.

When I was getting my dose for patches worked out, I felt what I can only describe as "testosterone anxiety", which persisted as I slowly bumped up my dose over a couple of weeks and eventually went away when I got up to three patches. (Now I'm on spiro and back down to two, and things are fine). This was a different feeling to injections wearing off.

Now the only thing I notice is that I get four days of being really tired and bitchy pretty consistently every 25 days or so. I'm not going to speculate what that is, but since I'm on a very stable dose of two patches every two days, I don't think it's due to dosage.

Yay! It sure does feel good.

Enjoy your new female metabolism :)

Good luck to you. I sincerely hope it goes better than you imagine.

Although I suspect and hope your friends will be accepting. Best wishes!

Ooh, very nicely done.

Haskell

Hmm. I'm still not very happy with part 3: it's a bit slow and messy. Doing state over the list monad for memoization doesn't work well, so I'm enumerating all possible configurations first and taking advantage of laziness.

 Haskell

    
import Control.Monad  
import Data.Bifunctor  
import Data.Ix  
import Data.List  
import Data.Map (Map)  
import Data.Map qualified as Map  
import Data.Maybe  
import Data.Set.Monad (Set)  
import Data.Set.Monad qualified as Set  
import Data.Tuple  

type Pos = (Int, Int)  

readInput :: String -> ((Pos, Pos), Pos, Set Pos, Set Pos)  
readInput s =  
  let grid =  
        Map.fromList  
          [ ((i, j), c)  
            | (i, cs) <- zip [0 ..] $ lines s,  
              (j, c) <- zip [0 ..] cs  
          ]  
   in ( ((0, 0), fst $ Map.findMax grid),  
        fst $ fromJust $ find ((== 'D') . snd) $ Map.assocs grid,  
        Set.fromList $ Map.keys (Map.filter (== 'S') grid),  
        Set.fromList $ Map.keys (Map.filter (== '#') grid)  
      )  

moveDragon (i, j) = Set.mapMonotonic (bimap (+ i) (+ j)) offsets  
  where  
    offsets = Set.fromList ([id, swap] <*> ((,) <$> [-1, 1] <*> [-2, 2]))  

dragonMoves bounds =  
  iterate (Set.filter (inRange bounds) . (>>= moveDragon)) . Set.singleton  

part1 n (bounds, start, sheep, _) =  
  (!! n)  
    . map (Set.size . Set.intersection sheep)  
    . scanl1 Set.union  
    $ dragonMoves bounds start  

part2 n (bounds, dragonStart, sheepStart, hideouts) =  
  (!! n)  
    . map ((Set.size sheepStart -) . Set.size)  
    . scanl'  
      ( \sheep eaten ->  
          (Set.\\ eaten)  
            . Set.mapMonotonic (first (+ 1))  
            . (Set.\\ eaten)  
            $ sheep  
      )  
      sheepStart  
    . map (Set.\\ hideouts)  
    $ (tail $ dragonMoves bounds dragonStart)  

part3 (bounds, dragonStart, sheepStart, hideouts) =  
  count (dragonStart, sheepStart)  
  where  
    sheepStartByColumn = Map.fromList $ map swap $ Set.elems sheepStart  
    sheepConfigs =  
      map  
        ( (Set.fromList . catMaybes)  
            . zipWith (\j -> fmap (,j)) (Map.keys sheepStartByColumn)  
        )  
        . mapM  
          ( ((Nothing :) . map Just)  
              . (`enumFromTo` (fst $ snd bounds))  
          )  
        $ Map.elems sheepStartByColumn  
    count =  
      ((Map.!) . Map.fromList . map ((,) <*> go))  
        ((,) <$> range bounds <*> sheepConfigs)  
    go (dragon, sheep)  
      | null sheep = 1  
      | otherwise =  
          (sum . map count) $ do  
            let movableSheep =  
                  filter (\(_, p) -> p /= dragon || Set.member p hideouts) $  
                    map (\(i, j) -> ((i, j), (i + 1, j))) $  
                      Set.elems sheep  
                sheepMoves =  
                  if null movableSheep  
                    then [sheep]  
                    else do  
                      (p1, p2) <- movableSheep  
                      return $ Set.insert p2 $ Set.delete p1 sheep  
            sheep' <- sheepMoves  
            guard $ all (inRange bounds) sheep'  
            dragon' <- Set.elems $ moveDragon dragon  
            guard $ inRange bounds dragon'  
            let eaten = Set.singleton dragon' Set.\\ hideouts  
            return (dragon', sheep' Set.\\ eaten)  

main = do  
  readFile "everybody_codes_e2025_q10_p1.txt" >>= print . part1 4 . readInput  
  readFile "everybody_codes_e2025_q10_p2.txt" >>= print . part2 20 . readInput  
  readFile "everybody_codes_e2025_q10_p3.txt" >>= print . part3 . readInput

As others have said, you're not going to notice anything right away. Why not start taking it regularly and let it cook while you focus on other things? A month or so down the road you'll probably realize you feel better than you ever have and don't want to stop.

That's fascinating, thank you!

I mean... it can?

It's pretty awesome, actually.

Haskell

Not particularly optimized but good enough.

 Haskell

    
import Control.Arrow ((***))  
import Data.Array (assocs)  
import Data.Function (on)  
import Data.Graph  
import Data.List  
import Data.Map (Map)  
import Data.Map qualified as Map  
import Data.Maybe  

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

findRelations :: Map Int [Char] -> Graph  
findRelations dna =  
  buildG (1, Map.size dna)  
    . concatMap (\(x, (y, z)) -> [(x, y), (x, z)])  
    . mapMaybe (\x -> (x,) <$> findParents x)  
    $ Map.keys dna  
  where  
    findParents x =  
      find (isChild x) $  
        [(y, z) | (y : zs) <- tails $ delete x $ Map.keys dna, z <- zs]  
    isChild x (y, z) =  
      all (\(a, b, c) -> a == b || a == c) $  
        zip3 (dna Map.! x) (dna Map.! y) (dna Map.! z)  

scores :: Map Int [Char] -> Graph -> [Int]  
scores dna relations =  
  [similarity x y * similarity x z | (x, [y, z]) <- assocs relations]  
  where  
    similarity i j =  
      length . filter (uncurry (==)) $ zip (dna Map.! i) (dna Map.! j)  

part1, part2, part3 :: Map Int [Char] -> Int  
part1 = sum . (scores <*> findRelations)  
part2 = part1  
part3 = sum . maximumBy (compare `on` length) . components . findRelations  

main = do  
  readFile "everybody_codes_e2025_q09_p1.txt" >>= print . part1 . readInput  
  readFile "everybody_codes_e2025_q09_p2.txt" >>= print . part2 . readInput  
  readFile "everybody_codes_e2025_q09_p3.txt" >>= print . part3 . readInput

Amy

@ lwhjp @piefed.blahaj.zone

Posts

7
Comments

114
Joined

5 mo. ago

Hi, I’m Amy.
✨ New 🏳️‍⚧️ improved ♀️ version 👩‍❤️‍👩 out 🏳️‍🌈 now! 🎊
I live in Japan. Talk to me about Haskell, Scheme, and Linux.
日本語も通じます。

Amy

What song would you sing ag karaoke?

👪 - 2025 DAY 7 SOLUTIONS - 👪

💃 - 2025 DAY 6 SOLUTIONS - 💃

👪 - 2025 DAY 7 SOLUTIONS - 👪

Haskell

💃 - 2025 DAY 6 SOLUTIONS - 💃

Haskell

🎄 - 2025 DAY 5 SOLUTIONS - 🎄

Haskell

🎄 - 2025 DAY 4 SOLUTIONS - 🎄

Haskell

💃 - 2025 DAY 3 SOLUTIONS - 💃

💃 - 2025 DAY 3 SOLUTIONS - 💃

Haskell

🧑 - 2025 DAY 2 SOLUTIONS - 🧑

Haskell

Permanently Deleted

Permanently Deleted

Oh my fucking good, estrogen feels amazing

Wish me luck everyone

🍄-nails

🦆 Everybody.Codes 2025 Quest 10 Solutions 🦆

Haskell

What to expect when trying HRT for the first time

neo-vaginal microbiome: problems & personal breakthroughs

what if it could happen for real

🦆 Everybody.Codes 2025 Quest 9 Solutions 🦆

Haskell