Date:

Series

This post is part of the series Advent of Code 2017

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

→ Full code on GitHub

!!! 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][flood]. 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!
``````

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
let grid = makeGrid input
used = countUsed grid
marked = countGroups \$ markAllGroups grid

putStrLn \$ "Used sectors: " ++ show used
putStrLn \$ "Groups: " ++ show marked
``````

## Webmentions

You can respond to this post, "Disk Defragmentation — Haskell — #adventofcode Day 14", by: liking, boosting or replying to a tweet or toot that mentions it; or sending a webmention from your own site to `https://erambler.co.uk/blog/day-14/`

Comments & reactions haven't loaded yet. You might have JavaScript disabled but that's cool 😎.