1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
-- Author: Yuchen Pei (me@ypei.me)
import Puzzle10 (knotHash)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (catMaybes)
-- import Data.Char (digit2Int)
hex2Bin '0' = "0000"
hex2Bin '1' = "0001"
hex2Bin '2' = "0010"
hex2Bin '3' = "0011"
hex2Bin '4' = "0100"
hex2Bin '5' = "0101"
hex2Bin '6' = "0110"
hex2Bin '7' = "0111"
hex2Bin '8' = "1000"
hex2Bin '9' = "1001"
hex2Bin 'a' = "1010"
hex2Bin 'b' = "1011"
hex2Bin 'c' = "1100"
hex2Bin 'd' = "1101"
hex2Bin 'e' = "1110"
hex2Bin 'f' = "1111"
matrix :: [Char] -> [[Char]]
matrix xs = (mconcat . (fmap hex2Bin) . knotHash . (\x -> xs ++ "-" ++ (show x))) <$> [0 .. 127]
solve1 :: [Char] -> Int
solve1 = length . (filter (=='1')) . mconcat . matrix
i2B :: Char -> Bool
i2B '0' = False
i2B '1' = True
truthMat :: [Char] -> [[Bool]]
truthMat = fmap (fmap i2B) . matrix
mat2Map :: [[a]] -> Map (Int, Int) a
mat2Map xs = Map.fromList $ mconcat $ fmap f $ zipWith (,) [0 .. length xs - 1] xs
where f (x, ys) = zipWith (,) ((\y -> (x,y)) <$> [0 .. length ys]) ys
step :: (Int, [(Int, Int)], Map (Int, Int) Bool) -> Int
step (n, queue, mat)
| null mat = n
| null queue = let (z, b) = head $ Map.toList mat in
if b then step (n + 1, [z], Map.delete z mat)
else step (n, [], Map.delete z mat)
| otherwise = step (n, catMaybes (zipWith f nbhd $ flip Map.lookup mat <$> nbhd) ++ zs, Map.delete (x, y) mat)
where (x, y):zs = queue
nbhd = [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]
f :: (Int, Int) -> Maybe Bool -> Maybe (Int, Int)
f x (Just True) = Just x
f x _ = Nothing
solve2 :: [Char] -> Int
solve2 xs = step (0, [], mat2Map $ truthMat xs)
|
