Got Stack working with days in separate packages
[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 testInstructions = "cpy 2 a\n\
25 \tgl a\n\
26 \tgl a\n\
27 \tgl a\n\
28 \cpy 1 a\n\
29 \dec a\n\
30 \dec a"
31
32 emptyMachine :: Machine
33 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
34
35 main :: IO ()
36 main = do
37 text <- readFile "data/advent23.txt"
38 let instructions = successfulParse $ parseIfile text
39 part1 instructions
40 part2 instructions
41
42
43 part1 :: [Instruction] -> IO ()
44 part1 instrs =
45 do let m0 = emptyMachine {instructions=instrs, a = 7}
46 let mf = snd $ runState runMachine m0
47 print (a mf)
48
49 part2 :: [Instruction] -> IO ()
50 part2 instrs =
51 do let m0 = emptyMachine {instructions=instrs, a = 12}
52 let mf = snd $ runState runMachine m0
53 print (a mf)
54
55
56 runMachine :: State Machine ()
57 runMachine =
58 do m <- get
59 if (pc m) >= (length $ instructions m)
60 then return ()
61 else do executeStep
62 runMachine
63
64 executeStep :: State Machine ()
65 executeStep =
66 do m <- get
67 let i = (instructions m)!!(pc m)
68 put (executeInstructionPeep i m)
69 -- put (executeInstruction i m)
70
71 executeInstructionPeep :: Instruction -> Machine -> Machine
72 executeInstructionPeep i m =
73 if sample1 == sample1Target
74 -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
75 then m1
76 else if sample2 == sample2Target
77 -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
78 then m2
79 else executeInstruction i m
80 where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m
81 sample1Target = [ Cpy (Literal 0) (Register 'a')
82 , Cpy (Register 'b') (Register 'c')
83 , Inc (Register 'a')
84 , Dec (Register 'c')
85 , Jnz (Register 'c') (Literal (-2))
86 , Dec (Register 'd')
87 , Jnz (Register 'd') (Literal (-5)) ]
88 m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
89 sample2 = take (length sample2Target) $ drop (pc m) $ instructions m
90 sample2Target = [ Dec (Register 'b')
91 , Cpy (Register 'b') (Register 'c')
92 , Cpy (Register 'c') (Register 'd')
93 , Dec (Register 'd')
94 , Inc (Register 'c')
95 , Jnz (Register 'd') (Literal (-2)) ]
96 m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
97
98
99 executeInstruction :: Instruction -> Machine -> Machine
100 executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
101 where pc1 = (pc m) + 1
102 v = evaluate m r
103 m' = writeValue m r (v+1)
104 executeInstruction (Inc (Literal _)) m = m {pc=pc1}
105 where pc1 = (pc m) + 1
106 executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
107 where pc1 = (pc m) + 1
108 v = evaluate m r
109 m' = writeValue m r (v-1)
110 executeInstruction (Dec (Literal _)) m = m {pc=pc1}
111 where pc1 = (pc m) + 1
112 executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
113 where pc1 = (pc m) + 1
114 v = evaluate m s
115 m' = writeValue m d v
116 executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
117 where pc1 = (pc m) + 1
118 executeInstruction (Jnz s d) m
119 | v == 0 = m {pc=pc1}
120 | otherwise = m {pc=pcj}
121 where pc1 = (pc m) + 1
122 ed = evaluate m d
123 pcj = (pc m) + ed
124 v = evaluate m s
125 executeInstruction (Tgl a) m
126 | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
127 pc=pc1}
128 | otherwise = m {pc=pc1}
129 where pc1 = pc m + 1
130 v = evaluate m a + pc m
131 i = (instructions m)!!v
132 i' = case i of
133 Inc x -> Dec x
134 Dec x -> Inc x
135 Tgl x -> Inc x
136 Cpy x y -> Jnz x y
137 Jnz x y -> Cpy x y
138 replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
139
140
141 evaluate :: Machine -> Location -> Int
142 evaluate _ (Literal i) = i
143 evaluate m (Register r) =
144 case r of
145 'a' -> (a m)
146 'b' -> (b m)
147 'c' -> (c m)
148 'd' -> (d m)
149
150 writeValue :: Machine -> Location -> Int -> Machine
151 writeValue m (Literal i) _ = m
152 writeValue m (Register r) v =
153 case r of
154 'a' -> m {a=v}
155 'b' -> m {b=v}
156 'c' -> m {c=v}
157 'd' -> m {d=v}
158
159
160 instructionFile = instructionLine `sepEndBy` newline
161 instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
162
163 incL = Inc <$> (string "inc" *> spaces *> register)
164 decL = Dec <$> (string "dec" *> spaces *> register)
165 cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
166 jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
167 tglL = Tgl <$> (string "tgl" *> spaces *> location)
168
169 location = (Literal <$> int) <|> register
170 register = Register <$> (oneOf "abcd")
171
172 parseIfile :: String -> Either ParseError [Instruction]
173 parseIfile input = parse instructionFile "(unknown)" input
174
175 parseIline :: String -> Either ParseError Instruction
176 parseIline input = parse instructionLine "(unknown)" input
177
178 successfulParse :: Either ParseError [a] -> [a]
179 successfulParse (Left _) = []
180 successfulParse (Right a) = a