Browse Source

Rewrote to have better overview, at the moment get quickly first with needed length

master
Arranun 2 years ago
parent
commit
9e3aeb2d92
  1. 178
      day18rw.hs

178
day18rw.hs

@ -0,0 +1,178 @@
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 connections = concat $ [(getConnections mapIn a b) | a <-"@abcdefghijklmnop", b <- "@abcdefghijklmnop", a /= b]
let state = State ['@'] 0 '@'
let result = part1 [state] connections
mapM putStrLn(map show connections)
mapM putStrLn(map show result)
data Connection =Connection { key1 :: Char,
key2 :: Char,
l :: Int,
block :: [Char]
} deriving (Show, Eq)
data Robot = Robot{ brain :: [[Char]]
,points :: [((Int,Int),Int)]
,position :: (Int,Int)
,direction :: Int
} deriving Show
data State = State { elements :: [Char],
len :: Int,
pos :: Char
} deriving (Show,Eq)
part1 :: [State] -> [Connection] -> [State]
part1 states conns
|length (filter(\(State elm _ _) -> (length elm) >= 17) (Trace.traceShowId((states)))) >= 1 =
states
|otherwise = do
let choose = chooseNext states
let newStates = runState choose conns
let nextStates = newStates:(states)
part1 nextStates conns
chooseNext :: [State] -> State
chooseNext states = do
let possible = filter(\(State elm len pos) -> (length elm) < 17) states
last ( sortBy sortElm possible )
sortLen :: State -> State -> Ordering
sortLen (State e1 l1 p1) (State e2 l2 p2)
| l1 > l2 = GT
| l1 < l2 = LT
| l1 == l2 = EQ
sortElm :: State -> State -> Ordering
sortElm (State e1 l1 _) (State e2 l2 _)
| length (e1) > length (e2) = GT
| length (e1) < length (e2) = LT
| l1 > l2 = GT
| l1 < l2 = LT
| otherwise = EQ
runState :: State -> [Connection] -> State
runState (State elm len pos) conns
| length possible == 0 = (State elm len pos)
| length possible == 1 = do
let c = head possible
stepState (State elm len pos) c
| otherwise = do
let choose = head (sortBy sortConn possible)
-- let newStates = map(\c -> stepState (State elm len pos) c) possible
stepState (State elm len pos) choose
where possible'' = filter(\(Connection k1 k2 l b) -> length ( b \\ notBlocked) == 0 )possible'''
possible = filter(\(Connection k1 k2 l b) -> notElem k2 elm) possible''
possible''' = filter(\(Connection k1 k2 l b) -> k1 == pos) conns
notBlocked = concat $ map(\x -> (toUpper x):[x]) elm
sortConn :: Connection -> Connection -> Ordering
sortConn (Connection _ _ l1 _) (Connection _ _ l2 _)
| l1 < l2 = LT
| l1 > l2 = LT
| l1 == l2 = EQ
stepState :: State -> Connection -> State
stepState (State elm len pos) (Connection _ k2 l b) = do
(State (k2:elm) (len + l) k2)
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) (delete goal (blocks pth))) gPkPair
blocks xs = map(\(_,c) -> (chr c)) $ filter(\(_,c) -> between 65 c 90 || between 97 c 122) 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
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 )
between :: Int -> Int -> Int -> Bool
between x y z
|x <= y = y <= z
|otherwise = False
Loading…
Cancel
Save