Initial commit

2017/14/day14.hs

@@ -0,0 +1,41 @@
+#!/usr/bin/env stack
+-- stack --resolver lts-9.18 script
+
+import Data.List
+import Data.List.Split
+import Data.Char
+import Data.Bits
+import Text.Printf
+
+twist :: [Int] -> Int -> Int -> [Int]
+twist xs len skip =
+  end ++ start
+  where (knot, keep) = splitAt len xs
+        (start, end) = splitAt skip $ keep ++ reverse knot
+
+twists :: [Int] -> [Int] -> Int -> [Int]
+twists list [] k = list
+twists list (x:xs) k = twists (twist list x k) xs (k+1)
+
+hashRound :: Int -> [Int] -> [Int]
+hashRound n lens = drop rot list ++ take rot list
+  where list = foldl' (\acc (x,k) -> twist acc x k) [0..(n-1)] $ zip lens (cycle [0..(n-1)])
+        rot = n - (sum (zipWith (+) [0..] lens) `rem` n)
+
+sparseHash :: [Int] -> [Int]
+sparseHash lengths =
+  hashRound 256 . concat . replicate 64 $ lengths ++ [17, 31, 73, 47, 23]
+
+denseHash :: [Int] -> [Int]
+denseHash h = foldr xor 0 <$> chunksOf 16 h
+
+grid :: String -> [[Int]]
+grid input =
+  map (denseHash . sparseHash . map ord . ((input++"-")++) . show) [0..127]
+
+main :: IO ()
+main = do
+  let input = "stpzcrnm"
+  let g = grid input
+  mapM_ (putStrLn . concatMap (printf "%08b")) g
+  print . length . filter (=='1') . concat $ map (concatMap (printf "%08b")) g