import Data.List.Split import Data.Char as Char import Data.List as List import qualified Data.Map.Strict as M import Linear.V2 import Control.Monad main = do software <- getList <$> getContents let arcade = Amplifier software 0 0 [] [] let arcadeStep1 = step arcade [] let step1Result = parseOutput M.empty (output arcadeStep1) let blocks =length $ M.filter(==2) step1Result let result = runGame arcade M.empty --let gameMap = createMap result [0..23] [] let score = M.filterWithKey(\(V2 a b) _ -> a == -1 ) result --mapM putStrLn( map (map getSymbol) gameMap) --putStrLn(show score) putStrLn(show result) putStrLn "Finished" data Amplifier = Amplifier{ state :: [Int] ,index :: Int ,base :: Int ,input :: [Int] ,output :: [Int] } deriving Show runGame :: Amplifier -> M.Map (V2 Int) Int -> M.Map (V2 Int) Int runGame arcade gameM= do let newArcade = step arcade [0] let tiles = ((parseOutput M.empty (output newArcade))) let newGameM = M.union tiles gameM let blocks = length $ M.filter(== 2) newGameM if blocks == 0 then tiles else runGame newArcade newGameM parseOutput :: M.Map (V2 Int) Int -> [Int] -> M.Map (V2 Int) Int parseOutput tiles (x:y:c:xs) | length xs == 0 = M.insert (V2 x y) c tiles | length xs > 0 = parseOutput newtiles xs where newtiles = M.insert (V2 x y) c tiles createMap :: M.Map (V2 Int) Int -> [Int] -> [[Int]] -> [[Int]] createMap points (y:ys) output |length ys > 0 = do let fPoints = M.filterWithKey(\(V2 a b) _ -> b ==y ) points let row = M.foldlWithKey createRow [] fPoints let newoutput = output ++ [(row)] createMap points ys newoutput |otherwise = output createRow :: [Int] -> V2 Int -> Int -> [Int] createRow row (V2 a b) c = Main.insert row c a getSymbol :: Int -> Char getSymbol 0 = ' ' getSymbol 1 = '|' getSymbol 2 = '#' getSymbol 3 = '=' getSymbol 4 = '*' 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 output 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