Please don’t rely on this Gitea instance being around forever. If any of your build scripts use my (kageru’s) projects hosted here, check my Github or IEW on Github for encoding projects. If you can’t find what you’re looking for there, tell me to migrate it.

Day18: Backup 3

master
Arranun 3 years ago
parent a5cda9b104
commit 98034f4f76

BIN
day18

Binary file not shown.

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