Day 9: Disk Fragmenter
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)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 
2 points
*
Haskell
Not a lot of time to come up with a pretty solution today; sorry.
Ugly first solution
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
3 points
*
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, (<=)]
2 points
It will always be a wonder to me how you manage to do so much in so few lines, even your naive solution only takes a few seconds to run. 🤯
1 point
Aww, thank you <3
It’s just practice, I guess? (The maths degree probably doesn’t hurt either)
