# Disk Defragmentation — Haskell — #adventofcode Day 14

Today's challenge has us helping a disk defragmentation program by identifying contiguous regions of used sectors on a 2D disk.

A lot more imports for this solution, as we're exercising a lot more of the standard library.

module Main where import Prelude hiding (length, filter, take) import Data.Char (ord) import Data.Sequence import Data.Foldable hiding (length) import Data.Ix (inRange) import Data.Function ((&)) import Data.Maybe (fromJust, mapMaybe, isJust) import qualified Data.Set as Set import Text.Printf (printf) import System.Environment (getArgs)

Also we'll extract the key bits from day 10 into a module and import that.

import KnotHash

Now we define a few data types to make the code a bit more readable. `Sector`

represent the state of a particular disk sector, either free, used (but unmarked) or used and marked as belonging to a given integer-labelled group. `Grid`

is a 2D matrix of `Sector`

, as a sequence of sequences.

data Sector = Free | Used | Mark Int deriving (Eq) instance Show Sector where show Free = " ." show Used = " #" show (Mark i) = printf "%4d" i type GridRow = Seq Sector type Grid = Seq (GridRow)

Some utility functions to make it easier to view the grids (which can be quite large): used for debugging but not in the finished solution.

subGrid :: Int -> Grid -> Grid subGrid n = fmap (take n) . take n printRow :: GridRow -> IO () printRow row = do mapM_ (putStr . show) row putStr "\n" printGrid :: Grid -> IO () printGrid = mapM_ printRow

`makeKey`

generates the hash key for a given row.

makeKey :: String -> Int -> String makeKey input n = input ++ "-" ++ show n

`stringToGridRow`

converts a binary string of '1' and '0' characters to a sequence of `Sector`

values.

stringToGridRow :: String -> GridRow stringToGridRow = fromList . map convert where convert x | x == '1' = Used | x == '0' = Free

`makeRow`

and `makeGrid`

build up the grid to use based on the provided input string.

makeRow :: String -> Int -> GridRow makeRow input n = stringToGridRow $ concatMap (printf "%08b") $ dense $ fullKnotHash 256 $ map ord $ makeKey input n makeGrid :: String -> Grid makeGrid input = fromList $ map (makeRow input) [0..127]

Utility functions to count the number of used and free sectors, to give the solution to part 1.

countEqual :: Sector -> Grid -> Int countEqual x = sum . fmap (length . filter (==x)) countUsed = countEqual Used countFree = countEqual Free

Now the real meat begins! `fundUnmarked`

finds the location of the next used sector that we haven't yet marked. It returns a `Maybe`

value, which is `Just (x, y)`

if there is still an unmarked block or `Nothing`

if there's nothing left to mark.

findUnmarked :: Grid -> Maybe (Int, Int) findUnmarked g | y == Nothing = Nothing | otherwise = Just (fromJust x, fromJust y) where hasUnmarked row = isJust $ elemIndexL Used row x = findIndexL hasUnmarked g y = case x of Nothing -> Nothing Just x' -> elemIndexL Used $ index g x'

`floodFill`

implements a very simple recursive flood fill. It takes a target and replacement value and a starting location, and fills in the replacement value for every *connected* location that currently has the target value. We use it below to replace a connected used region with a marked region.

floodFill :: Sector -> Sector -> (Int, Int) -> Grid -> Grid floodFill t r (x, y) g | inRange (0, length g - 1) x && inRange (0, length g - 1) y && elem == t = let newRow = update y r row newGrid = update x newRow g in newGrid & floodFill t r (x+1, y) & floodFill t r (x-1, y) & floodFill t r (x, y+1) & floodFill t r (x, y-1) | otherwise = g where row = g `index` x elem = row `index` y

`markNextGroup`

looks for an unmarked group and marks it if found. If no more groups are found it returns `Nothing`

. `markAllGroups`

then repeatedly applies `markNextGroup`

until `Nothing`

is returned.

markNextGroup :: Int -> Grid -> Maybe Grid markNextGroup i g = case findUnmarked g of Nothing -> Nothing Just loc -> Just $ floodFill Used (Mark i) loc g markAllGroups :: Grid -> Grid markAllGroups g = markAllGroups' 1 g where markAllGroups' i g = case markNextGroup i g of Nothing -> g Just g' -> markAllGroups' (i+1) g'

`onlyMarks`

filters a grid row and returns a list of (possibly duplicated) group numbers in the row.

onlyMarks :: GridRow -> [Int] onlyMarks = mapMaybe getMark . toList where getMark Free = Nothing getMark Used = Nothing getMark (Mark i) = Just i

Finally, `countGroups`

puts all the group numbers into a set to get rid of duplicates and returns the size of the set, i.e. the total number of separate groups.

countGroups :: Grid -> Int countGroups g = Set.size groupSet where groupSet = foldl' Set.union Set.empty $ fmap rowToSet g rowToSet = Set.fromList . toList . onlyMarks

As always, every Haskell program needs a main function to drive the I/O and produce the actual result.

main = do input <- fmap head getArgs let grid = makeGrid input used = countUsed grid marked = countGroups $ markAllGroups grid putStrLn $ "Used sectors: " ++ show used putStrLn $ "Groups: " ++ show marked

Commentary

Wow, today's challenge had a pretty steep learning curve. Day 14 was the first to directly reuse code from a previous day: the "knot hash" from day 10. I solved day 10 in Haskell, so I thought it would be easier to stick with Haskell for today as well. The first part was straightforward, but the second was pretty mind-bending in a pure functional language!

I ended up solving it by implementing a flood fill algorithm. It's recursive, which is right in Haskell's wheelhouse, but I ended up using

`Data.Sequence`

instead of the standard list type as its API for indexing is better. I haven't tried it, but I think it will also be a little faster than a naive list-based version.It took a looong time to figure everything out, but I had a day off work to be able to concentrate on it!