[hs] Solve 2019_05 part 1
This commit is contained in:
parent
53aacea987
commit
e335e9d874
3 changed files with 213 additions and 117 deletions
|
|
@ -7,6 +7,7 @@ import qualified Aoc.Y2019.D01 as D01
|
|||
import qualified Aoc.Y2019.D02 as D02
|
||||
import qualified Aoc.Y2019.D03 as D03
|
||||
import qualified Aoc.Y2019.D04 as D04
|
||||
import qualified Aoc.Y2019.D05 as D05
|
||||
|
||||
year :: Year
|
||||
year = Year 2019
|
||||
|
|
@ -14,4 +15,5 @@ year = Year 2019
|
|||
, ( 2, D02.day)
|
||||
, ( 3, D03.day)
|
||||
, ( 4, D04.day)
|
||||
, ( 5, D05.day)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,117 +0,0 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Aoc.Y2019.A05
|
||||
( solve201905
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
-- Basic types
|
||||
|
||||
-- Typesafe addresses and values so we don't confuse the two unless we want to.
|
||||
|
||||
newtype Addr = Addr Integer
|
||||
deriving (Show, Eq, Ord, Enum, Num, Real, Integral)
|
||||
|
||||
newtype Value = Value Integer
|
||||
deriving (Show, Eq, Ord, Enum, Num, Real, Integral)
|
||||
|
||||
-- Memory
|
||||
|
||||
newtype Memory = Memory { unmemory :: M.Map Addr Value }
|
||||
|
||||
instance Show Memory where
|
||||
show mem = "Memory " <> show (memToList mem)
|
||||
|
||||
newMem :: [Integer] -> Memory
|
||||
newMem = Memory . M.fromList . map (bimap Addr Value) . zip [0..]
|
||||
|
||||
memToList :: Memory -> [Integer]
|
||||
memToList (Memory m) =
|
||||
let maxAddr = fromMaybe 0 $ S.lookupMax $ M.keysSet m
|
||||
in map (toInteger . fromMaybe 0 . (m M.!?)) [0..maxAddr]
|
||||
|
||||
readMem :: Addr -> Memory -> Maybe Value
|
||||
readMem addr (Memory mem) = mem M.!? addr
|
||||
|
||||
writeMem :: Addr -> Value -> Memory -> Memory
|
||||
writeMem addr val = Memory . M.insert addr val . unmemory
|
||||
|
||||
-- State
|
||||
|
||||
data State = State
|
||||
{ stateMem :: Memory
|
||||
, stateIdx :: Addr
|
||||
, stateInput :: [Integer]
|
||||
} deriving (Show)
|
||||
|
||||
newState :: Memory -> State
|
||||
newState mem = State mem 0 []
|
||||
|
||||
data StepError
|
||||
= Halted
|
||||
| CouldNotRead Addr
|
||||
| UnknownOpcode Integer
|
||||
deriving (Show)
|
||||
|
||||
readAt :: State -> Addr -> Either StepError Value
|
||||
readAt s i = case readMem i $ stateMem s of
|
||||
Nothing -> Left $ CouldNotRead i
|
||||
Just v -> Right v
|
||||
|
||||
writeAt :: Addr -> Value -> State -> State
|
||||
writeAt addr val s = s{stateMem = writeMem addr val $ stateMem s}
|
||||
|
||||
-- Opcode
|
||||
|
||||
data ParamMode = PositionMode | ImmediateMode
|
||||
deriving (Show, Eq)
|
||||
|
||||
digits :: Integer -> [Integer]
|
||||
digits i = (i `mod` 10) : digits (i `div` 10)
|
||||
|
||||
pmFromDigit :: Integer -> ParamMode
|
||||
pmFromDigit 0 = PositionMode
|
||||
pmFromDigit 1 = ImmediateMode
|
||||
pmFromDigit _ = undefined
|
||||
|
||||
paramModes :: Integer -> [ParamMode]
|
||||
paramModes i = map pmFromDigit $ drop 2 $ (digits i ++ repeat 0)
|
||||
|
||||
data Operand = Direct Value | Indirect Addr
|
||||
deriving (Show)
|
||||
|
||||
data Opcode
|
||||
= OpAdd Operand Operand Addr
|
||||
| OpMul Operand Operand Addr
|
||||
| OpInput Addr
|
||||
| OpOutput Operand Addr
|
||||
| OpHalt
|
||||
deriving (Show)
|
||||
|
||||
opWidth :: Opcode -> Addr
|
||||
opWidth (OpAdd _ _ _) = 4
|
||||
opWidth (OpMul _ _ _) = 4
|
||||
opWidth (OpInput _) = 2
|
||||
opWidth (OpOutput _ _) = 3
|
||||
opWidth OpHalt = 1
|
||||
|
||||
parseOpcode :: State -> Either StepError Opcode
|
||||
parseOpcode s = do
|
||||
let idx = stateIdx s
|
||||
undefined
|
||||
|
||||
solve201905 :: FilePath -> IO ()
|
||||
solve201905 f = do
|
||||
stuff <- readFile f
|
||||
|
||||
putStrLn ">> Part 1"
|
||||
|
||||
putStrLn ">> Part 2"
|
||||
211
hs/src/Aoc/Y2019/D05.hs
Normal file
211
hs/src/Aoc/Y2019/D05.hs
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Aoc.Y2019.D05
|
||||
( day
|
||||
) where
|
||||
|
||||
import Data.Bifunctor
|
||||
import Data.Maybe
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
import Aoc.Day
|
||||
import Aoc.Parse
|
||||
|
||||
-------------------
|
||||
-- General types --
|
||||
-------------------
|
||||
|
||||
newtype Addr = Addr Integer
|
||||
deriving (Show, Eq, Ord, Enum, Num, Real, Integral)
|
||||
|
||||
newtype Value = Value Integer
|
||||
deriving (Show, Eq, Ord, Enum, Num, Real, Integral)
|
||||
|
||||
data StepError
|
||||
= Halted State
|
||||
| CouldNotRead Addr
|
||||
| UnknownOpcode Addr Integer
|
||||
| InvalidInput T.Text
|
||||
deriving (Show)
|
||||
|
||||
displayError :: StepError -> T.Text
|
||||
displayError (Halted s) = "Halted at " <> T.pack (show $ stateIdx s)
|
||||
displayError (CouldNotRead a) = "Could not read value at " <> T.pack (show a)
|
||||
displayError (UnknownOpcode a i) = "Unknown opcode " <> T.pack (show i) <> " at " <> T.pack (show a)
|
||||
displayError (InvalidInput t) = "Invalid input: " <> t
|
||||
|
||||
type StepM = Either StepError
|
||||
|
||||
------------
|
||||
-- Memory --
|
||||
------------
|
||||
|
||||
newtype Memory = Memory { unmemory :: M.Map Addr Value }
|
||||
|
||||
instance Show Memory where
|
||||
show mem = "Memory " <> show (memToList mem)
|
||||
|
||||
newMem :: [Integer] -> Memory
|
||||
newMem = Memory . M.fromList . map (bimap Addr Value) . zip [0..]
|
||||
|
||||
memToList :: Memory -> [Integer]
|
||||
memToList (Memory m) =
|
||||
let maxAddr = fromMaybe 0 $ S.lookupMax $ M.keysSet m
|
||||
in map (toInteger . fromMaybe 0 . (m M.!?)) [0..maxAddr]
|
||||
|
||||
readMem :: Addr -> Memory -> Maybe Value
|
||||
readMem addr (Memory mem) = mem M.!? addr
|
||||
|
||||
writeMem :: Addr -> Value -> Memory -> Memory
|
||||
writeMem addr val = Memory . M.insert addr val . unmemory
|
||||
|
||||
-----------
|
||||
-- State --
|
||||
-----------
|
||||
|
||||
data State = State
|
||||
{ stateMem :: Memory
|
||||
, stateIdx :: Addr
|
||||
} deriving (Show)
|
||||
|
||||
newState :: Memory -> State
|
||||
newState mem = State mem 0
|
||||
|
||||
readAt :: State -> Addr -> StepM Value
|
||||
readAt s i = case readMem i $ stateMem s of
|
||||
Nothing -> Left $ CouldNotRead i
|
||||
Just v -> Right v
|
||||
|
||||
writeAt :: State -> Addr -> Value -> State
|
||||
writeAt s addr val = s{stateMem = writeMem addr val $ stateMem s}
|
||||
|
||||
-------------
|
||||
-- Opcodes --
|
||||
-------------
|
||||
|
||||
data ParamMode = PositionMode | ImmediateMode
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Infinite list of param modes based on the digits of a number. The default
|
||||
-- mode is 'PositionMode'.
|
||||
paramModes :: Integer -> [ParamMode]
|
||||
paramModes = map pmFromDigit . digits
|
||||
where
|
||||
digits i = (i `mod` 10) : digits (i `div` 10)
|
||||
pmFromDigit 0 = PositionMode
|
||||
pmFromDigit _ = ImmediateMode
|
||||
|
||||
data Operand = Direct Value | Indirect Addr
|
||||
deriving (Show)
|
||||
|
||||
pmToOp :: ParamMode -> Value -> Operand
|
||||
pmToOp PositionMode = Indirect . fromIntegral
|
||||
pmToOp ImmediateMode = Direct
|
||||
|
||||
data Opcode
|
||||
= OpAdd Operand Operand Addr
|
||||
| OpMul Operand Operand Addr
|
||||
| OpInput Addr
|
||||
| OpOutput Operand
|
||||
| OpHalt
|
||||
deriving (Show)
|
||||
|
||||
--------------
|
||||
-- Stepping --
|
||||
--------------
|
||||
|
||||
-- Parsing opcodes
|
||||
|
||||
getOp :: State -> Addr -> [ParamMode] -> Int -> StepM Operand
|
||||
getOp s a pms i = do
|
||||
let pm = pms !! i
|
||||
value <- readAt s $ a + 1 + fromIntegral i
|
||||
pure $ pmToOp pm value
|
||||
|
||||
getAddr :: State -> Addr -> Int -> StepM Addr
|
||||
getAddr s a i = fromIntegral <$> readAt s (a + 1 + fromIntegral i)
|
||||
|
||||
parseOpcode :: State -> StepM Opcode
|
||||
parseOpcode s = do
|
||||
let a = stateIdx s
|
||||
value <- toInteger <$> readAt s a
|
||||
let opcode = value `mod` 100
|
||||
pms = paramModes $ value `div` 100
|
||||
case opcode of
|
||||
1 -> OpAdd <$> getOp s a pms 0 <*> getOp s a pms 1 <*> getAddr s a 2
|
||||
2 -> OpMul <$> getOp s a pms 0 <*> getOp s a pms 1 <*> getAddr s a 2
|
||||
3 -> OpInput <$> getAddr s a 0
|
||||
4 -> OpOutput <$> getOp s a pms 0
|
||||
99 -> pure OpHalt
|
||||
_ -> Left $ UnknownOpcode a opcode
|
||||
|
||||
-- Executing opcodes
|
||||
|
||||
data StepResult
|
||||
= NormalStep State
|
||||
| InputStep (Integer -> State)
|
||||
| OutputStep State Integer
|
||||
|
||||
readOp :: State -> Operand -> StepM Value
|
||||
readOp _ (Direct v) = pure v
|
||||
readOp s (Indirect a) = readAt s a
|
||||
|
||||
incIdx :: Int -> State -> State
|
||||
incIdx i s = s{stateIdx = stateIdx s + fromIntegral i}
|
||||
|
||||
execOpcode :: State -> Opcode -> StepM StepResult
|
||||
execOpcode s (OpAdd x y r) = do
|
||||
vx <- readOp s x
|
||||
vy <- readOp s y
|
||||
pure $ NormalStep $ incIdx 4 $ writeAt s r $ vx + vy
|
||||
execOpcode s (OpMul x y r) = do
|
||||
vx <- readOp s x
|
||||
vy <- readOp s y
|
||||
pure $ NormalStep $ incIdx 4 $ writeAt s r $ vx * vy
|
||||
execOpcode s (OpInput r) = pure $ InputStep $ incIdx 2 . writeAt s r . fromInteger
|
||||
execOpcode s (OpOutput x) = do
|
||||
vx <- readOp s x
|
||||
pure $ OutputStep (incIdx 2 s) $ toInteger vx
|
||||
execOpcode s OpHalt = Left $ Halted s
|
||||
|
||||
step :: State -> Either StepError StepResult
|
||||
step s = execOpcode s =<< parseOpcode s
|
||||
|
||||
run :: State -> IO StepError
|
||||
run s = case step s of
|
||||
Left e -> pure e
|
||||
Right (NormalStep s') -> run s'
|
||||
Right (InputStep f) -> do
|
||||
putStr "?> "
|
||||
t <- T.getLine
|
||||
case readMaybe $ T.unpack t of
|
||||
Nothing -> pure $ InvalidInput t
|
||||
Just i -> run $ f i
|
||||
Right (OutputStep s' o) -> do
|
||||
putStrLn $ "-> " ++ show o
|
||||
run s'
|
||||
|
||||
runAndPrintResult :: State -> IO ()
|
||||
runAndPrintResult s = do
|
||||
e <- run s
|
||||
T.putStrLn $ displayError e
|
||||
|
||||
parser :: Parser Memory
|
||||
parser = newMem <$> (signed (pure ()) decimal `sepBy` char ',') <* newline
|
||||
|
||||
solver :: Memory -> IO ()
|
||||
solver mem = do
|
||||
putStrLn ">> Part 1"
|
||||
runAndPrintResult $ newState mem
|
||||
|
||||
putStrLn ""
|
||||
putStrLn ">> Part 2"
|
||||
|
||||
day :: Day
|
||||
day = dayParse parser solver
|
||||
Loading…
Add table
Add a link
Reference in a new issue