adventofcode1614/app/advent14parallel.hs

   1 module Main(main) where
   2
   3 import Data.List (nub, tails)
   4 import Data.ByteString.Char8 (pack)
   5 import Crypto.Hash (hash, Digest, MD5)
   6 import Control.Parallel.Strategies (withStrategy, parBuffer, rdeepseq)
   7
   8 salt = "yjdafjpo"
   9 -- salt = "abc"
  10
  11 stretch_factor = [1..2016]
  12 -- stretch_factor = [1..100]
  13
  14 main :: IO ()
  15 main = do
  16         part1
  17         part2
  18
  19 part1 :: IO ()
  20 part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
  21     where sq = md5sequence
  22
  23 part2 :: IO ()
  24 part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
  25     where sq = md5sequenceS
  26
  27 getHash :: String -> String
  28 getHash bs = show (hash $ pack bs :: Digest MD5)
  29
  30 md5sequence :: [String]
  31 -- md5sequence = [makeMd5 i | i <- [0..]]
  32 md5sequence = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
  33     where makeMd5 i = getHash (salt ++ show i)
  34
  35 md5sequenceS :: [String]
  36 -- md5sequenceS = [makeMd5 i | i <- [0..]]
  37 md5sequenceS = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
  38     where makeMd5 i = stretch $ getHash (salt ++ show i)
  39           stretch h0 = foldr (\_ h -> getHash h) h0 stretch_factor
  40
  41 possibleKey :: [String] -> Int-> Bool
  42 possibleKey s = not . null . repeats 3 . ((!!) s)
  43
  44 confirmKey :: [String] -> Int -> Bool
  45 confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
  46     where c = head $ repeats 3 $ s!!i
  47           confirmation m = c `elem` (repeats 5 m)
  48
  49 repeats :: Int -> String -> [String]
  50 repeats n = filter (null . tail) . map (nub) . substrings n
  51
  52 substrings :: Int -> [a] -> [[a]]
  53 substrings l = filter (\s -> (length s) == l) . map (take l) . tails