You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

224 lines
9.2 KiB

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