Day 14
This commit is contained in:
parent
744aec1540
commit
1267845646
6 changed files with 249 additions and 2 deletions
|
@ -2,7 +2,11 @@
|
|||
;;; For more information see (info "(emacs) Directory Variables")
|
||||
|
||||
((haskell-mode
|
||||
(intero-targets "adventofcode:lib" "adventofcode:exe:adventofcode-exe" "adventofcode:test:adventofcode-test")))
|
||||
(intero-targets "adventofcode:lib"
|
||||
"adventofcode:exe:adventofcode-exe"
|
||||
"adventofcode:test:adventofcode-test")))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: ece24a6f206c14c1251a73fcaadfb901287003b3dc6bb86e59bb0df886d7d33d
|
||||
-- hash: ea04591b11d049b24eb195b76d379646dcfbc1c5bf4ee126d894309a7a7a3708
|
||||
|
||||
name: adventofcode
|
||||
version: 0.1.0.0
|
||||
|
@ -43,6 +43,7 @@ library
|
|||
Day11
|
||||
Day12
|
||||
Day13
|
||||
Day14
|
||||
other-modules:
|
||||
Paths_adventofcode
|
||||
build-depends:
|
||||
|
|
10
app/Main.hs
10
app/Main.hs
|
@ -21,6 +21,7 @@ import qualified Day10
|
|||
import qualified Day11
|
||||
import qualified Day12
|
||||
import qualified Day13
|
||||
import qualified Day14
|
||||
|
||||
showSol :: [Char] -> Doc -> IO ()
|
||||
showSol txt d = putText . toS . render $
|
||||
|
@ -47,6 +48,7 @@ solutions = Map.fromList [(["01"], day01)
|
|||
,(["11"], day11)
|
||||
,(["12"], day12)
|
||||
,(["13"], day13)
|
||||
,(["14"], day14)
|
||||
]
|
||||
|
||||
|
||||
|
@ -163,3 +165,11 @@ day13 = do
|
|||
input2 <- Day13.parseInput
|
||||
let sol2 = Day13.solution2 =<< input2
|
||||
showSol "Solution 2" (int (fromMaybe 0 sol2))
|
||||
|
||||
day14 :: IO ()
|
||||
day14 = do
|
||||
putText "Day 14:"
|
||||
let sol1 = Day14.solution1 Day14.input
|
||||
showSol "Solution 1" (int (fromMaybe 0 sol1))
|
||||
sol2 <- Day14.solution2 Day14.input
|
||||
showSol "Solution 2" (int sol2)
|
||||
|
|
|
@ -26,6 +26,7 @@ library:
|
|||
- Day11
|
||||
- Day12
|
||||
- Day13
|
||||
- Day14
|
||||
dependencies:
|
||||
- base >=4.7 && <5
|
||||
- protolude
|
||||
|
|
215
src/Day14.hs
Normal file
215
src/Day14.hs
Normal file
|
@ -0,0 +1,215 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-|
|
||||
description:
|
||||
|
||||
--- Day 14: Disk Defragmentation ---
|
||||
|
||||
Suddenly, a scheduled job activates the system's disk defragmenter. Were the
|
||||
situation different, you might sit and watch it for a while, but today, you just
|
||||
don't have that kind of time. It's soaking up valuable system resources that are
|
||||
needed elsewhere, and so the only option is to help it finish its task as soon
|
||||
as possible.
|
||||
|
||||
The disk in question consists of a 128x128 grid; each square of the grid is
|
||||
either free or used. On this disk, the state of the grid is tracked by the bits
|
||||
in a sequence of knot hashes.
|
||||
|
||||
A total of 128 knot hashes are calculated, each corresponding to a single row in
|
||||
the grid; each hash contains 128 bits which correspond to individual grid
|
||||
squares. Each bit of a hash indicates whether that square is free (0) or used
|
||||
(1).
|
||||
|
||||
The hash inputs are a key string (your puzzle input), a dash, and a number from
|
||||
0 to 127 corresponding to the row. For example, if your key string were
|
||||
flqrgnkx, then the first row would be given by the bits of the knot hash of
|
||||
flqrgnkx-0, the second row from the bits of the knot hash of flqrgnkx-1, and so
|
||||
on until the last row, flqrgnkx-127.
|
||||
|
||||
The output of a knot hash is traditionally represented by 32 hexadecimal digits;
|
||||
each of these digits correspond to 4 bits, for a total of 4 * 32 = 128 bits. To
|
||||
convert to bits, turn each hexadecimal digit to its equivalent binary value,
|
||||
high-bit first: 0 becomes 0000, 1 becomes 0001, e becomes 1110, f becomes 1111,
|
||||
and so on; a hash that begins with a0c2017... in hexadecimal would begin with
|
||||
10100000110000100000000101110000... in binary.
|
||||
|
||||
Continuing this process, the first 8 rows and columns for key flqrgnkx appear as
|
||||
follows, using # to denote used squares, and . to denote free ones:
|
||||
|
||||
##.#.#..-->
|
||||
.#.#.#.#
|
||||
....#.#.
|
||||
#.#.##.#
|
||||
.##.#...
|
||||
##..#..#
|
||||
.#...#..
|
||||
##.#.##.-->
|
||||
| |
|
||||
V V
|
||||
|
||||
In this example, 8108 squares are used across the entire 128x128 grid.
|
||||
|
||||
Given your actual key string, how many squares are used?
|
||||
|
||||
--- Part Two ---
|
||||
|
||||
Now, all the defragmenter needs to know is the number of regions. A region is a
|
||||
group of used squares that are all adjacent, not including diagonals. Every used
|
||||
square is in exactly one region: lone used squares form their own isolated
|
||||
regions, while several adjacent squares all count as a single region.
|
||||
|
||||
In the example above, the following nine regions are visible, each marked with a
|
||||
distinct digit:
|
||||
|
||||
11.2.3..-->
|
||||
.1.2.3.4
|
||||
....5.6.
|
||||
7.8.55.9
|
||||
.88.5...
|
||||
88..5..8
|
||||
.8...8..
|
||||
88.8.88.-->
|
||||
| |
|
||||
V V
|
||||
|
||||
Of particular interest is the region marked 8; while it does not appear
|
||||
contiguous in this small view, all of the squares marked 8 are connected when
|
||||
considering the whole 128x128 grid. In total, in this example, 1242 regions are
|
||||
present.
|
||||
|
||||
How many regions are present given your key string?
|
||||
|
||||
|-}
|
||||
module Day14 where
|
||||
|
||||
import Protolude
|
||||
|
||||
import qualified Day10
|
||||
|
||||
import Data.Array.IO (IOUArray)
|
||||
import Data.Array.MArray
|
||||
import qualified Data.Text as T
|
||||
|
||||
input :: Text
|
||||
input = "hfdlxzhv"
|
||||
|
||||
testInput :: Text
|
||||
testInput = "flqrgnkx"
|
||||
|
||||
-- solution1 :: Text -> Maybe Int
|
||||
solution1 input =
|
||||
grid input
|
||||
& fmap (fmap binToNb) -- Maybe [Int]
|
||||
& fmap sum'
|
||||
where
|
||||
lineToNbUsed :: Text -> Maybe Int
|
||||
lineToNbUsed = fmap binToNb . lineToBin
|
||||
binToNb :: Text -> Int
|
||||
binToNb = T.length . T.filter (== '1')
|
||||
|
||||
grid :: Text -> Maybe [Text]
|
||||
grid input =
|
||||
input & inputToLines & traverse lineToBin
|
||||
|
||||
inputToLines :: Text -> [Text]
|
||||
inputToLines input = map (\i -> input <> "-" <> show i) [0..127]
|
||||
|
||||
lineToBin :: Text -> Maybe Text
|
||||
lineToBin = hexToBin . Day10.solution2
|
||||
|
||||
sum' :: [Int] -> Int
|
||||
sum' = foldl' (+) 0
|
||||
|
||||
hexToBin :: [Char] -> Maybe Text
|
||||
hexToBin = fmap T.concat . traverse chexToBin
|
||||
|
||||
chexToBin :: Char -> Maybe Text
|
||||
chexToBin '0' = Just "0000"
|
||||
chexToBin '1' = Just "0001"
|
||||
chexToBin '2' = Just "0010"
|
||||
chexToBin '3' = Just "0011"
|
||||
chexToBin '4' = Just "0100"
|
||||
chexToBin '5' = Just "0101"
|
||||
chexToBin '6' = Just "0110"
|
||||
chexToBin '7' = Just "0111"
|
||||
chexToBin '8' = Just "1000"
|
||||
chexToBin '9' = Just "1001"
|
||||
chexToBin 'a' = Just "1010"
|
||||
chexToBin 'b' = Just "1011"
|
||||
chexToBin 'c' = Just "1100"
|
||||
chexToBin 'd' = Just "1101"
|
||||
chexToBin 'e' = Just "1110"
|
||||
chexToBin 'f' = Just "1111"
|
||||
chexToBin _ = Nothing
|
||||
|
||||
type Coord = (Int,Int)
|
||||
type Matrix = IOUArray Coord Int
|
||||
|
||||
bingrid :: Text -> IO (Maybe Matrix)
|
||||
bingrid txt = do
|
||||
let mlines = concatMap textToArray <$> grid txt
|
||||
case mlines of
|
||||
Nothing -> return Nothing
|
||||
Just lines -> Just <$> newListArray ((0,0),(127,127)) lines
|
||||
where
|
||||
textToArray :: Text -> [Int]
|
||||
textToArray t = T.unpack t & map (\x -> if x == '0' then -1 else 0)
|
||||
|
||||
|
||||
solution2 :: Text -> IO Int
|
||||
solution2 txt = do
|
||||
mmatrix <- bingrid txt
|
||||
case mmatrix of
|
||||
Nothing -> return 0
|
||||
Just matrix -> fillGroups 0 matrix
|
||||
|
||||
fillGroups :: Int -> Matrix -> IO Int
|
||||
fillGroups group matrix = do
|
||||
-- print group
|
||||
-- showMatrix matrix 16
|
||||
mc <- searchNewGroupStart matrix
|
||||
case mc of
|
||||
Nothing -> return group
|
||||
Just c -> do
|
||||
fillGroupFrom matrix c
|
||||
numberizeGroup matrix (group + 1)
|
||||
fillGroups (group + 1) matrix
|
||||
|
||||
searchNewGroupStart :: Matrix -> IO (Maybe Coord)
|
||||
searchNewGroupStart matrix = do
|
||||
lst <- getAssocs matrix
|
||||
return $ lst & filter ((== 0) . snd) & head & map fst
|
||||
|
||||
showMatrix :: Matrix -> Int -> IO ()
|
||||
showMatrix matrix m =
|
||||
traverse_ (\y -> do
|
||||
vals <- traverse (\x -> readArray matrix (x,y)) [0..m]
|
||||
putText (showLine vals)) [0..m]
|
||||
where
|
||||
showLine :: [Int] -> Text
|
||||
showLine xs = T.concat lines
|
||||
where lines :: [Text]
|
||||
lines = map (\case
|
||||
-1 -> "."
|
||||
-2 -> "@"
|
||||
_ -> "X") xs
|
||||
|
||||
|
||||
|
||||
fillGroupFrom :: Matrix -> Coord -> IO Matrix
|
||||
fillGroupFrom matrix c@(x,y) = do
|
||||
bounds <- getBounds matrix
|
||||
writeArray matrix c (-2)
|
||||
coordsToFill <- filter isJust <$> traverse isZero (filter (inRange bounds) [(x-1,y),(x+1,y),(x,y-1),(x,y+1)])
|
||||
traverse_ (\(Just x) -> fillGroupFrom matrix x) coordsToFill
|
||||
return matrix
|
||||
where
|
||||
isZero :: Coord -> IO (Maybe Coord)
|
||||
isZero c = do
|
||||
v <- readArray matrix c
|
||||
return $ if v == 0 then Just c else Nothing
|
||||
|
||||
numberizeGroup :: Matrix -> Int -> IO Matrix
|
||||
numberizeGroup matrix group =
|
||||
mapArray (\x -> if x == -2 then group else x) matrix
|
16
test/Spec.hs
16
test/Spec.hs
|
@ -18,6 +18,7 @@ import qualified Day10
|
|||
import qualified Day11
|
||||
import qualified Day12
|
||||
import qualified Day13
|
||||
import qualified Day14
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain $
|
||||
|
@ -35,6 +36,7 @@ main = defaultMain $
|
|||
, testDay11
|
||||
, testDay12
|
||||
, testDay13
|
||||
, testDay14
|
||||
]
|
||||
|
||||
testDay01 =
|
||||
|
@ -243,3 +245,17 @@ testDay13 =
|
|||
(Day13.solution2 =<< Day13.parseTxt Day13.testInput) @?= Just 10
|
||||
]
|
||||
]
|
||||
|
||||
testDay14 =
|
||||
testGroup "Day 14"
|
||||
[ testGroup "Solution 1"
|
||||
[ testCase "Example" $
|
||||
Day14.solution1 Day14.testInput @?= Just 8108
|
||||
]
|
||||
, testGroup "Solution 2"
|
||||
[ testCaseSteps "Example" $ \step -> do
|
||||
sol <- Day14.solution2 Day14.testInput
|
||||
when (sol /= 1242)
|
||||
(assertFailure "Should be 1242 groups")
|
||||
]
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue