adventofcode1617/app/advent17.hs

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