Skip Navigation

🎁 - 2023 DAY 5 SOLUTIONS -🎁

Day 5: If You Give a Seed a Fertilizer


Megathread guidelines

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • Code block support is not fully rolled out yet but likely will be in the middle of the event. Try to share solutions as both code blocks and using something such as https://topaz.github.io/paste/ , pastebin, or github (code blocks to future proof it for when 0.19 comes out and since code blocks currently function in some apps and some instances as well if they are running a 0.19 beta)

FAQ


πŸ”’This post will be unlocked when there is a decent amount of submissions on the leaderboard to avoid cheating for top spots

πŸ”“ Unlocked after 27 mins (current record for time, hard one today)

39

You're viewing a single thread.

39 comments
  • 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?

    import Data.List
    import Data.List.Split
    
    readInput :: String -> ([Int], [(String, [(Int, Int, Int)])])
    readInput s =
      let (seedsChunk : mapChunks) = splitOn [""] $ lines s
          seeds = map read $ tail $ words $ head seedsChunk
          maps = map readMapChunk mapChunks
       in (seeds, maps)
      where
        readMapChunk (title : rows) =
          let name = head $ words title
              entries = map ((\[a, b, c] -> (a, b, c)) . map read . words) rows
           in (name, entries)
    
    part1 (seeds, maps) =
      let f = foldl1' (flip (.)) $ map (ref . snd) maps
       in minimum $ map f seeds
      where
        ref [] x = x
        ref ((a, b, c) : rest) x =
          let i = x - b
           in if i >= 0 && i < c
                then a + i
                else ref rest x
    
    mapRange :: [(Int, Int, Int)] -> (Int, Int) -> [(Int, Int)]
    mapRange entries (start, end) =
      go start $ sortOn (\(_, b, _) -> b) entries
      where
        go i [] = [(i, end)]
        go i es@((a, b, c) : rest)
          | i > end = []
          | b > end = go i []
          | b + c <= i = go i rest
          | i < b = (i, b - 1) : go b es
          | otherwise =
              let d = min (b + c - 1) end
               in (a + i - b, a + d - b) : go (d + 1) rest
    
    part2 (seeds, maps) =
      let seedRanges = map (\[a, b] -> (a, a + b - 1)) $ chunksOf 2 seeds
       in minimum $ map fst $ foldl' (flip mapRanges) seedRanges $ map snd maps
      where
        mapRanges m = concatMap (mapRange m)
    
    main = do
      input <- readInput <$> readFile "input05"
      print $ part1 input
      print $ part2 input
    
You've viewed 39 comments.