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")
|
;;; For more information see (info "(emacs) Directory Variables")
|
||||||
|
|
||||||
((haskell-mode
|
((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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: ece24a6f206c14c1251a73fcaadfb901287003b3dc6bb86e59bb0df886d7d33d
|
-- hash: ea04591b11d049b24eb195b76d379646dcfbc1c5bf4ee126d894309a7a7a3708
|
||||||
|
|
||||||
name: adventofcode
|
name: adventofcode
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -43,6 +43,7 @@ library
|
||||||
Day11
|
Day11
|
||||||
Day12
|
Day12
|
||||||
Day13
|
Day13
|
||||||
|
Day14
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_adventofcode
|
Paths_adventofcode
|
||||||
build-depends:
|
build-depends:
|
||||||
|
|
10
app/Main.hs
10
app/Main.hs
|
@ -21,6 +21,7 @@ import qualified Day10
|
||||||
import qualified Day11
|
import qualified Day11
|
||||||
import qualified Day12
|
import qualified Day12
|
||||||
import qualified Day13
|
import qualified Day13
|
||||||
|
import qualified Day14
|
||||||
|
|
||||||
showSol :: [Char] -> Doc -> IO ()
|
showSol :: [Char] -> Doc -> IO ()
|
||||||
showSol txt d = putText . toS . render $
|
showSol txt d = putText . toS . render $
|
||||||
|
@ -47,6 +48,7 @@ solutions = Map.fromList [(["01"], day01)
|
||||||
,(["11"], day11)
|
,(["11"], day11)
|
||||||
,(["12"], day12)
|
,(["12"], day12)
|
||||||
,(["13"], day13)
|
,(["13"], day13)
|
||||||
|
,(["14"], day14)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -163,3 +165,11 @@ day13 = do
|
||||||
input2 <- Day13.parseInput
|
input2 <- Day13.parseInput
|
||||||
let sol2 = Day13.solution2 =<< input2
|
let sol2 = Day13.solution2 =<< input2
|
||||||
showSol "Solution 2" (int (fromMaybe 0 sol2))
|
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
|
- Day11
|
||||||
- Day12
|
- Day12
|
||||||
- Day13
|
- Day13
|
||||||
|
- Day14
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >=4.7 && <5
|
- base >=4.7 && <5
|
||||||
- protolude
|
- 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 Day11
|
||||||
import qualified Day12
|
import qualified Day12
|
||||||
import qualified Day13
|
import qualified Day13
|
||||||
|
import qualified Day14
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain $
|
main = defaultMain $
|
||||||
|
@ -35,6 +36,7 @@ main = defaultMain $
|
||||||
, testDay11
|
, testDay11
|
||||||
, testDay12
|
, testDay12
|
||||||
, testDay13
|
, testDay13
|
||||||
|
, testDay14
|
||||||
]
|
]
|
||||||
|
|
||||||
testDay01 =
|
testDay01 =
|
||||||
|
@ -243,3 +245,17 @@ testDay13 =
|
||||||
(Day13.solution2 =<< Day13.parseTxt Day13.testInput) @?= Just 10
|
(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