AoC2019/day18rw.hs

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 999
     mapM putStrLn(map show connections)
     putStrLn(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] -> [State] -> [Connection] -> Int -> Int
part1 states deadStates conns  minimum
       |length finished > 3 =
	       min
       |otherwise = do
            let choose = chooseNext (filtered)(min)
            let newStates = runState (choose) deadStates conns min
            if (newStates) == choose 
	       then do
		       let newDeadStates = newStates:deadStates
                       part1 states newDeadStates conns min
               else do
                       let nextStates = newStates:(states)
                       part1 nextStates deadStates conns min
       where finished = (filter(\(State elm _ _) -> (length elm) >= 17) (states))
	     min = if length finished > 0
	                then List.minimum (map(\(State _ l _) -> l) finished)
                        else minimum
             filtered = states \\ deadStates
chooseNext :: [State] -> Int -> State
chooseNext states  min = do
	let possible' = filter(\(State elm len pos) -> (length elm) < 17) states
        let possible = filter(\(State elm len pos) -> len < min) possible'
        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 -> [State] -> [Connection] -> Int -> State
runState (State elm len pos) deadStates conns min
        | 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 _ _ l _) -> len + l < min) possible'''
              possible' = filter(\(Connection k1 k2 l b) -> notElem k2 (deadPath))  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
              dead = filter(\(State el _ _) -> (tail el) == elm) deadStates	      
              deadPath = map(\(State el _ _) -> head el) dead

sortConn :: Connection -> Connection -> Ordering
sortConn (Connection _ _ l1 _) (Connection _ _ l2 _)
       | l1 < l2 = LT
       | l1 > l2 = GT
       | 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