From 9e3aeb2d92c187324c227a375f12618525b4473b Mon Sep 17 00:00:00 2001 From: Arranun Date: Fri, 20 Dec 2019 00:56:22 +0100 Subject: [PATCH] Rewrote to have better overview, at the moment get quickly first with needed length --- day18rw.hs | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) create mode 100644 day18rw.hs diff --git a/day18rw.hs b/day18rw.hs new file mode 100644 index 0000000..f588782 --- /dev/null +++ b/day18rw.hs @@ -0,0 +1,178 @@ +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 + mapM putStrLn(map show connections) + mapM putStrLn(map 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] -> [Connection] -> [State] +part1 states conns + |length (filter(\(State elm _ _) -> (length elm) >= 17) (Trace.traceShowId((states)))) >= 1 = + states + |otherwise = do + let choose = chooseNext states + let newStates = runState choose conns + let nextStates = newStates:(states) + part1 nextStates conns + +chooseNext :: [State] -> State +chooseNext states = do + let possible = filter(\(State elm len pos) -> (length elm) < 17) states + 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 -> [Connection] -> State +runState (State elm len pos) conns + | 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 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 + +sortConn :: Connection -> Connection -> Ordering +sortConn (Connection _ _ l1 _) (Connection _ _ l2 _) + | l1 < l2 = LT + | l1 > l2 = LT + | 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 + + + + + + + + + + + +