summaryrefslogtreecommitdiff
path: root/2017
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-12-14 10:29:33 +0100
committertomsmeding <tom.smeding@gmail.com>2017-12-14 10:29:33 +0100
commitc88ae38f6da0fa9ce97c9bffa5c3470145467bf7 (patch)
tree053c1ea84e1b0e1fc7f4bd6847cb733b27fb5543 /2017
parentc56796a2ebe192fe0832b4e5000e900fcfd5fa40 (diff)
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.
Diffstat (limited to '2017')
-rw-r--r--2017/14.hs95
-rw-r--r--2017/14.in1
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