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)] (0,0) 0 let result = runRobot robot let endPoints = points result let pointsNoColor = map(\(x,y) -> x) endPoints let unique = nub pointsNoColor let mapPoint = createMap endPoints (reverse [-7..1]) [] mapM putStrLn( map show mapPoint) 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 ++ [(Trace.traceShowId(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 brain points position direction) = do let currentpoint = filter(\(p,c)-> p == position) $ points let input =( if length currentpoint == 0 then 0 else snd $ head currentpoint) let newBrain = (step brain [(input)]) if (output newBrain) == [] then Robot brain points position direction else do let outColor = (output (newBrain))!!0 let outMove = (output newBrain)!!1 let newPoints = ( (points \\ currentpoint) ++ [(position,outColor)]) let newDirection = changeDirection direction outMove let newPos = move position newDirection runRobot (Robot newBrain newPoints newPos newDirection) stepRobot :: Robot -> Robot stepRobot (Robot brain points position direction) = do let currentpoint = filter(\(p,c)-> p == position) $ points let input = if length currentpoint == 0 then 0 else snd $ head currentpoint let newBrain = step brain [input] let outColor = (output newBrain)!!0 let outMove = (output newBrain)!!1 let newPoints = (points) ++ [(position,outColor)] let newDirection = changeDirection direction outMove let newPos = move position newDirection Robot newBrain newPoints newPos newDirection move :: (Int,Int) -> Int -> (Int,Int) move (x,y) direction | direction == 0 = (x,y+1) | direction == 1 = (x+1,y) | direction == 2 = (x,y-1) | direction == 3 = (x-1,y) changeDirection :: Int -> Int -> Int changeDirection direction input | input == 0 = changeDirection' direction (-1) | input == 1 = changeDirection' direction 1 changeDirection' :: Int -> Int -> Int changeDirection' direction change | direction + change < 0 = 3 | otherwise = mod (direction + change) 4 getList :: String -> [Int] getList = map Prelude.read . splitOn "," link :: Amplifier -> Amplifier -> Amplifier link left calc | null (output left) = Amplifier (state calc) (-1) (base calc) (input calc) (output calc) | index left == -1 = Amplifier (state calc) (-1) (base calc) (input calc) (output calc) | otherwise = step calc ([last $ output left]) 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