advent02/src/advent02.hs

   1 -- Some code taken from [AoC 2017 day 5](https://adventofcode.com/2017/day/5),
   2 --    and some from [AoC 2018 day 21](https://adventofcode.com/2018/day/21)
   3
   4 import Data.Text (Text)
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Void (Void)
   8
   9 import Text.Megaparsec hiding (State)
  10 import Text.Megaparsec.Char
  11 import qualified Text.Megaparsec.Char.Lexer as L
  12 import qualified Control.Applicative as CA
  13
  14 import Control.Monad (unless)
  15 import Control.Monad.State.Strict
  16
  17 import qualified Data.IntMap.Strict as M
  18 import Data.IntMap.Strict ((!))
  19
  20 type Memory = M.IntMap Int
  21
  22 data Machine = Machine { _memory :: Memory
  23                        , _ip :: Int
  24                        }
  25                deriving (Show, Eq)
  26
  27 type ProgrammedMachine = State Machine ()
  28
  29
  30 main :: IO ()
  31 main = do
  32         text <- TIO.readFile "data/advent02.txt"
  33         let mem = successfulParse text
  34         let machine = makeMachine mem
  35         print $ part1 machine
  36         print $ part2 machine
  37
  38
  39 -- part1 machine = (_memory $ execState runAll machine1202)!0
  40 --     where machine1202 = machine { _memory = M.insert 1 12 $ M.insert 2 2 $ _memory machine }
  41
  42
  43 part1 = nounVerbResult 12 2
  44
  45 part2Target = 19690720
  46
  47 part2 machine = noun * 100 + verb
  48     where (noun, verb) = head $ [(n, v) | n <- [0..99], v <- [0..99],
  49                                           nounVerbResult n v machine == part2Target ]
  50
  51
  52 makeMachine :: [Int] -> Machine
  53 makeMachine memory = Machine {_ip = 0, _memory = M.fromList $ zip [0..] memory}
  54
  55 nounVerbResult :: Int -> Int -> Machine -> Int
  56 nounVerbResult noun verb machine = machineOutput nvMachine
  57     where nvMachine0 = machineNounVerb machine noun verb
  58           nvMachine = execState runAll nvMachine0
  59
  60 machineNounVerb :: Machine -> Int -> Int -> Machine
  61 machineNounVerb machine noun verb = machine { _memory = M.insert 1 noun $ M.insert 2 verb $ _memory machine }
  62
  63 machineOutput :: Machine -> Int
  64 machineOutput machine = (_memory machine)!0
  65
  66
  67 runAll :: ProgrammedMachine
  68 runAll = do m0 <- get
  69             unless (lkup (_ip m0) (_memory m0) == 99)
  70                 do runStep
  71                    runAll
  72
  73 runStep :: ProgrammedMachine
  74 runStep =
  75     do m0 <- get
  76        let mem = _memory m0
  77        let ip = _ip m0
  78        let (mem', ip') = perform (mem!ip) ip mem
  79        put m0 {_ip = ip', _memory = mem'}
  80
  81 perform :: Int -> Int -> Memory -> (Memory, Int)
  82 perform 1 ip mem = (iInsert (ip + 3) (a + b) mem, ip + 4)
  83     where a = mem!>(ip + 1)
  84           b = mem!>(ip + 2)
  85 perform 2 ip mem = (iInsert (ip + 3) (a * b) mem, ip + 4)
  86     where a = mem!>(ip + 1)
  87           b = mem!>(ip + 2)
  88
  89
  90 -- Some IntMap utility functions, for syntactic sugar
  91
  92 -- prefix version of (!)
  93 lkup k m = m!k
  94
  95 -- indirect lookup
  96 (!>) m k = m!(m!k)
  97
  98 -- indirect insert
  99 iInsert k v m = M.insert (m!k) v m
 100
 101
 102
 103 -- Parse the input file
 104 type Parser = Parsec Void Text
 105
 106 sc :: Parser ()
 107 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 108 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 109
 110 lexeme  = L.lexeme sc
 111 integer = lexeme L.decimal
 112 -- signedInteger = L.signed sc integer
 113 symb = L.symbol sc
 114 comma = symb ","
 115
 116 memoryP = integer `sepBy` comma
 117
 118 successfulParse :: Text -> [Int]
 119 successfulParse input =
 120         case parse memoryP "input" input of
 121                 Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 122                 Right memory -> memory