|
|
|
@ -8,13 +8,13 @@ import Data.Maybe |
|
|
|
|
|
|
|
|
|
main = do |
|
|
|
|
mapIn <- lines <$> getContents |
|
|
|
|
--let brain = Amplifier software 0 0 [] [0] |
|
|
|
|
--let robot = Robot mapIn [((5,1),64)] (5,1) 1 |
|
|
|
|
--let resultRobots = (runRobot robot ) |
|
|
|
|
--let reachablePoints = getNextKey resultRobots |
|
|
|
|
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 result = getAllKeys mapIn (15,1) [] |
|
|
|
|
--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 |
|
|
|
@ -25,7 +25,8 @@ main = do |
|
|
|
|
--putStrLn(show winRobotsLength) |
|
|
|
|
--putStrLn(show $ List.maximum( part2Length)) |
|
|
|
|
mapM putStrLn(map show mapIn) |
|
|
|
|
putStrLn(show result) |
|
|
|
|
mapM putStrLn(map show connections) |
|
|
|
|
putStrLn(show result) |
|
|
|
|
|
|
|
|
|
--putStrLn(printKey nextKey) |
|
|
|
|
--mapM putStrLn(map show resultRobots) |
|
|
|
@ -41,19 +42,101 @@ data Key = Key { id :: Int, |
|
|
|
|
way :: Int |
|
|
|
|
} deriving (Show, Eq) |
|
|
|
|
|
|
|
|
|
getAllKeys :: [[Char]] -> (Int,Int) -> [Key] -> [[Key]] |
|
|
|
|
getAllKeys mapIn (a,b) keys = do |
|
|
|
|
let robot = Robot (Trace.traceShowId(mapIn)) [((a,b),64)] (a,b) 1 |
|
|
|
|
let resultRobots = (runRobot robot ) |
|
|
|
|
let reachablKeys = (Trace.traceShowId(getNextKey (resultRobots))) |
|
|
|
|
if length reachablKeys /= 0 |
|
|
|
|
then do |
|
|
|
|
let nextKey = head (sortBy sortLength reachablKeys) |
|
|
|
|
let newMap = openGate mapIn (Trace.traceShowId(nextKey)) |
|
|
|
|
let newKeys = nextKey:keys |
|
|
|
|
getAllKeys newMap (pos nextKey) newKeys |
|
|
|
|
else keys |
|
|
|
|
|
|
|
|
|
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) |
|
|
|
@ -80,25 +163,27 @@ getNextKey robots = nub minPts |
|
|
|
|
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 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
runRobot :: Robot -> [Robot] |
|
|
|
|
runRobot robot |
|
|
|
|
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 |
|
|
|
|
runRobot newRobot |
|
|
|
|
let newRobot = stepRobot robot ( move!!0 ) goal |
|
|
|
|
runRobot newRobot goal |
|
|
|
|
| otherwise = do |
|
|
|
|
let newRobots = map(\mv -> stepRobot robot mv) move |
|
|
|
|
foldl (++) [] $ map(\robot -> runRobot robot) newRobots |
|
|
|
|
let newRobots = map(\mv -> stepRobot robot mv goal) move |
|
|
|
|
foldl (++) [] $ map(\robot -> runRobot robot goal) newRobots |
|
|
|
|
where move = getNextMove robot |
|
|
|
|
|
|
|
|
|
stepRobot :: Robot -> Int -> Robot |
|
|
|
|
stepRobot (Robot brain points position direction) newDirection = do |
|
|
|
|
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 || between 65 statusResponse 90 || between 97 statusResponse 122 |
|
|
|
|
if statusResponse == 35 || statusResponse == goal |
|
|
|
|
then Robot brain newPoints position newDirection |
|
|
|
|
else Robot brain newPoints newPos newDirection |
|
|
|
|
|
|
|
|
|