X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=adventofcode16%2Fapp%2Fadvent14parallel.hs;fp=adventofcode16%2Fapp%2Fadvent14parallel.hs;h=b0ca781465fb09e639959c426b7da30dc832a08a;hb=7267c0fa74db510564dc59587dd076372640114f;hp=0000000000000000000000000000000000000000;hpb=b66f0f79e01057fcb153ac16ce13ff50943a6d02;p=advent-of-code-16.git

diff --git a/adventofcode16/app/advent14parallel.hs b/adventofcode16/app/advent14parallel.hs
new file mode 100644
index 0000000..b0ca781
--- /dev/null
+++ b/adventofcode16/app/advent14parallel.hs
@@ -0,0 +1,53 @@
+module Main(main) where
+
+import Data.List (nub, tails)
+import Data.ByteString.Char8 (pack)
+import Crypto.Hash (hash, Digest, MD5)
+import Control.Parallel.Strategies (withStrategy, parBuffer, rdeepseq)
+
+salt = "yjdafjpo"
+-- salt = "abc"
+
+stretch_factor = [1..2016]
+-- stretch_factor = [1..100]
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequence
+
+part2 :: IO ()
+part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequenceS
+
+getHash :: String -> String
+getHash bs = show (hash $ pack bs :: Digest MD5)
+
+md5sequence :: [String]
+-- md5sequence = [makeMd5 i | i <- [0..]]
+md5sequence = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
+    where makeMd5 i = getHash (salt ++ show i)
+
+md5sequenceS :: [String]
+-- md5sequenceS = [makeMd5 i | i <- [0..]]
+md5sequenceS = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
+    where makeMd5 i = stretch $ getHash (salt ++ show i)
+          stretch h0 = foldr (\_ h -> getHash h) h0 stretch_factor
+
+possibleKey :: [String] -> Int-> Bool
+possibleKey s = not . null . repeats 3 . ((!!) s)
+
+confirmKey :: [String] -> Int -> Bool
+confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
+    where c = head $ repeats 3 $ s!!i
+          confirmation m = c `elem` (repeats 5 m)
+                              
+repeats :: Int -> String -> [String]
+repeats n = filter (null . tail) . map (nub) . substrings n
+
+substrings :: Int -> [a] -> [[a]]
+substrings l = filter (\s -> (length s) == l) . map (take l) . tails