adventofcode1623/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