Day 21 done
[advent-of-code-16.git] / advent17.hs
1 import Data.ByteString.Char8 (pack)
2 import qualified Crypto.Hash as C
3
4 type Position = (Int, Int)
5 data Agendum = Agendum {position :: Position, path :: String, hash :: String} deriving (Show, Eq)
6 type Agenda = [Agendum]
7
8 -- input = "hijkl"
9 -- input = "ihgpwlah"
10
11 input = "qljzarfv" -- my input
12
13 main :: IO ()
14 main = do
15 part1
16 part2
17
18 part1 :: IO ()
19 part1 = print $ path $ extractJust $ bfs initialAgenda
20
21 part2 :: IO ()
22 part2 = print $ bfs2 initialAgenda 0
23
24 initialAgenda :: Agenda
25 initialAgenda = [Agendum {position=(1, 1), path="", hash=(getHash "")}]
26
27 getHash :: String -> String
28 getHash path = show (C.hash $ pack (input ++ path) :: C.Digest C.MD5)
29
30 extractJust :: Maybe Agendum -> Agendum
31 extractJust Nothing = head initialAgenda
32 extractJust (Just x) = x
33
34 bfs :: Agenda -> Maybe Agendum
35 bfs [] = Nothing
36 bfs (current:agenda) =
37 if isGoal current then Just current
38 else bfs (agenda ++ (successors current))
39
40 bfs2 :: Agenda -> Int -> Int
41 bfs2 [] l = l
42 bfs2 (current:agenda) l =
43 if isGoal current then bfs2 agenda (length $ path $ current)
44 else bfs2 (agenda ++ (successors current)) l
45
46 isGoal :: Agendum -> Bool
47 isGoal agendum = (position agendum) == (4, 4)
48
49 isLegalPos :: Position -> Bool
50 isLegalPos p = fst p >= 1 && fst p <= 4 && snd p >= 1 && snd p <= 4
51
52 successors :: Agendum -> Agenda
53 successors state = [Agendum {position = step p0 ld,
54 path = path0 ++ [ld],
55 hash = getHash (path0 ++ [ld])} | ld <- legalDoors ]
56 where
57 p0 = position state
58 path0 = path state
59 h0 = hash state
60 doors = openDoors h0
61 legalDoors = filter (isLegalPos . (step p0)) doors
62
63 openDoors :: String -> String
64 openDoors h = up ++ down ++ left ++ right
65 where
66 up = if h!!0 `elem` "bcdef" then "U" else ""
67 down = if h!!1 `elem` "bcdef" then "D" else ""
68 left = if h!!2 `elem` "bcdef" then "L" else ""
69 right = if h!!3 `elem` "bcdef" then "R" else ""
70
71 step :: Position -> Char -> Position
72 step (r, c) 'U' = (r-1, c)
73 step (r, c) 'D' = (r+1, c)
74 step (r, c) 'L' = (r, c-1)
75 step (r, c) 'R' = (r, c+1)