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.

228 lines
9.5 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)] (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