Day 14

.dir-locals.el

@@ -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")))
+
+
 
 
 

adventofcode.cabal

@@ -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:

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)

package.yaml

@@ -26,6 +26,7 @@ library:
   - Day11
   - Day12
   - Day13
+  - Day14
   dependencies:
   - base >=4.7 && <5
   - protolude

src/Day14.hs

@@ -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

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")
+    ]
+  ]