From b49c764d8c3bb8b44562f53edb166b8e828bcb5e Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Fri, 6 Dec 2019 08:22:13 +0000 Subject: [PATCH] Done day 5 --- advent05/package.yaml | 61 ++++++++++++ advent05/src/advent05.hs | 202 +++++++++++++++++++++++++++++++++++++++ data/advent05.txt | 1 + stack.yaml | 1 + 4 files changed, 265 insertions(+) create mode 100644 advent05/package.yaml create mode 100644 advent05/src/advent05.hs create mode 100644 data/advent05.txt diff --git a/advent05/package.yaml b/advent05/package.yaml new file mode 100644 index 0000000..1d04271 --- /dev/null +++ b/advent05/package.yaml @@ -0,0 +1,61 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent05 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +- OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent05: + main: advent05.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - megaparsec + - containers + - mtl diff --git a/advent05/src/advent05.hs b/advent05/src/advent05.hs new file mode 100644 index 0000000..752b8ed --- /dev/null +++ b/advent05/src/advent05.hs @@ -0,0 +1,202 @@ +import Debug.Trace + +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec hiding (State) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +import Control.Monad (unless) +import Control.Monad.State.Strict +import Control.Monad.Reader +import Control.Monad.Writer + +import qualified Data.IntMap.Strict as M +import Data.IntMap.Strict ((!)) +import Data.List + +type Memory = M.IntMap Int + +data Machine = Machine { _memory :: Memory + , _ip :: Int + , _inputIndex :: Int + } + deriving (Show, Eq) + +type ProgrammedMachine = WriterT [Int] (ReaderT ([Int]) (State Machine)) () + +data ParameterMode = Position | Immediate deriving (Ord, Eq, Show) + + +main :: IO () +main = do + text <- TIO.readFile "data/advent05.txt" + let mem = successfulParse text + -- let machine = makeMachine mem + print $ findMachineOutput [1] mem + print $ findMachineOutput [5] mem + -- print $ part2 machine + + +-- part1 machine = (_memory $ execState runAll machine1202)!0 +-- where machine1202 = machine { _memory = M.insert 1 12 $ M.insert 2 2 $ _memory machine } + + +findMachineOutput inputs program = output -- last output + where finalStack = + runState ( + runReaderT ( + runWriterT runAll + ) + inputs + ) + (makeMachine program) + ((_retval, output), _machine) = finalStack + + +-- part1 = nounVerbResult 12 2 + +-- part2Target = 19690720 + +-- part2 machine = noun * 100 + verb +-- where (noun, verb) = head $ [(n, v) | n <- [0..99], v <- [0..99], +-- nounVerbResult n v machine == part2Target ] + + +makeMachine :: [Int] -> Machine +makeMachine memory = Machine {_ip = 0, _inputIndex = 0 + , _memory = M.fromList $ zip [0..] memory + } + +-- nounVerbResult :: Int -> Int -> Machine -> Int +-- nounVerbResult noun verb machine = machineOutput nvMachine +-- where nvMachine0 = machineNounVerb machine noun verb +-- nvMachine = execState runAll nvMachine0 + +-- machineNounVerb :: Machine -> Int -> Int -> Machine +-- machineNounVerb machine noun verb = machine { _memory = M.insert 1 noun $ M.insert 2 verb $ _memory machine } + +-- machineOutput :: Machine -> Int +-- machineOutput machine = (_memory machine)!0 + + +runAll :: ProgrammedMachine +runAll = do mem <- gets _memory + ip <- gets _ip + unless (mem!ip == 99) + do runStep + runAll + +runStep :: ProgrammedMachine +runStep = + do mem <- gets _memory + ip <- gets _ip + let opcode = (mem!ip) `mod` 100 + let modes = parameterModes ((mem!ip) `div` 100) + fetchInput opcode + putOutput opcode modes + mem' <- gets _memory + let (mem'', ip') = perform opcode ip modes mem' + modify (\m -> m {_ip = ip', _memory = mem''}) + + +-- fetchInput opcode | trace ("Input with opcode " ++ show opcode) False = undefined +fetchInput 3 = + do mem <- gets _memory + ip <- gets _ip + inputIndex <- gets _inputIndex + inputs <- ask + let mem' = iInsert (ip + 1) (inputs!!inputIndex) mem + modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'}) +fetchInput _ = return () + + +-- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined +putOutput 4 modes = + do mem <- gets _memory + ip <- gets _ip + let v = getMemoryValue (ip + 1) (modes!!0) mem + tell [v] +putOutput _ _ = return () + + +perform :: Int -> Int -> [ParameterMode] -> Memory -> (Memory, Int) +-- perform instr ip modes mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined +perform 1 ip modes mem = (iInsert (ip + 3) (a + b) mem, ip + 4) + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem +perform 2 ip modes mem = (iInsert (ip + 3) (a * b) mem, ip + 4) + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem +perform 3 ip _ mem = (mem, ip + 2) +perform 4 ip _ mem = (mem, ip + 2) +perform 5 ip modes mem = (mem, ip') + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem + ip' = if a /= 0 then b else ip + 3 +perform 6 ip modes mem = (mem, ip') + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem + ip' = if a == 0 then b else ip + 3 +perform 7 ip modes mem = (iInsert (ip + 3) res mem, ip + 4) + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem + res = if a < b then 1 else 0 +perform 8 ip modes mem = (iInsert (ip + 3) res mem, ip + 4) + where a = getMemoryValue (ip + 1) (modes!!0) mem + b = getMemoryValue (ip + 2) (modes!!1) mem + res = if a == b then 1 else 0 +perform _ ip _ mem = (mem, ip) + + +getMemoryValue loc Position mem = mem!>loc +getMemoryValue loc Immediate mem = mem!loc + + +parameterModes :: Int -> [ParameterMode] +parameterModes modeCode = unfoldr generateMode modeCode + +generateMode :: Int -> Maybe (ParameterMode, Int) +generateMode modeCode = Just (mode, modeCode `div` 10) + where mode = case (modeCode `mod` 10) of + 0 -> Position + 1 -> Immediate + + +-- Some IntMap utility functions, for syntactic sugar + +-- prefix version of (!) +lkup k m = m!k + +-- indirect lookup +(!>) m k = m!(m!k) + +-- indirect insert +iInsert k v m = M.insert (m!k) v m + + + +-- Parse the input file +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty +-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +signedInteger = L.signed sc integer +symb = L.symbol sc +comma = symb "," + +memoryP = signedInteger `sepBy` comma + +successfulParse :: Text -> [Int] +successfulParse input = + case parse memoryP "input" input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right memory -> memory \ No newline at end of file diff --git a/data/advent05.txt b/data/advent05.txt new file mode 100644 index 0000000..0727400 --- /dev/null +++ b/data/advent05.txt @@ -0,0 +1 @@ +3,225,1,225,6,6,1100,1,238,225,104,0,1101,81,30,225,1102,9,63,225,1001,92,45,224,101,-83,224,224,4,224,102,8,223,223,101,2,224,224,1,224,223,223,1102,41,38,225,1002,165,73,224,101,-2920,224,224,4,224,102,8,223,223,101,4,224,224,1,223,224,223,1101,18,14,224,1001,224,-32,224,4,224,1002,223,8,223,101,3,224,224,1,224,223,223,1101,67,38,225,1102,54,62,224,1001,224,-3348,224,4,224,1002,223,8,223,1001,224,1,224,1,224,223,223,1,161,169,224,101,-62,224,224,4,224,1002,223,8,223,101,1,224,224,1,223,224,223,2,14,18,224,1001,224,-1890,224,4,224,1002,223,8,223,101,3,224,224,1,223,224,223,1101,20,25,225,1102,40,11,225,1102,42,58,225,101,76,217,224,101,-153,224,224,4,224,102,8,223,223,1001,224,5,224,1,224,223,223,102,11,43,224,1001,224,-451,224,4,224,1002,223,8,223,101,6,224,224,1,223,224,223,1102,77,23,225,4,223,99,0,0,0,677,0,0,0,0,0,0,0,0,0,0,0,1105,0,99999,1105,227,247,1105,1,99999,1005,227,99999,1005,0,256,1105,1,99999,1106,227,99999,1106,0,265,1105,1,99999,1006,0,99999,1006,227,274,1105,1,99999,1105,1,280,1105,1,99999,1,225,225,225,1101,294,0,0,105,1,0,1105,1,99999,1106,0,300,1105,1,99999,1,225,225,225,1101,314,0,0,106,0,0,1105,1,99999,8,226,677,224,1002,223,2,223,1006,224,329,1001,223,1,223,7,226,226,224,102,2,223,223,1006,224,344,101,1,223,223,108,677,677,224,1002,223,2,223,1006,224,359,101,1,223,223,1107,226,677,224,1002,223,2,223,1005,224,374,101,1,223,223,1008,677,226,224,1002,223,2,223,1005,224,389,101,1,223,223,1007,677,226,224,1002,223,2,223,1005,224,404,1001,223,1,223,1107,677,226,224,1002,223,2,223,1005,224,419,1001,223,1,223,108,677,226,224,102,2,223,223,1006,224,434,1001,223,1,223,7,226,677,224,102,2,223,223,1005,224,449,1001,223,1,223,107,226,226,224,102,2,223,223,1006,224,464,101,1,223,223,107,677,226,224,102,2,223,223,1006,224,479,101,1,223,223,1007,677,677,224,1002,223,2,223,1006,224,494,1001,223,1,223,1008,226,226,224,1002,223,2,223,1006,224,509,101,1,223,223,7,677,226,224,1002,223,2,223,1006,224,524,1001,223,1,223,1007,226,226,224,102,2,223,223,1006,224,539,101,1,223,223,8,677,226,224,1002,223,2,223,1006,224,554,101,1,223,223,1008,677,677,224,102,2,223,223,1006,224,569,101,1,223,223,1108,677,226,224,102,2,223,223,1005,224,584,101,1,223,223,107,677,677,224,102,2,223,223,1006,224,599,1001,223,1,223,1108,677,677,224,1002,223,2,223,1006,224,614,1001,223,1,223,1107,677,677,224,1002,223,2,223,1005,224,629,1001,223,1,223,108,226,226,224,1002,223,2,223,1005,224,644,101,1,223,223,8,226,226,224,1002,223,2,223,1005,224,659,101,1,223,223,1108,226,677,224,1002,223,2,223,1006,224,674,101,1,223,223,4,223,99,226 diff --git a/stack.yaml b/stack.yaml index e0c5714..441f991 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,6 +41,7 @@ packages: - advent02 - advent03 - advent04 +- advent05 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1