42cd15f2c24ca07570df285045b35368821776ed
[advent-of-code-16.git] / adventofcode16 / app / advent23.hs
1 module Main(main) where
2
3 import Text.Parsec hiding (State)
4 import Text.ParserCombinators.Parsec.Number
5 import Control.Monad.State.Lazy
6 -- import Debug.Trace
7
8 data Location = Literal Int | Register Char deriving (Show, Eq)
9 data Instruction = Cpy Location Location
10 | Inc Location
11 | Dec Location
12 | Jnz Location Location
13 | Tgl Location
14 deriving (Show, Eq)
15
16 data Machine = Machine { a :: Int
17 , b :: Int
18 , c :: Int
19 , d :: Int
20 , pc :: Int
21 , instructions :: [Instruction]}
22 deriving (Show, Eq)
23
24
25 testInstructions = "cpy 2 a\n\
26 \tgl a\n\
27 \tgl a\n\
28 \tgl a\n\
29 \cpy 1 a\n\
30 \dec a\n\
31 \dec a"
32
33
34 emptyMachine :: Machine
35 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
36
37 main :: IO ()
38 main = do
39 text <- readFile "data/advent23.txt"
40 let instructions = successfulParse $ parseIfile text
41 part1 instructions
42 part2 instructions
43
44
45 part1 :: [Instruction] -> IO ()
46 part1 instrs =
47 do let m0 = emptyMachine {instructions=instrs, a = 7}
48 let mf = snd $ runState runMachine m0
49 print (a mf)
50
51 part2 :: [Instruction] -> IO ()
52 part2 instrs =
53 do let m0 = emptyMachine {instructions=instrs, a = 12}
54 let mf = snd $ runState runMachine m0
55 print (a mf)
56
57
58 runMachine :: State Machine ()
59 runMachine =
60 do m <- get
61 if (pc m) >= (length $ instructions m)
62 then return ()
63 else do executeStep
64 runMachine
65
66 executeStep :: State Machine ()
67 executeStep =
68 do m <- get
69 let i = (instructions m)!!(pc m)
70 put (executeInstructionPeep i m)
71 -- put (executeInstruction i m)
72
73 executeInstructionPeep :: Instruction -> Machine -> Machine
74 executeInstructionPeep i m =
75 if sample1 == sample1Target
76 -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
77 then m1
78 else if sample2 == sample2Target
79 -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
80 then m2
81 else executeInstruction i m
82 where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m
83 sample1Target = [ Cpy (Literal 0) (Register 'a')
84 , Cpy (Register 'b') (Register 'c')
85 , Inc (Register 'a')
86 , Dec (Register 'c')
87 , Jnz (Register 'c') (Literal (-2))
88 , Dec (Register 'd')
89 , Jnz (Register 'd') (Literal (-5)) ]
90 m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
91 sample2 = take (length sample2Target) $ drop (pc m) $ instructions m
92 sample2Target = [ Dec (Register 'b')
93 , Cpy (Register 'b') (Register 'c')
94 , Cpy (Register 'c') (Register 'd')
95 , Dec (Register 'd')
96 , Inc (Register 'c')
97 , Jnz (Register 'd') (Literal (-2)) ]
98 m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
99
100
101 executeInstruction :: Instruction -> Machine -> Machine
102 executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
103 where pc1 = (pc m) + 1
104 v = evaluate m r
105 m' = writeValue m r (v+1)
106 executeInstruction (Inc (Literal _)) m = m {pc=pc1}
107 where pc1 = (pc m) + 1
108 executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
109 where pc1 = (pc m) + 1
110 v = evaluate m r
111 m' = writeValue m r (v-1)
112 executeInstruction (Dec (Literal _)) m = m {pc=pc1}
113 where pc1 = (pc m) + 1
114 executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
115 where pc1 = (pc m) + 1
116 v = evaluate m s
117 m' = writeValue m d v
118 executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
119 where pc1 = (pc m) + 1
120 executeInstruction (Jnz s d) m
121 | v == 0 = m {pc=pc1}
122 | otherwise = m {pc=pcj}
123 where pc1 = (pc m) + 1
124 ed = evaluate m d
125 pcj = (pc m) + ed
126 v = evaluate m s
127 executeInstruction (Tgl a) m
128 | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
129 pc=pc1}
130 | otherwise = m {pc=pc1}
131 where pc1 = pc m + 1
132 v = evaluate m a + pc m
133 i = (instructions m)!!v
134 i' = case i of
135 Inc x -> Dec x
136 Dec x -> Inc x
137 Tgl x -> Inc x
138 Cpy x y -> Jnz x y
139 Jnz x y -> Cpy x y
140 replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
141
142
143 evaluate :: Machine -> Location -> Int
144 evaluate _ (Literal i) = i
145 evaluate m (Register r) =
146 case r of
147 'a' -> (a m)
148 'b' -> (b m)
149 'c' -> (c m)
150 'd' -> (d m)
151
152 writeValue :: Machine -> Location -> Int -> Machine
153 writeValue m (Literal i) _ = m
154 writeValue m (Register r) v =
155 case r of
156 'a' -> m {a=v}
157 'b' -> m {b=v}
158 'c' -> m {c=v}
159 'd' -> m {d=v}
160
161
162 instructionFile = instructionLine `sepEndBy` newline
163 -- instructionLine = choice [cpyL, incL, decL, jnzL]
164 instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
165
166 -- incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
167 -- where incify r = Inc (Register r)
168 incL = (Inc . Register) <$> (string "inc" *> spaces *> (oneOf "abcd"))
169 -- decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
170 -- where decify r = Dec (Register r)
171 decL = (Dec . Register) <$> (string "dec" *> spaces *> (oneOf "abcd"))
172 cpyL = cpyify <$> (string "cpy" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
173 <*> (spaces *> (oneOf "abcd"))
174 where cpyify s r = Cpy s (Register r)
175 jnzL = jnzify <$> (string "jnz" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
176 <*> (spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
177 where jnzify r o = Jnz r o
178 tglL = Tgl <$> (string "tgl" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
179 -- where tglify r = Tgl r
180
181
182 -- readLocation :: Int -> Location
183 -- readLocation l = Literal l
184
185 -- readLocation :: String -> Location
186 -- readLocation l
187 -- | all (isDigit) l = Literal (read l)
188 -- | otherwise = Register (head l)
189
190 parseIfile :: String -> Either ParseError [Instruction]
191 parseIfile input = parse instructionFile "(unknown)" input
192
193 parseIline :: String -> Either ParseError Instruction
194 parseIline input = parse instructionLine "(unknown)" input
195
196 successfulParse :: Either ParseError [a] -> [a]
197 successfulParse (Left _) = []
198 successfulParse (Right a) = a