Day 14

Honestly, I'm surprised that this is even remotely fast. The usage of plain
linked-list strings should make this horrifyingly slow, but apparently, the
combination of an optimising GHC and a not-too-large map (apparently) make
this tractable.

2 files changed, 96 insertions, 0 deletions

diff --git a/2017/14.hs b/2017/14.hs
new file mode 100644
index 0000000..ff60529
--- /dev/null
+++ b/2017/14.hs
@@ -0,0 +1,95 @@
+import Control.Monad
+import Data.Bits hiding (rotate)
+import Data.Char
+import Data.List
+import Numeric
+
+
+strip :: String -> String
+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+
+rotate :: Int -> [a] -> [a]
+rotate num l = take (length l) (drop num (cycle l))
+
+blocks :: Int -> [a] -> [[a]]
+blocks _ [] = []
+blocks n l = let (pre, post) = splitAt n l in pre : blocks n post
+
+pad :: Int -> a -> [a] -> [a]
+pad len x list = replicate (len - length list) x ++ list
+
+tie' :: [a] -> [Int] -> Int -> [a]
+tie' chain [] _ = chain
+tie' chain (len : lens) skip =
+    let (sub, rest) = splitAt len chain
+    in tie' (rotate skip (rest ++ reverse sub)) lens (skip + 1)
+
+tie :: [a] -> [Int] -> [a]
+tie chain lens =
+    let chainlen = length chain
+        numlens = length lens
+        backnum = chainlen - (sum lens + numlens * (numlens - 1) `div` 2) `mod` chainlen
+    in rotate backnum (tie' chain lens 0)
+
+knotHash :: [Int] -> [Int]
+knotHash input =
+    let chainlen = 256
+        lenlist = input ++ [17, 31, 73, 47, 23]
+        sparse = tie [0..chainlen-1] (take (64 * length lenlist) (cycle lenlist))
+    in map (foldl1 xor) (blocks 16 sparse)
+
+toHex :: [Int] -> String
+toHex = concat . map (pad 2 '0' . flip showHex "")
+
+fromStr :: String -> [Int]
+fromStr = map ord . strip
+
+
+bytebits :: Int -> [Int]
+bytebits n = map (fromEnum . testBit n) [7,6..0]
+
+setAt :: Int -> a -> [a] -> [a]
+setAt i v l =
+    let (pre, _ : post) = splitAt i l
+    in pre ++ v : post
+
+setAt2 :: Int -> Int -> a -> [[a]] -> [[a]]
+setAt2 x y v ch =
+    let (pre, r : post) = splitAt y ch
+    in pre ++ setAt x v r : post
+
+floodfill :: [[Int]] -> [[Int]]
+floodfill topchart = go 0 0 2 topchart
+  where
+    w = length (head topchart)
+    h = length topchart
+
+    go :: Int -> Int -> Int -> [[Int]] -> [[Int]]
+    go x y _ chart | x < 0 || y < 0 || x >= w || y >= h = chart
+    go x y ctr chart = case chart !! y !! x of
+        1 -> next x y (ctr+1) $ fill x y ctr chart
+        _ -> next x y ctr chart
+
+    fill :: Int -> Int -> Int -> [[Int]] -> [[Int]]
+    fill x y _ chart | x < 0 || y < 0 || x >= w || y >= h = chart
+    fill x y ctr chart = case chart !! y !! x of
+        1 -> fill (x-1) y ctr $ fill x (y-1) ctr $ fill (x+1) y ctr $ fill x (y+1) ctr $ setAt2 x y ctr chart
+        _ -> chart
+
+    next :: Int -> Int -> Int -> [[Int]] -> [[Int]]
+    next x y ctr chart =
+        if x == w-1
+            then if y == h-1 then chart else go 0 (y+1) ctr chart
+            else go (x+1) y ctr chart
+
+main :: IO ()
+main = do
+    prefix <- liftM strip (readFile "14.in")
+    let hashes = map (knotHash . fromStr) [prefix ++ '-' : show i | i <- [0..127]]
+    let chart = map (concatMap bytebits) hashes
+    -- putStrLn (intercalate "\n" $ map (map (\b -> ".#" !! fromEnum b)) chart)
+
+    print $ sum (map sum chart)
+
+    let chart' = floodfill chart
+    print $ maximum (map maximum chart') - 1
diff --git a/2017/14.in b/2017/14.in
new file mode 100644
index 0000000..879ef41
--- /dev/null
+++ b/2017/14.in
@@ -0,0 +1 @@
+vbqugkhl