Browse Source

Day18: Backup 3

master
Arranun 2 years ago
parent
commit
98034f4f76
  1. BIN
      day18
  2. 143
      day18.hs

BIN
day18

Binary file not shown.

143
day18.hs

@ -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

Loading…
Cancel
Save