2019-12-18 14:27:33 +01:00
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
2019-12-19 02:13:46 +01:00
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 ]
2019-12-18 14:27:33 +01:00
--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 )
2019-12-19 02:13:46 +01:00
mapM putStrLn ( map show connections )
putStrLn ( show result )
2019-12-18 14:27:33 +01:00
--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 )
2019-12-19 02:13:46 +01:00
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
2019-12-18 14:27:33 +01:00
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
2019-12-19 02:13:46 +01:00
min :: [ Int ] -> Int
min xs = foldr1 ( \ x y -> if x < y then x else y ) xs
runRobot :: Robot -> Int -> [ Robot ]
runRobot robot goal
2019-12-18 14:27:33 +01:00
| ( length move ) == 0 = [ robot ]
| ( length move ) == 1 = do
2019-12-19 02:13:46 +01:00
let newRobot = stepRobot robot ( move !! 0 ) goal
runRobot newRobot goal
2019-12-18 14:27:33 +01:00
| otherwise = do
2019-12-19 02:13:46 +01:00
let newRobots = map ( \ mv -> stepRobot robot mv goal ) move
foldl ( ++ ) [] $ map ( \ robot -> runRobot robot goal ) newRobots
2019-12-18 14:27:33 +01:00
where move = getNextMove robot
2019-12-19 02:13:46 +01:00
stepRobot :: Robot -> Int -> Int -> Robot
stepRobot ( Robot brain points position direction ) newDirection goal = do
2019-12-18 14:27:33 +01:00
let newPos = move position newDirection
let statusResponse = ord ( ( brain !! ( snd newPos ) ) !! ( fst newPos ) )
let newPoints = ( points ) ++ [ ( newPos , statusResponse ) ]
2019-12-19 02:13:46 +01:00
if statusResponse == 35 || statusResponse == goal
2019-12-18 14:27:33 +01:00
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 " , "