Skip to content

Stuart A Kurtz / advent-of-code-2021

Go to a project
Commit 56d662d9 by Stuart Kurtz
Options

Day 24, finished

parent a7da1bb9
Inline Side-by-side
Showing with 578 additions and 2 deletions
data/instructions.txt 0 → 100644
inp w
mul x 0
add x z
mod x 26
div z 1
add x 10
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 10
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 13
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 5
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 15
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 12
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -12
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 12
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 14
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 6
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -2
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 4
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 13
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 15
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -12
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 3
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 15
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 7
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 1
add x 11
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 11
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -3
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 2
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -13
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 12
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -12
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 4
mul y x
add z y
inp w
mul x 0
add x z
mod x 26
div z 26
add x -13
eql x w
eql x 0
mul y 0
add y 25
mul y x
add y 1
mul z y
mul y 0
add y w
add y 11
mul y x
add z y
\ No newline at end of file
src/AOC-24a.hs
module Main where
import Control.Monad ( when )
import Data.Char ( isDigit )
-- import Data.Foldable ( for_ )
import Data.Functor ( ($>) )
import qualified Data.Map as M
import Text.ParserCombinators.ReadP
( (<++),
char,
munch1,
option,
readP_to_S,
satisfy,
skipSpaces,
string,
ReadP )
debugging :: Bool
debugging = True
data Value
= VInt Int
| VReg Char
instance Show Value where
show (VInt i) = show i
show (VReg c) = [c]
data Instruction
= IInp Char
| IAdd Char Value
| IMul Char Value
| IDiv Char Value
| IMod Char Value
| IEql Char Value
instance Show Instruction where
show (IInp c) = "inp " ++ [c]
show (IAdd c v) = showOp "add" c v
show (IMul c v) = showOp "mul" c v
show (IDiv c v) = showOp "div" c v
show (IMod c v) = showOp "mod" c v
show (IEql c v) = showOp "eql" c v
showOp :: String -> Char -> Value -> String
showOp name reg val = unwords [name,[reg],show val]
parseInt :: ReadP Int
parseInt = do
sg <- option 1 (char '-' $> (-1))
ds <- read <$> munch1 isDigit
pure $ sg * ds
parseReg :: ReadP Char
parseReg = satisfy (`elem` "wxyz")
parseValue :: ReadP Value
parseValue = (VInt <$> parseInt) <++ (VReg <$> parseReg)
parseInstruction :: ReadP Instruction
parseInstruction = parseInp <++ parseAdd <++ parseMul <++ parseDiv <++ parseMod <++ parseEql where
parseInp = IInp <$> (string "inp" *> skipSpaces *> parseReg)
parseInstr name constructor = constructor <$> reg <*> val where
reg = string name *> skipSpaces *> parseReg
val = skipSpaces *> parseValue
parseAdd = parseInstr "add" IAdd
parseMul = parseInstr "mul" IMul
parseDiv = parseInstr "div" IDiv
parseMod = parseInstr "mod" IMod
parseEql = parseInstr "eql" IEql
instance Read Instruction where
readsPrec _ = readP_to_S parseInstruction
data Registers = Registers
{ w :: Int
, x :: Int
, y :: Int
, z :: Int
} deriving (Eq, Ord)
instance Show Registers where
show r = unlines [ unwords ["w =",show $ w r]
, unwords ["x =",show $ x r]
, unwords ["y =",show $ y r]
, unwords ["z =",show $ z r]
]
modifyReg :: Registers -> Char -> (Int -> Int) -> Registers
modifyReg regs 'w' op = regs { w = op (w regs) }
modifyReg regs 'x' op = regs { x = op (x regs) }
modifyReg regs 'y' op = regs { y = op (y regs) }
modifyReg regs 'z' op = regs { z = op (z regs) }
modifyReg _ _ _ = error "modifyReg: unknown register"
eql :: Int -> Int -> Int
eql a b
| a == b = 1
| otherwise = 0
oneInstruction :: Instruction -> Registers -> Int -> [ (Registers,Int) ]
oneInstruction (IInp a ) r c = [ (modifyReg (reset r) a (const c'), 10 * c+c') -- reset is a hack.
| c' <- [1..9]]
oneInstruction (IAdd a v) r c = [ (modifyReg r a (+ value r v), c) ]
oneInstruction (IMul a v) r c = [ (modifyReg r a (* value r v), c) ]
oneInstruction (IDiv a v) r c = [ (modifyReg r a (`quot` value r v), c) ]
oneInstruction (IMod a v) r c = [ (modifyReg r a (`rem` value r v), c) ]
oneInstruction (IEql a v) r c = [ (modifyReg r a (`eql` value r v), c) ]
reset :: Registers -> Registers
reset r = Registers { w = 0, x = 0, y = 0, z = z r}
value :: Registers -> Value -> Int
value _ (VInt i) = i
value r (VReg 'w') = w r
value r (VReg 'x') = x r
value r (VReg 'y') = y r
value r (VReg 'z') = z r
value _ (VReg _) = error "value: unknown register"
type ALUSpace = M.Map Registers Int
interpret :: [Instruction] -> IO ALUSpace
interpret instrs = do
when debugging $ do
putStr . show $ start
iter (M.singleton start 0) instrs
where
start = Registers { w = 0, x = 0, y = 0, z = 0 }
iter alu [] = do
when debugging $ do
putStrLn "done"
pure alu
iter alu (i:is) = do
let alu' = M.unionsWith max
[ M.singleton registers' c'
| (registers,c) <- M.assocs alu
, (registers',c') <- oneInstruction i registers c
, z registers' < 1000000 -- hack!!
]
when debugging $ do
putStrLn $ unwords[show i, " -- ", show (M.size alu')]
iter alu' is
segment :: [Instruction] -> [[Instruction]]
segment [] = []
segment (a:as) = (a : front) : segment rear where
(front,rear) = span (not . isInput) as
isInput (IInp _) = True
isInput _ = False
main :: IO ()
main = pure ()
main = do
instrs <- map (read @Instruction) . lines <$> readFile "data/instructions.txt"
alu <- interpret instrs
putStrLn . show . maximum $ [c | (r,c) <- M.assocs alu, z r == 0]
\ No newline at end of file
src/AOC-24b.hs
module Main where
import Control.Monad ( when )
import Data.Char ( isDigit )
-- import Data.Foldable ( for_ )
import Data.Functor ( ($>) )
import qualified Data.Map as M
import Text.ParserCombinators.ReadP
( (<++),
char,
munch1,
option,
readP_to_S,
satisfy,
skipSpaces,
string,
ReadP )
debugging :: Bool
debugging = True
data Value
= VInt Int
| VReg Char
instance Show Value where
show (VInt i) = show i
show (VReg c) = [c]
data Instruction
= IInp Char
| IAdd Char Value
| IMul Char Value
| IDiv Char Value
| IMod Char Value
| IEql Char Value
instance Show Instruction where
show (IInp c) = "inp " ++ [c]
show (IAdd c v) = showOp "add" c v
show (IMul c v) = showOp "mul" c v
show (IDiv c v) = showOp "div" c v
show (IMod c v) = showOp "mod" c v
show (IEql c v) = showOp "eql" c v
showOp :: String -> Char -> Value -> String
showOp name reg val = unwords [name,[reg],show val]
parseInt :: ReadP Int
parseInt = do
sg <- option 1 (char '-' $> (-1))
ds <- read <$> munch1 isDigit
pure $ sg * ds
parseReg :: ReadP Char
parseReg = satisfy (`elem` "wxyz")
parseValue :: ReadP Value
parseValue = (VInt <$> parseInt) <++ (VReg <$> parseReg)
parseInstruction :: ReadP Instruction
parseInstruction = parseInp <++ parseAdd <++ parseMul <++ parseDiv <++ parseMod <++ parseEql where
parseInp = IInp <$> (string "inp" *> skipSpaces *> parseReg)
parseInstr name constructor = constructor <$> reg <*> val where
reg = string name *> skipSpaces *> parseReg
val = skipSpaces *> parseValue
parseAdd = parseInstr "add" IAdd
parseMul = parseInstr "mul" IMul
parseDiv = parseInstr "div" IDiv
parseMod = parseInstr "mod" IMod
parseEql = parseInstr "eql" IEql
instance Read Instruction where
readsPrec _ = readP_to_S parseInstruction
data Registers = Registers
{ w :: Int
, x :: Int
, y :: Int
, z :: Int
} deriving (Eq, Ord)
instance Show Registers where
show r = unlines [ unwords ["w =",show $ w r]
, unwords ["x =",show $ x r]
, unwords ["y =",show $ y r]
, unwords ["z =",show $ z r]
]
modifyReg :: Registers -> Char -> (Int -> Int) -> Registers
modifyReg regs 'w' op = regs { w = op (w regs) }
modifyReg regs 'x' op = regs { x = op (x regs) }
modifyReg regs 'y' op = regs { y = op (y regs) }
modifyReg regs 'z' op = regs { z = op (z regs) }
modifyReg _ _ _ = error "modifyReg: unknown register"
eql :: Int -> Int -> Int
eql a b
| a == b = 1
| otherwise = 0
oneInstruction :: Instruction -> Registers -> Int -> [ (Registers,Int) ]
oneInstruction (IInp a ) r c = [ (modifyReg (reset r) a (const c'), 10 * c+c') -- reset is a hack.
| c' <- [1..9]]
oneInstruction (IAdd a v) r c = [ (modifyReg r a (+ value r v), c) ]
oneInstruction (IMul a v) r c = [ (modifyReg r a (* value r v), c) ]
oneInstruction (IDiv a v) r c = [ (modifyReg r a (`quot` value r v), c) ]
oneInstruction (IMod a v) r c = [ (modifyReg r a (`rem` value r v), c) ]
oneInstruction (IEql a v) r c = [ (modifyReg r a (`eql` value r v), c) ]
reset :: Registers -> Registers
reset = id
-- reset r = Registers { w = 0, x = 0, y = 0, z = z r}
value :: Registers -> Value -> Int
value _ (VInt i) = i
value r (VReg 'w') = w r
value r (VReg 'x') = x r
value r (VReg 'y') = y r
value r (VReg 'z') = z r
value _ (VReg _) = error "value: unknown register"
type ALUSpace = M.Map Registers Int
interpret :: [Instruction] -> IO ALUSpace
interpret instrs = do
when debugging $ do
putStr . show $ start
iter (M.singleton start 0) instrs
where
start = Registers { w = 0, x = 0, y = 0, z = 0 }
iter alu [] = do
when debugging $ do
putStrLn "done"
pure alu
iter alu (i:is) = do
let alu' = M.unionsWith min
[ M.singleton registers' c'
| (registers,c) <- M.assocs alu
, (registers',c') <- oneInstruction i registers c
, z registers' < 1000000 -- hack!!
]
when debugging $ do
putStrLn $ unwords[show i, " -- ", show (M.size alu')]
iter alu' is
segment :: [Instruction] -> [[Instruction]]
segment [] = []
segment (a:as) = (a : front) : segment rear where
(front,rear) = span (not . isInput) as
isInput (IInp _) = True
isInput _ = False
main :: IO ()
main = pure ()
main = do
instrs <- map (read @Instruction) . lines <$> readFile "data/instructions.txt"
alu <- interpret instrs
putStrLn . show . minimum $ [c | (r,c) <- M.assocs alu, z r == 0]
\ No newline at end of file
test/instructions.txt 0 → 100644
inp w
add z w
mod z 2
div w 2
add y w
mod y 2
div w 2
add x w
mod x 2
div w 2
mod w 2
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or sign in to comment