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.

225 lines
9.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 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]
--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)
mapM putStrLn(map show connections)
putStrLn(show result)
--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)
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
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
min :: [Int] -> Int
min xs = foldr1 (\x y -> if x < y then x else y) 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
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 ","