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)