You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

192 lines
7.0 KiB

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