module Puzzle10 (knotHash) where import Data.List.Split (splitOn) import Data.Bits (xor) import Numeric (showHex) import Data.Char (ord) split3Ways :: [Int] -> Int -> Int -> ([Int], [Int], [Int]) split3Ways xs from to | to >= from = (take from xs, take (to - from) (drop from xs), drop to xs) | otherwise = split3Ways xs to from permute :: [Int] -> Int -> Int -> [Int] permute xs from to | to >= from = xs1 ++ reverse xs2 ++ xs3 | otherwise = xs1' ++ xs2 ++ xs3' where (xs1, xs2, xs3) = split3Ways xs from to xs4 = reverse (xs3 ++ xs1) (xs3', xs1') = splitAt (length xs3) xs4 step :: ([Int], Int, Int) -> Int -> ([Int], Int, Int) step (xs, skip, from) n = let m = length xs in (permute xs from ((from + n) `mod` m), skip + 1, (from + n + skip) `mod` m) solve1' :: [Int] -> Int solve1' xs = let (ys, _, _) = foldl step ([0 .. 255], 0, 0) xs in --solve1' xs = let (ys, _, _) = foldl step ([0 .. 4], 0, 0) xs in (head ys) * (head $ tail ys) parseInput :: [Char] -> [Int] parseInput = (fmap read) . (splitOn ",") solve1 :: [Char] -> Int solve1 = solve1' . parseInput sparseHash :: [Int] -> [Int] sparseHash xs = let (ys, _, _) = foldl step ([0 .. 255], 0, 0) $ take (64 * (length xs)) (cycle xs) in ys stepHash :: (Int, [Int]) -> (Int, [Int]) stepHash (xs, ys) = (foldl1 xor (take 16 ys), drop 16 ys) int2Hex :: Int -> [Char] int2Hex xs | length ys == 2 = ys | otherwise = '0':ys where ys = showHex xs "" denseHash :: [Int] -> [Char] denseHash xs = mconcat $ fmap (int2Hex . fst) $ take 16 $ drop 1 $ iterate stepHash (0, xs) solve2 :: [Char] solve2 = knotHash input knotHash :: [Char] -> [Char] knotHash xs = denseHash $ sparseHash $ (ord <$> xs) ++ [17, 31, 73, 47, 23] input = "120,93,0,90,5,80,129,74,1,165,204,255,254,2,50,113"