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 = incL <|> decL <|> cpyL <|> jnzL <|> tglL
 164
 165 incL = Inc <$> (string "inc" *> spaces *> register)
 166 decL = Dec <$> (string "dec" *> spaces *> register)
 167 cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
 168 jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
 169 tglL = Tgl <$> (string "tgl" *> spaces *> location)
 170
 171 location = (Literal <$> int) <|> register
 172 register = Register <$> (oneOf "abcd")
 173
 174 parseIfile :: String -> Either ParseError [Instruction]
 175 parseIfile input = parse instructionFile "(unknown)" input
 176
 177 parseIline :: String -> Either ParseError Instruction
 178 parseIline input = parse instructionLine "(unknown)" input
 179
 180 successfulParse :: Either ParseError [a] -> [a]
 181 successfulParse (Left _) = []
 182 successfulParse (Right a) = a