import Data.List.Split import Data.List.Unique import Data.Char as Char import Data.List as List import Data.Either as Either import Debug.Trace as Trace import Data.Maybe main = do mapIn <- lines <$> getContents let connections = concat $ [(getConnections mapIn a b) | a <-"@abcdefghijklmnop", b <- "@abcdefghijklmnop", a /= b] let state = State ['@'] 0 '@' let result = part1 [state] [] connections 999 mapM putStrLn(map show connections) putStrLn(show result) data Connection =Connection { key1 :: Char, key2 :: Char, l :: Int, block :: [Char] } deriving (Show, Eq) data Robot = Robot{ brain :: [[Char]] ,points :: [((Int,Int),Int)] ,position :: (Int,Int) ,direction :: Int } deriving Show data State = State { elements :: [Char], len :: Int, pos :: Char } deriving (Show,Eq) part1 :: [State] -> [State] -> [Connection] -> Int -> Int part1 states deadStates conns minimum |length finished > 3 = min |otherwise = do let choose = chooseNext (filtered)(min) let newStates = runState (choose) deadStates conns min if (newStates) == choose then do let newDeadStates = newStates:deadStates part1 states newDeadStates conns min else do let nextStates = newStates:(states) part1 nextStates deadStates conns min where finished = (filter(\(State elm _ _) -> (length elm) >= 17) (states)) min = if length finished > 0 then List.minimum (map(\(State _ l _) -> l) finished) else minimum filtered = states \\ deadStates chooseNext :: [State] -> Int -> State chooseNext states min = do let possible' = filter(\(State elm len pos) -> (length elm) < 17) states let possible = filter(\(State elm len pos) -> len < min) possible' last ( sortBy sortElm (possible)) sortLen :: State -> State -> Ordering sortLen (State e1 l1 p1) (State e2 l2 p2) | l1 > l2 = GT | l1 < l2 = LT | l1 == l2 = EQ sortElm :: State -> State -> Ordering sortElm (State e1 l1 _) (State e2 l2 _) | length (e1) > length (e2) = GT | length (e1) < length (e2) = LT | l1 > l2 = GT | l1 < l2 = LT | otherwise = EQ runState :: State -> [State] -> [Connection] -> Int -> State runState (State elm len pos) deadStates conns min | length possible == 0 = (State elm len pos) | length possible == 1 = do let c = head possible stepState (State elm len pos) c | otherwise = do let choose = head (sortBy sortConn possible) -- let newStates = map(\c -> stepState (State elm len pos) c) possible stepState (State elm len pos) choose where possible''' = filter(\(Connection k1 k2 l b) -> length ( b \\ notBlocked) == 0 )possible'''' possible'' = filter(\(Connection _ _ l _) -> len + l < min) possible''' possible' = filter(\(Connection k1 k2 l b) -> notElem k2 (deadPath)) possible'' possible = filter(\(Connection k1 k2 l b) -> notElem k2 elm) possible' possible'''' = filter(\(Connection k1 k2 l b) -> k1 == pos) conns notBlocked = concat $ map(\x -> (toUpper x):[x]) elm dead = filter(\(State el _ _) -> (tail el) == elm) deadStates deadPath = map(\(State el _ _) -> head el) dead sortConn :: Connection -> Connection -> Ordering sortConn (Connection _ _ l1 _) (Connection _ _ l2 _) | l1 < l2 = LT | l1 > l2 = GT | l1 == l2 = EQ stepState :: State -> Connection -> State stepState (State elm len pos) (Connection _ k2 l b) = do (State (k2:elm) (len + l) k2) getCoordinate :: [[Char]] -> Char -> (Int,Int) getCoordinate mapIn id = do let yAxis = head $ filter(\y -> elem id y) mapIn let yAxisV = fromJust $ elemIndex yAxis mapIn let xAxisV = fromJust $ elemIndex id yAxis (xAxisV,yAxisV) getConnections :: [[Char]] -> Char -> Char -> [Connection] getConnections mapIn id goal = conn where robot = Robot (mapIn) [((a,b),64)] (a,b) 1 resultRobots = (runRobot robot (ord goal)) conn = (getConnection (resultRobots) id goal) (a,b) = getCoordinate mapIn id getConnection :: [Robot] -> Char -> Char -> [Connection] getConnection robots startKey goal = conn where paths = map (\(Robot brain points position direction) -> points) robots pkPair = map(\ps -> ((snd (last ps)),ps)) paths gPkPair = filter(\(k,pth) -> (chr k) == goal ) pkPair conn = map(\(k,pth) -> Connection startKey (chr k) (length pth) (delete goal (blocks pth))) gPkPair blocks xs = map(\(_,c) -> (chr c)) $ filter(\(_,c) -> between 65 c 90 || between 97 c 122) xs runRobot :: Robot -> Int -> [Robot] runRobot robot goal | (length move) == 0 = [robot] | (length move) == 1 = do let newRobot = stepRobot robot ( move!!0 ) goal runRobot newRobot goal | otherwise = do let newRobots = map(\mv -> stepRobot robot mv goal) move foldl (++) [] $ map(\robot -> runRobot robot goal) newRobots where move = getNextMove robot stepRobot :: Robot -> Int -> Int -> Robot stepRobot (Robot brain points position direction) newDirection goal = do let newPos = move position newDirection let statusResponse = ord ((brain!! (snd newPos))!! (fst newPos)) let newPoints = (points) ++ [(newPos, statusResponse)] if statusResponse == 35 || statusResponse == goal then Robot brain newPoints position newDirection else Robot brain newPoints newPos newDirection move :: (Int,Int) -> Int -> (Int,Int) move (x,y) direction | direction == 1 = (x,y-1) | direction == 2 = (x+1,y) | direction == 3 = (x,y+1) | direction == 4 = (x-1,y) getNextMove :: Robot -> [Int] getNextMove (Robot brain points position direction) |length points > 0 && (snd $ last points) == 2 = [] |otherwise = do filterMoves (Robot brain points position direction) [1,2,3,4] filterMoves :: Robot -> [Int] -> [Int] filterMoves robot moves = filter(\x -> checkVisit robot x && checkWall robot x) moves checkVisit :: Robot -> Int -> Bool checkVisit (Robot brain points position direction) mv = do let newPos = move position mv let visits = map(\(pos,c) -> pos) points notElem newPos visits checkWall :: Robot -> Int -> Bool checkWall (Robot brain points position direction) mv = do let newPos = (move position mv) let mvResult = ( ord ((brain!! (snd newPos))!! (fst newPos))) not (mvResult == 35 ) between :: Int -> Int -> Int -> Bool between x y z |x <= y = y <= z |otherwise = False