import Data.List.Split import Data.Char as Char import Data.List as List import Data.Either as Either import Debug.Trace as Trace main = do software <- getList <$> getContents let brain = Amplifier software 0 0 [] [0] let robot = Robot brain [] (0,0) 1 let resultRobots = (runRobot robot ) let winRobots = filter(\(Robot br pts pos dir) -> elem 2 (map(\(p,c) -> c) pts))resultRobots let winRobotsLength = map(\(Robot br pts pos dir) -> length (filter(\(p,c) -> c == 1)pts))winRobots let winRobot = (map(\(Robot br pts pos dir) -> Robot br [] pos 1) winRobots) !! 0 let part2Robots = (runRobot winRobot) let part2Length = map(\(Robot br pts pos dir) -> length (filter(\(p,c) -> c == 1)pts))part2Robots putStrLn(show winRobotsLength) putStrLn(show $ List.maximum( part2Length)) data Amplifier = Amplifier{ state :: [Int] ,index :: Int ,base :: Int ,input :: [Int] ,output :: [Int] } deriving Show data Robot = Robot{ brain:: Amplifier ,points:: [((Int,Int),Int)] ,position:: (Int,Int) ,direction :: Int } deriving Show getBrain :: Robot -> Amplifier getBrain (Robot brain points poisition direction) = brain createMap ::[((Int,Int),Int)]-> [Int] -> [[Int]] -> [[Int]] createMap points (y:ys) output |length ys > 0 = do let fPoints = filter(\((a,b),c) -> b ==y ) points let row = foldl createRow [] fPoints let newoutput = output ++ [(row)] createMap points ys newoutput |otherwise = output createRow :: [Int] -> ((Int,Int),Int) -> [Int] createRow row ((a,b),c) = Main.insert row c a runRobot :: Robot -> [Robot] runRobot robot | (length move) == 0 = [robot] | (length move) == 1 = do let newRobot = stepRobot robot $ move!!0 runRobot newRobot | otherwise = do let newRobots = map(\mv -> stepRobot robot mv) move foldl (++) [] $ map(\robot -> runRobot robot) newRobots where move = getNextMove robot stepRobot :: Robot -> Int -> Robot stepRobot (Robot brain points position direction) newDirection = do let newBrain = step brain [newDirection] let statusResponse = head(output newBrain) let newPos = move position newDirection let newPoints = (points) ++ [(newPos,statusResponse)] if statusResponse == 0 || statusResponse == 2 then Robot newBrain newPoints position newDirection else Robot newBrain newPoints newPos newDirection move :: (Int,Int) -> Int -> (Int,Int) move (x,y) direction | direction == 1 = (x,y+1) | direction == 4 = (x+1,y) | direction == 2 = (x,y-1) | direction == 3 = (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 mvResult = head $ output (step brain [mv]) mvResult /= 0 getList :: String -> [Int] getList = map Prelude.read . splitOn "," step :: Amplifier -> [Int] -> Amplifier step amp input = operation (drop (index amp) (state amp)) (state amp) (index amp) (base amp) input [] operation :: [Int] -> [Int] -> Int -> Int -> [Int] -> [Int] -> Amplifier operation (99:_) state i base input output = Amplifier state i base input [] operation (op:xs) state i base input output | last (digits op) == 1 = do let newindex = i + 4 let newstate = add (fillup (revertdigs op) 5) (xs!!0) (xs!!1) (xs!!2) base state operation ((drop newindex newstate)) (newstate) newindex base input output | last (digits op) == 2 = do let newindex = i + 4 let newstate = mult (fillup (revertdigs op) 5) (xs!!0) (xs!!1) (xs!!2) base state operation ((drop newindex newstate)) (newstate) newindex base input output | last (digits op) == 3 = do if (length input) == 0 then (Amplifier state i base input output) else do let newindex = i + 2 let newstate = put (fillup (revertdigs op) 3) (xs!!0) (head input) base state let newinput = drop 1 input operation (drop newindex newstate) (newstate) newindex base newinput output | last (digits op) == 4 = do let newindex = i + 2 let newoutput = out (fillup (revertdigs op) 3) output (xs!!0) base state let newinput = drop 1 input operation ((drop newindex state)) (state) newindex base input (newoutput) | (last (digits op) == 5 ) = do let newindex = jumpif (fillup (revertdigs op) 4) (xs!!0) (xs!!1) i base state operation ((drop newindex state)) (state) newindex base input output | (last (digits op) == 6 ) = do let newindex = jumpifnot (fillup (revertdigs op) 4) (xs!!0) (xs!!1) i base state operation ((drop newindex state)) (state) newindex base input output | (last (digits op) == 7 ) = do let newindex = i + 4 let newstate = lessthan (fillup (revertdigs op) 5) (xs!!0) (xs!!1) (xs!!2) base state operation ((drop newindex newstate)) (newstate) newindex base input output | (last (digits op) == 8 ) = do let newindex = i + 4 let newstate = equal (fillup (revertdigs op) 5) (xs!!0) (xs!!1) (xs!!2) base state operation ((drop newindex newstate)) (newstate) newindex base input output | (last (digits op) == 9 ) = do let newindex = i + 2 let fullop = (fillup (revertdigs op) 3) let newbase = base + (getValue (fullop!!2) (xs!!0) base state) (operation ((drop newindex state)) (state) newindex newbase input output) add :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> [Int] add (op1:op2:m1:m2:m3:_) p1 p2 p3 base state = Main.insert state sum (getIndex m3 p3 base) where sum = (getValue m1 p1 base state) + (getValue m2 p2 base state) mult :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> [Int] mult (op1:op2:m1:m2:m3:_) p1 p2 p3 base state = Main.insert state sum (getIndex m3 p3 base) where sum = (getValue m1 p1 base state) * (getValue m2 p2 base state) put :: [Int] -> Int -> Int -> Int -> [Int] -> [Int] put(op1:op2:m1:_) p1 input base state = Main.insert state input (getIndex m1 p1 base) out :: [Int] -> [Int] -> Int -> Int -> [Int] -> [Int] out (op1:op2:m1:_) output p1 base state = output ++ [(getValue m1 p1 base state)] jumpif :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> Int jumpif (op1:op2:m1:m2:_) p1 p2 index base state | (getValue m1 p1 base state) /= 0 = getValue m2 p2 base state | otherwise = index + 3 jumpifnot :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> Int jumpifnot (op1:op2:m1:m2:_) p1 p2 index base state | (getValue m1 p1 base state) == 0 = getValue m2 p2 base state | otherwise = index + 3 lessthan :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> [Int] lessthan (op1:op2:m1:m2:m3:_) p1 p2 p3 base state | (getValue m1 p1 base state) < (getValue m2 p2 base state) = Main.insert state 1 (getIndex m3 p3 base) | otherwise = Main.insert state 0 (getIndex m3 p3 base) equal :: [Int] -> Int -> Int -> Int -> Int -> [Int] -> [Int] equal (op1:op2:m1:m2:m3:_) p1 p2 p3 base state | (getValue m1 p1 base state ) == (getValue m2 p2 base state ) = Main.insert state 1 (getIndex m3 p3 base) | otherwise = Main.insert state 0 (getIndex m3 p3 base) insert :: [Int] -> Int -> Int -> [Int] insert xs value index | index < length xs = do let split = splitAt index xs (fst split)++ [value] ++ (drop 1 (snd split)) | otherwise = do let longState = xs ++ (replicate (index - length xs) 0) let split = splitAt index longState (fst split)++ [value] ++ (drop 1 (snd split)) read :: [Int] -> Int -> Int read xs index | index < length xs = xs!!index | otherwise = 0 digits :: Int -> [Int] digits = map Char.digitToInt . show revertdigs :: Int -> [Int] revertdigs 0 = [] revertdigs x = x `mod` 10 : revertdigs (x `div` 10) fillup :: [Int] -> Int -> [Int] fillup array x = array ++ (replicate (x - (length array)) 0) getValue :: Int -> Int -> Int -> [Int] -> Int getValue 0 p base array = Main.read array p getValue 1 p base array = p getValue 2 p base array = Main.read array (base + p) getIndex :: Int -> Int -> Int -> Int getIndex m p base | m == 0 = p | m == 2 = p + base