f19c046dfc916293dc26d12436bb748044585215
[advent-of-code-16.git] / adventofcode1625 / app / advent25.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
7 -- import Control.Monad.Writer
8 import Control.Monad.Reader
9 import Debug.Trace
10
11 data Location = Literal Int | Register Char deriving (Show, Eq)
12 data Instruction = Cpy Location Location
13 | Inc Location
14 | Dec Location
15 | Jnz Location Location
16 | Tgl Location
17 | Out Location
18 deriving (Show, Eq)
19
20 data Machine = Machine { a :: Int
21 , b :: Int
22 , c :: Int
23 , d :: Int
24 , pc :: Int
25 , instructions :: [Instruction]
26 , execCount :: Int
27 }
28 deriving (Show, Eq)
29
30 data AppConfig = AppConfig { cfgMaxRun :: Int } deriving (Show)
31
32
33 type App = ReaderT AppConfig (State Machine) String
34
35
36 testInstructions1 = "\
37 \cpy 5 d\n\
38 \cpy 7 c\n\
39 \cpy 362 b\n\
40 \inc d\n\
41 \dec b\n\
42 \jnz b -2\n\
43 \dec c\n\
44 \jnz c -5\n\
45 \out d"
46
47 testInstructions2 = "jnz 1 0"
48
49 target :: String
50 target = cycle "01"
51
52 emptyMachine :: Machine
53 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[], execCount=0}
54
55 main :: IO ()
56 main = do
57 text <- readFile "data/advent25.txt"
58 -- let text = testInstructions1
59 let instructions = successfulParse $ parseIfile text
60 part1 instructions
61
62
63 part1 :: [Instruction] -> IO ()
64 part1 instrs =
65 print $ head validInputs
66 where m0 = emptyMachine {instructions=instrs}
67 inputs = [0..]
68 validInputs = filter (validMachine) inputs
69 validMachine i = valid $ evalMachine m0 i
70
71
72 valid :: String -> Bool
73 valid output = all (\p -> fst p == snd p) $ zip target output
74
75 evalMachine :: Machine -> Int -> String
76 evalMachine machine0 input = evalState (runReaderT (runMachine "") config) m
77 where m = machine0 {a = input}
78 config = AppConfig {cfgMaxRun = 500000}
79
80 runMachine :: String -> App
81 runMachine output =
82 do cfg <- ask
83 m <- get
84 if (pc m) >= (length $ instructions m) || execCount m > cfgMaxRun cfg
85 then return output
86 else do thisOutput <- executeStep
87 runMachine (output ++ thisOutput)
88
89
90 executeStep :: App
91 executeStep =
92 do m <- get
93 let i = (instructions m)!!(pc m)
94 let output = generateOutput i m
95 put (executeInstructionPeep i m) {execCount = (execCount m) + 1}
96 -- put (executeInstruction i m) {execCount = (execCount m) + 1}
97 return output
98
99 generateOutput :: Instruction -> Machine -> String
100 generateOutput (Out a) m = show $ evaluate m a
101 generateOutput _ _ = ""
102
103 executeInstructionPeep :: Instruction -> Machine -> Machine
104 executeInstructionPeep i m =
105 if sample == sampleTarget
106 -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
107 then m1
108 else executeInstruction i m
109 where sample = take (length sampleTarget) $ drop (pc m) $ instructions m
110 sampleTarget = [ Inc (Register 'd')
111 , Dec (Register 'b')
112 , Jnz (Register 'b') (Literal (-2))
113 , Dec (Register 'c')
114 , Jnz (Register 'c') (Literal (-5)) ]
115 m1 = m {d = d m + c m * b m, c = 0, b = 0, pc = pc m + (length sample)}
116
117
118 executeInstruction :: Instruction -> Machine -> Machine
119 executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
120 where pc1 = (pc m) + 1
121 v = evaluate m r
122 m' = writeValue m r (v+1)
123 executeInstruction (Inc (Literal _)) m = m {pc=pc1}
124 where pc1 = (pc m) + 1
125 executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
126 where pc1 = (pc m) + 1
127 v = evaluate m r
128 m' = writeValue m r (v-1)
129 executeInstruction (Dec (Literal _)) m = m {pc=pc1}
130 where pc1 = (pc m) + 1
131 executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
132 where pc1 = (pc m) + 1
133 v = evaluate m s
134 m' = writeValue m d v
135 executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
136 where pc1 = (pc m) + 1
137 executeInstruction (Jnz s d) m
138 | v == 0 = m {pc=pc1}
139 | otherwise = m {pc=pcj}
140 where pc1 = (pc m) + 1
141 ed = evaluate m d
142 pcj = (pc m) + ed
143 v = evaluate m s
144 executeInstruction (Tgl a) m
145 | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
146 pc=pc1}
147 | otherwise = m {pc=pc1}
148 where pc1 = pc m + 1
149 v = evaluate m a + pc m
150 i = (instructions m)!!v
151 i' = case i of
152 Inc x -> Dec x
153 Dec x -> Inc x
154 Tgl x -> Inc x
155 Cpy x y -> Jnz x y
156 Jnz x y -> Cpy x y
157 replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
158 executeInstruction (Out _) m = m {pc = pc m + 1}
159
160
161 evaluate :: Machine -> Location -> Int
162 evaluate _ (Literal i) = i
163 evaluate m (Register r) =
164 case r of
165 'a' -> (a m)
166 'b' -> (b m)
167 'c' -> (c m)
168 'd' -> (d m)
169
170 writeValue :: Machine -> Location -> Int -> Machine
171 writeValue m (Literal i) _ = m
172 writeValue m (Register r) v =
173 case r of
174 'a' -> m {a=v}
175 'b' -> m {b=v}
176 'c' -> m {c=v}
177 'd' -> m {d=v}
178
179
180 instructionFile = instructionLine `sepEndBy` newline
181 instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL <|> outL
182
183 incL = Inc <$> (string "inc" *> spaces *> register)
184 decL = Dec <$> (string "dec" *> spaces *> register)
185 cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
186 jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
187 tglL = Tgl <$> (string "tgl" *> spaces *> location)
188 outL = Out <$> (string "out" *> spaces *> location)
189
190 location = (Literal <$> int) <|> register
191 register = Register <$> (oneOf "abcd")
192
193 parseIfile :: String -> Either ParseError [Instruction]
194 parseIfile input = parse instructionFile "(unknown)" input
195
196 parseIline :: String -> Either ParseError Instruction
197 parseIline input = parse instructionLine "(unknown)" input
198
199 successfulParse :: Either ParseError [a] -> [a]
200 successfulParse (Left _) = []
201 successfulParse (Right a) = a