src/advent14/advent14.hs

   1 import Data.List.Split (chunksOf)
   2 import Data.Char (ord)
   3 import Text.Printf (printf)
   4 import Data.Bits (xor)
   5
   6 puzzleKey = "xlqgujun"
   7
   8
   9 part1 :: String -> Int
  10 part1 key = sum rowCounts
  11     where hashes = map knotHash $ rowSpecs key
  12           rowCounts = map (countSetBits . binify) hashes
  13
  14 rowSpecs :: String -> [String]
  15 rowSpecs key = map (((key ++ "-") ++) . show) [0..127]
  16
  17 countSetBits :: String -> Int
  18 countSetBits = length . filter (== '1')
  19
  20
  21 knotHash :: String -> [Int]
  22 knotHash input = densify tied
  23     where (tied, _, _) = foldl step ([0..255], 0, 0) hashTerms
  24           hashTerms = mkHashTerms input
  25
  26 step :: ([Int], Int, Int) -> Int -> ([Int], Int, Int)
  27 step (original, start, skip) len = (replaced, start', skip + 1)
  28     where replaced = tie original start len
  29           start' = (start + len + skip) `mod` (length original)
  30
  31 tie :: [a] -> Int -> Int -> [a]
  32 tie original start len = replace original replacement start
  33     where replacement = reverse $ extract original start len
  34
  35 extract :: [a] -> Int -> Int -> [a]
  36 extract items from len = take len $ drop from $ items ++ items
  37
  38 replace :: [a] -> [a] -> Int -> [a]
  39 replace original replacement from = take (length original) (start ++ replacement ++ remainder)
  40     where excess = drop (length original - from) replacement
  41           stub = drop (length excess) original
  42           start = take from (excess ++ stub)
  43           remainder = drop (length $ start ++ replacement) original
  44
  45
  46 mkHashTerms :: String -> [Int]
  47 mkHashTerms text = take (length chunk * 64) $ cycle chunk
  48     where chunk = map ord text ++ [17, 31, 73, 47, 23]
  49
  50 hexify :: [Int] -> String
  51 hexify = concatMap (printf "%02x")
  52
  53 binify :: [Int] -> String
  54 binify = concatMap (printf "%08b")
  55
  56 densify :: [Int] -> [Int]
  57 densify ns = codes
  58     where chunks = chunksOf 16 ns
  59           compress = foldl1 xor
  60           codes = map compress chunks