Rewrote to have better overview, at the moment get quickly first with needed length
This commit is contained in:
parent
98034f4f76
commit
9e3aeb2d92
|
|
@ -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…
Reference in New Issue
Block a user