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 robot = Robot mapIn [((5,1),64)] (5,1) 1 let resultRobots = (runRobot robot ) let connections = concat $ [(getConnections mapIn a b) | a <-"@abcdefghijklmnop", b <- "@abcdefghijklmnop", a /= b] let state = StatePath connections '@' [] let result = getPath2 [state] --let nextKey = head (sortBy sortLength reachablePoints) --let newMap = openGate mapIn nextKey --let aRobotLength = List.minimum( map (length . points) $ aRobots) --let aRobotWin = filter(\(Robot brain points position direction) -> length points == aRobotLength) aRobots --let winRobots = filter(\(Robot br pts pos dir) -> elem 2 (map(\(p,c) -> c) pts))resultRobots --let winRobotsLength = map(\(Robot br pts pos dir) -> length (filter(\(p,c) -> c == 1)pts))winRobots --let winRobot = (map(\(Robot br pts pos dir) -> Robot br [] pos 1) winRobots) !! 0 --let part2Robots = (runRobot winRobot) --let part2Length = map(\(Robot br pts pos dir) -> length (filter(\(p,c) -> c == 1)pts))part2Robots --putStrLn(show winRobotsLength) --putStrLn(show $ List.maximum( part2Length)) mapM putStrLn(map show mapIn) mapM putStrLn(map show connections) putStrLn(show result) --putStrLn(printKey nextKey) --mapM putStrLn(map show resultRobots) data Robot = Robot{ brain:: [[Char]] ,points:: [((Int,Int),Int)] ,position:: (Int,Int) ,direction :: Int } deriving Show data Key = Key { id :: Int, pos :: (Int,Int), way :: Int } deriving (Show, Eq) data State = State { m :: [[Char]], posi :: (Int,Int), keys :: [Key] } deriving Show data StatePath = StatePath { connection :: [Connection], p :: Char, path :: [(Char,Int)] } deriving (Show, Eq) data Connection =Connection { key1 :: Char, key2 :: Char, l :: Int, block :: [Char] } deriving (Show, Eq) getPath2 :: [StatePath] -> Int getPath2 states = do let choose = (sortBy sortL( filter(\state -> getLength state < (min)) possible)) if null choose then min else do let newChoose = (getPath (head choose) min) getPath2 ((delete (head choose) states) ++ (newChoose)) where min = if length completed /= 0 then List.minimum( map(getLength) completed) else 999 completed = filter(\state -> length (path state) == 16) states possible = states \\ completed longest =List.maximum $ map(\state -> length (path state)) states sortL :: StatePath -> StatePath -> Ordering sortL s1 s2 | length (path s1) > length (path s2) = LT | length (path s1) < length (path s2) = GT | getLength s1 < getLength s2 = LT | getLength s1 > getLength s2 = GT | otherwise = EQ getPath :: StatePath -> Int -> [StatePath] getPath(StatePath conn id path) minIn |length path >= 16 = [ (StatePath conn id path) ] |length possible == 1 = do let c = head possible let newState = stepPath (StatePath conn id path) c if getLength newState > minIn then [newState] else getPath newState minIn |otherwise = do let newStates = map(\c -> stepPath (StatePath conn id path) c) possible newStates where possible = filter(\(Connection k1 k2 _ bs) -> k1 == id && length bs == 0) conn stepPath :: StatePath -> Connection -> StatePath stepPath (StatePath conn id path) c = do let newConn' = map(\(Connection k1 k2 l b) -> (Connection k1 k2 l (delete (toUpper (key2 c)) b))) conn let newConn = filter(\(Connection k1 k2 l b) -> (k1 /= (key1 c)) && (k2 /= (key1 c)) ) newConn' let newId = key2 c let newPath = (newId, l c):path StatePath ( newConn ) newId newPath 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) (blocks pth)) gPkPair blocks xs = map(\(_,c) -> (chr c)) $ filter(\(_,c) -> between 65 c 90) xs getLength :: StatePath -> Int getLength (StatePath _ _ path) = do let keyL = map(\(_,a) -> a - 1) path sum (keyL) stepKey :: State -> Key -> State stepKey (State mapIn (a,b) keys) nextKey = do let newMap = openGate mapIn (nextKey) let newKeys = nextKey:keys State newMap (pos nextKey) newKeys sortLength :: Key -> Key -> Ordering sortLength (Key _ _ way1) (Key _ _ way2) | way1 == way2 = EQ | way1 < way2 = LT | way1 > way2 = GT openGate :: [[Char]] -> Key -> [[Char]] openGate mapIn (Key id (a,b) _) = result where result' = map( map(\c -> if c==(chr id) then '.' else c)) mapIn result = map( map(\c -> if c==(chr (id-32)) then '.' else c)) result' printKey :: Key -> [Char] printKey (Key id pos way) = (show id)++" :"++(show pos)++(show way) getBrain :: Robot -> [[Char]] getBrain (Robot brain points poisition direction) = brain getNextKey :: [Robot] -> [Key] getNextKey robots = nub minPts where kPts = map(\(Robot brain points position direction) ->(Key (snd(last points)) (fst(last points)) (length points))) robots minPts = map(\(Key id pos way) ->(Key id pos (min id))) keyWPr min x = List.minimum $ map(\(Key id pos way) -> way) $ filter(\(Key id pos way) -> id == x) keyWPr keys = filter(\(Key id pos way) -> id /= 46 && id /= 64 && between 97 id 122) kPts keyWPr = keys min :: [Int] -> Int min xs = foldr1 (\x y -> if x < y then x else y) 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 between :: Int -> Int -> Int -> Bool between x y z |x <= y = y <= z |otherwise = False 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 ) getList :: String -> [Int] getList = map Prelude.read . splitOn ","