Day18: Backup 3

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