From 2c248bf0d6b000a5402e15de9ca521e9228f9fde Mon Sep 17 00:00:00 2001 From: Eric Bailey Date: Wed, 15 May 2024 23:05:06 -0500 Subject: [PATCH] feat(2015.23-haskell): solve Part Two and tidy --- VERSION | 2 +- package.yaml | 2 + src/AdventOfCode/Year2015/Day23.hs | 109 ++++++++++++++++++----------- 3 files changed, 73 insertions(+), 40 deletions(-) diff --git a/VERSION b/VERSION index 2fa1fe4..497c775 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -2023.6.2.7 \ No newline at end of file +2023.6.2.8 \ No newline at end of file diff --git a/package.yaml b/package.yaml index eb7a3e6..fb61963 100644 --- a/package.yaml +++ b/package.yaml @@ -59,6 +59,7 @@ library: - monoid-extras - mtl - parser-combinators + - pointless-fun - recursion-schemes - safe - scientific @@ -172,6 +173,7 @@ executables: dependencies: - data-default - mtl + - pointless-fun - vector aoc-2016-day05: <<: *executable diff --git a/src/AdventOfCode/Year2015/Day23.hs b/src/AdventOfCode/Year2015/Day23.hs index 6672010..98f1b3c 100644 --- a/src/AdventOfCode/Year2015/Day23.hs +++ b/src/AdventOfCode/Year2015/Day23.hs @@ -1,6 +1,15 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +-- | +-- Module : AdventOfCode.Year2015.Day23 +-- Description : Advent of Code 2015 Day 23: Opening the Turing Lock +-- Copyright : (c) Eric Bailey, 2024 +-- License : MIT +-- Maintainer : eric@ericb.me +-- Stability : experimental +-- Portability : POSIX +-- https://adventofcode.com/2015/day/23 module AdventOfCode.Year2015.Day23 ( main, partOne, @@ -11,11 +20,13 @@ where import AdventOfCode.Input (parseInput) import AdventOfCode.TH (defaultMain, inputFilePath) import Control.Applicative ((<|>)) -import Control.Lens (makeLenses, modifying, uses, view, (+=)) +import Control.Lens (makeLenses, modifying, uses, view, (+=), (.~)) import Control.Monad (when) import Control.Monad.State (State, execState) import Data.Bool (bool) -import Data.Default (Default (..)) +import Data.Default (Default (def)) +import Data.Function ((&)) +import Data.Function.Pointless ((.:)) import Data.Ix (inRange) import Data.Vector (Vector, (!)) import qualified Data.Vector as Vector @@ -32,12 +43,18 @@ import Text.Trifecta (), ) -data Register - = A - | B - deriving (Eq, Show) +-- ------------------------------------------------------------------- [ Types ] -type Offset = Int +data Instruction + = InstructionRegister !Operation !Register + | InstructionOffset !Operation !Offset + | InstructionRegisterOffset !Operation !Register !Offset + deriving (Eq) + +instance Show Instruction where + show (InstructionRegister op r) = show op <> " " <> show r + show (InstructionOffset op o) = show op <> " " <> show o + show (InstructionRegisterOffset op r o) = show op <> " " <> show r <> ", " <> show o data Operation = HLF @@ -48,16 +65,12 @@ data Operation | JIO deriving (Eq, Show) -data Instruction - = InstructionRegister !Operation !Register - | InstructionOffset !Operation !Offset - | InstructionRegisterOffset !Operation !Register !Offset - deriving (Eq) +data Register + = A + | B + deriving (Eq, Show) -instance Show Instruction where - show (InstructionRegister op r) = show op <> " " <> show r - show (InstructionOffset op o) = show op <> " " <> show o - show (InstructionRegisterOffset op r o) = show op <> " " <> show r <> ", " <> show o +type Offset = Int data ComputerState = ComputerState { _cursor :: !Int, @@ -68,22 +81,25 @@ data ComputerState = ComputerState makeLenses ''ComputerState +type Program = State ComputerState + +-- ------------------------------------------------------------------ [ Puzzle ] + main :: IO () main = $(defaultMain) partOne :: Vector Instruction -> Int -partOne = view registerB . flip execState initialState . program +partOne = programExec def partTwo :: Vector Instruction -> Int -partTwo = undefined +partTwo = programExec $ def & (registerA .~ 1) getInput :: IO (Vector Instruction) getInput = parseInput (Vector.fromList <$> some instruction) $(inputFilePath) -initialState :: ComputerState -initialState = def +-- ---------------------------------------------------------------- [ Programs ] -program :: Vector Instruction -> State ComputerState () +program :: Vector Instruction -> Program () program prog | Vector.null prog = pure () | otherwise = @@ -92,10 +108,15 @@ program prog runInstruction =<< uses cursor (prog !) program prog -ensuring :: (Monad m) => m Bool -> m () -> m () -ensuring p s = p >>= flip when s +execProgram :: Vector Instruction -> ComputerState -> Int +execProgram = view registerB .: execState . program -runInstruction :: Instruction -> State ComputerState () +programExec :: ComputerState -> Vector Instruction -> Int +programExec = flip execProgram + +-- ------------------------------------------------------------ [ Instructions ] + +runInstruction :: Instruction -> Program () runInstruction (InstructionRegister HLF r) = modifyingRegister r (`div` 2) *> moveCursor 1 runInstruction (InstructionRegister TPL r) = @@ -103,22 +124,17 @@ runInstruction (InstructionRegister TPL r) = runInstruction (InstructionRegister INC r) = modifyingRegister r (+ 1) *> moveCursor 1 runInstruction (InstructionOffset JMP o) = moveCursor o -runInstruction (InstructionRegisterOffset JIE r o) = - moveCursor . bool 1 (fromIntegral o) =<< usesRegister r even -runInstruction (InstructionRegisterOffset JIO r o) = - moveCursor . bool 1 (fromIntegral o) =<< usesRegister r (== 1) +runInstruction (InstructionRegisterOffset JIE r o) = jumpIf even r o +runInstruction (InstructionRegisterOffset JIO r o) = jumpIf (== 1) r o runInstruction _ = error "Invalid instruction!" -usesRegister :: Register -> (Int -> Bool) -> State ComputerState Bool -usesRegister A = uses registerA -usesRegister B = uses registerB +moveCursor :: Offset -> Program () +moveCursor o = cursor += o -modifyingRegister :: Register -> (Int -> Int) -> State ComputerState () -modifyingRegister A = modifying registerA -modifyingRegister B = modifying registerB +jumpIf :: (Int -> Bool) -> Register -> Offset -> Program () +jumpIf p r o = moveCursor . bool 1 o =<< usesRegister r p -moveCursor :: Int -> State ComputerState () -moveCursor o = cursor += o +-- ----------------------------------------------------------------- [ Parsers ] instruction :: Parser Instruction instruction = @@ -143,9 +159,6 @@ jump = mkOp JMP "jmp" "jump" jumpIfEven = mkOp JIE "jie" "jump if even" jumpIfOne = mkOp JIO "jio" "jump if one" -mkOp :: a -> String -> String -> Parser a -mkOp op repr desc = highlight Operator $ op <$ symbol repr desc - register :: Parser Register register = highlight Identifier $ @@ -154,3 +167,21 @@ register = offset :: Parser Offset offset = highlight Number $ fromInteger <$> integer "offset" + +-- ----------------------------------------------------------------- [ Helpers ] + +ensuring :: (Monad m) => m Bool -> m () -> m () +ensuring p s = p >>= flip when s + +mkOp :: a -> String -> String -> Parser a +mkOp op repr desc = highlight Operator $ op <$ symbol repr desc + +modifyingRegister :: Register -> (Int -> Int) -> Program () +modifyingRegister A = modifying registerA +modifyingRegister B = modifying registerB + +usesRegister :: Register -> (Int -> Bool) -> Program Bool +usesRegister A = uses registerA +usesRegister B = uses registerB + +-- --------------------------------------------------------------------- [ EOF ]