day 10 solution 2

app/Main.hs

@@ -103,3 +103,5 @@ day10 = do
   putText "Day 10:"
   let sol1 = Day10.solution1 Day10.input
   showSol "Solution 1" (int sol1)
+  input2 <- Day10.parseInput2
+  showSol "Solution 2" (text (toS (Day10.solution2 input2)))

inputs/day10.txt

@@ -0,0 +1 @@
+187,254,0,81,169,219,1,190,19,102,255,56,46,32,2,216

src/Day10.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-|
 description:
 
@@ -141,8 +142,12 @@ module Day10 where
 
 import           Protolude
 
+import           Data.Char       (chr, ord)
+import           Data.List       (foldl1')
 import qualified Data.Map.Strict as Map
+import           Numeric         (showHex)
 import           Text.Parsec
+import qualified Data.Text as T
 
 testInput :: AppState
 testInput = mkAppState 5 [3,4,1,5]
@@ -153,11 +158,11 @@ input = mkAppState 256 [187,254,0,81,169,219,1,190,19,102,255,56,46,32,2,216]
 mkAppState :: Int -> [Int] -> AppState
 mkAppState n ls = AppState [0..(n-1)] n ls 0 0
 
-data AppState = AppState { lst :: [Int]
-                         , lstSize :: Int
-                         , lenghts :: [Int]
+data AppState = AppState { lst      :: [Int]
+                         , lstSize  :: Int
+                         , lengths  :: [Int]
                          , position :: Int
-                         , skip :: Int
+                         , skip     :: Int
                          } deriving (Show)
 
 oneStep :: AppState -> AppState
@@ -180,6 +185,45 @@ merge lst1 lst2 lst1Size lst2Size n =
 
 solution1 :: AppState -> Int
 solution1 appState =
-  if null (lenghts appState)
+  if null (lengths appState)
      then lst appState & take 2 & foldl' (*) 1
      else solution1 (oneStep appState)
+
+
+parseInput2 :: IO Text
+parseInput2 = T.strip <$> readFile "inputs/day10.txt"
+
+strToLengths :: Text -> [Int]
+strToLengths = (++ [17,31,73,47,23]) . map ord . toS
+
+oneRound :: AppState -> AppState
+oneRound appState =
+  if null (lengths appState)
+     then appState
+     else oneRound (oneStep appState)
+
+testInput2 :: Text
+testInput2 = "1,2,3"
+
+manyRounds :: AppState -> Int -> [Int] -> AppState
+manyRounds appState 0 _ = appState
+manyRounds appState nbRounds ls =
+  manyRounds (oneRound (appState { lengths = ls })) (nbRounds - 1) ls
+
+chunksOf :: Int -> [a] -> [[a]]
+chunksOf n [] = []
+chunksOf n l  = take n l:chunksOf n (drop n l)
+
+solution2 :: Text -> [Char]
+solution2 input =
+  let ls = strToLengths input
+      initAppState = mkAppState 256 ls
+      finalAppState = manyRounds initAppState 64 ls
+      sparseHash :: [Word8]
+      sparseHash = lst finalAppState & map fromIntegral
+      denseHash = map (foldl1' xor) (chunksOf 16 sparseHash)
+  in concatMap toHex denseHash
+
+toHex :: Word8 -> [Char]
+toHex n = let s = n `showHex` "" in
+  if length s < 2 then '0':s else s

test/Spec.hs

@@ -84,5 +84,13 @@ main = defaultMain $
   , testGroup "Day 10"
     [ testCase "example 1" $
         Day10.solution1 Day10.testInput @?= 12
+    , testCase "solution 2 empty" $
+        Day10.solution2 "" @?= "a2582a3a0e66e6e86e3812dcb672a272"
+    , testCase "solution 2 AoC 2017" $
+        Day10.solution2 "AoC 2017" @?= "33efeb34ea91902bb2f59c9920caa6cd"
+    , testCase "solution 2 1,2,3" $
+        Day10.solution2 "1,2,3" @?= "3efbe78a8d82f29979031a4aa0b16a9d"
+    , testCase "solution 2 1,2,4" $
+        Day10.solution2 "1,2,4" @?= "63960835bcdc130f0b66d7ff4f6a5a8e"
     ]
   ]