AoC2019/day18rw.hs

179 lines
6.1 KiB
Haskell
Raw Normal View History

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