aboutsummaryrefslogtreecommitdiff
path: root/Puzzle14.hs
blob: c904d4ae2b37ae5b73cce47b4046d42c45067b00 (plain) (blame)
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
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)