193 lines
7.0 KiB
Haskell
193 lines
7.0 KiB
Haskell
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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|