From 1ceda81b1ea28546d796dafa288067d09b9c7313 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Mon, 25 Dec 2017 20:41:30 +0000 Subject: [PATCH] Done day 25 --- advent-of-code.cabal | 10 + data/advent25.txt | 62 +++ src/advent25/advent25.hs | 128 ++++++ src/advent25/advent25.ipynb | 691 ++++++++++++++++++++++++++++++++ src/advent25/advent25sample.txt | 22 + 5 files changed, 913 insertions(+) create mode 100644 data/advent25.txt create mode 100644 src/advent25/advent25.hs create mode 100644 src/advent25/advent25.ipynb create mode 100644 src/advent25/advent25sample.txt diff --git a/advent-of-code.cabal b/advent-of-code.cabal index 65cbc37..059296b 100644 --- a/advent-of-code.cabal +++ b/advent-of-code.cabal @@ -281,3 +281,13 @@ executable advent24 , text , megaparsec , multiset + +executable advent25 + hs-source-dirs: src/advent25 + main-is: advent25.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , containers + , mtl + , text + , megaparsec diff --git a/data/advent25.txt b/data/advent25.txt new file mode 100644 index 0000000..c8216fa --- /dev/null +++ b/data/advent25.txt @@ -0,0 +1,62 @@ +Begin in state A. +Perform a diagnostic checksum after 12994925 steps. + +In state A: + If the current value is 0: + - Write the value 1. + - Move one slot to the right. + - Continue with state B. + If the current value is 1: + - Write the value 0. + - Move one slot to the left. + - Continue with state F. + +In state B: + If the current value is 0: + - Write the value 0. + - Move one slot to the right. + - Continue with state C. + If the current value is 1: + - Write the value 0. + - Move one slot to the right. + - Continue with state D. + +In state C: + If the current value is 0: + - Write the value 1. + - Move one slot to the left. + - Continue with state D. + If the current value is 1: + - Write the value 1. + - Move one slot to the right. + - Continue with state E. + +In state D: + If the current value is 0: + - Write the value 0. + - Move one slot to the left. + - Continue with state E. + If the current value is 1: + - Write the value 0. + - Move one slot to the left. + - Continue with state D. + +In state E: + If the current value is 0: + - Write the value 0. + - Move one slot to the right. + - Continue with state A. + If the current value is 1: + - Write the value 1. + - Move one slot to the right. + - Continue with state C. + +In state F: + If the current value is 0: + - Write the value 1. + - Move one slot to the left. + - Continue with state A. + If the current value is 1: + - Write the value 1. + - Move one slot to the right. + - Continue with state A. \ No newline at end of file diff --git a/src/advent25/advent25.hs b/src/advent25/advent25.hs new file mode 100644 index 0000000..55f5c5c --- /dev/null +++ b/src/advent25/advent25.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Text.Megaparsec hiding (State) +import qualified Text.Megaparsec.Lexer as L +import Text.Megaparsec.Text (Parser) +import qualified Control.Applicative as CA + +import qualified Data.Map as M +import Data.Map ((!)) + +import Control.Monad (unless) +import Control.Monad.State.Lazy +import Control.Monad.Reader + +type TuringState = String + +type Tape = M.Map Integer Bool + +data StateTransition = StateTransition { writeValue :: Bool + , newState :: TuringState + , tapeMovement :: Integer + } deriving (Show, Eq) + +type RuleTrigger = (TuringState, Bool) + +type Rules = M.Map RuleTrigger StateTransition + +data Machine = Machine { tState :: TuringState + , tape :: Tape + , tapeLocation :: Integer + , stepsRemaining :: Integer + } + deriving (Show, Eq) + +emptyMachine = Machine {tState = "unknown", tape = M.empty, tapeLocation = 0, stepsRemaining = 0} + +type ProgrammedMachine = ReaderT Rules (State Machine) () + + +main :: IO () +main = do + text <- TIO.readFile "data/advent25.txt" + let (machine0, rules) = successfulParse text + let (result, machinef) = part1 rules machine0 + print $ M.size $ M.filter id $ tape machinef + + +part1 rules machine0 = + runState ( + runReaderT executeSteps + rules + ) + machine0 + +executeSteps = + do m <- get + unless (stepsRemaining m == 0) $ + do executeStep + executeSteps + + +executeStep = + do rules <- ask + m <- get + let tapeHere = M.findWithDefault False (tapeLocation m) (tape m) + let transition = rules!(tState m, tapeHere) + let tape' = M.insert (tapeLocation m) (writeValue transition) (tape m) + let loc' = (tapeLocation m) + (tapeMovement transition) + let tState' = newState transition + let steps' = stepsRemaining m - 1 + let m' = m {tState = tState', tape = tape', tapeLocation = loc', stepsRemaining = steps'} + put m' + + + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.integer +symbol = L.symbol sc +fullstop = symbol "." + +commandP = between (symbol "-") fullstop + +writeValueP = (symbol "1" *> pure True) <|> (symbol "0" *> pure False) +writeP = commandP ((symbol "Write the value") *> writeValueP) + +directionP = (symbol "left" *> pure -1) <|> (symbol "right" *> pure 1) +tapeMovementP = commandP ((symbol "Move one slot to the") *> directionP) + +newStateP = commandP ((symbol "Continue with state") *> (some letterChar)) + +stateTransitionP = stify <$> writeP <*> tapeMovementP <*> newStateP + where stify w t s = StateTransition {writeValue = w, newState = s, tapeMovement = t} + +currentValueP = (symbol "If the current value is") *> writeValueP <* (symbol ":") + +stateWhenP = (,) <$> currentValueP <*> stateTransitionP + +stateDefP = (symbol "In state") *> (some letterChar) <* (symbol ":") + +stateRulesP = rulify <$> stateDefP <*> (stateWhenP `sepBy` space) + where rulify s ts = M.fromList $ map (\(v, t) -> ((s, v), t)) ts + +manyStateRulesP = M.unions <$> (stateRulesP `sepBy` space) + +startStateP = (symbol "Begin in state") *> (some letterChar) <* fullstop +stepsP = (symbol "Perform a diagnostic checksum after") *> integer <* (symbol "steps") <* fullstop + +machineDescriptionP = machineify <$> startStateP <*> stepsP <*> manyStateRulesP + where machineify initial limit rules = + ( emptyMachine { tState = initial, stepsRemaining = limit } + , rules + ) + +successfulParse :: Text -> (Machine, Rules) +successfulParse input = + case parse machineDescriptionP "input" input of + Left _error -> (emptyMachine, M.empty) + Right machineRules -> machineRules \ No newline at end of file diff --git a/src/advent25/advent25.ipynb b/src/advent25/advent25.ipynb new file mode 100644 index 0000000..0813c7f --- /dev/null +++ b/src/advent25/advent25.ipynb @@ -0,0 +1,691 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "metadata": {}, + "outputs": [], + "source": [ + "{-# LANGUAGE NegativeLiterals #-}\n", + "{-# LANGUAGE FlexibleContexts #-}\n", + "{-# LANGUAGE OverloadedStrings #-}\n", + "{-# LANGUAGE TypeFamilies #-}" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "metadata": {}, + "outputs": [], + "source": [ + "-- import Prelude hiding ((++))\n", + "import Data.Text (Text)\n", + "import qualified Data.Text as T\n", + "import qualified Data.Text.IO as TIO\n", + "\n", + "import Text.Megaparsec hiding (State)\n", + "import qualified Text.Megaparsec.Lexer as L\n", + "import Text.Megaparsec.Text (Parser)\n", + "import qualified Control.Applicative as CA\n", + "\n", + "import qualified Data.Map as M\n", + "import Data.Map ((!))\n", + "\n", + "import Control.Monad (when, unless)\n", + "import Control.Monad.State.Lazy\n", + "import Control.Monad.Reader\n", + "import Control.Monad.Writer" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "metadata": {}, + "outputs": [], + "source": [ + "type TuringState = String\n", + "\n", + "type Tape = M.Map Integer Bool\n", + "\n", + "data StateTransition = StateTransition { writeValue :: Bool\n", + " , newState :: TuringState\n", + " , tapeMovement :: Integer\n", + " } deriving (Show, Eq)\n", + "\n", + "type RuleTrigger = (TuringState, Bool)\n", + "\n", + "type Rules = M.Map RuleTrigger StateTransition\n", + "\n", + "data Machine = Machine { state :: TuringState\n", + " , tape :: Tape\n", + " , tapeLocation :: Integer\n", + " , stepsRemaining :: Integer\n", + " } \n", + " deriving (Show, Eq)\n", + "\n", + "emptyMachine = Machine {state = \"unknown\", tape = M.empty, tapeLocation = 0, stepsRemaining = 0}\n", + "\n", + "type ProgrammedMachine = ReaderT Rules (State Machine) Int" + ] + }, + { + "cell_type": "code", + "execution_count": 4, + "metadata": {}, + "outputs": [], + "source": [ + "sc :: Parser ()\n", + "sc = L.space (skipSome spaceChar) CA.empty CA.empty\n", + "\n", + "lexeme = L.lexeme sc\n", + "integer = lexeme L.integer\n", + "symbol = L.symbol sc\n", + "fullstop = symbol \".\"\n", + "\n", + "commandP = between (symbol \"-\") fullstop\n", + "\n", + "writeValueP = (symbol \"1\" *> pure True) <|> (symbol \"0\" *> pure False)\n", + "writeP = commandP ((symbol \"Write the value\") *> writeValueP)\n", + "\n", + "directionP = (symbol \"left\" *> pure -1) <|> (symbol \"right\" *> pure 1)\n", + "tapeMovementP = commandP ((symbol \"Move one slot to the\") *> directionP)\n", + "\n", + "newStateP = commandP ((symbol \"Continue with state\") *> (some letterChar))\n", + "\n", + "stateTransitionP = stify <$> writeP <*> tapeMovementP <*> newStateP\n", + " where stify w t s = StateTransition {writeValue = w, newState = s, tapeMovement = t}\n", + " \n", + "currentValueP = (symbol \"If the current value is\") *> writeValueP <* (symbol \":\")\n", + " \n", + "stateWhenP = (,) <$> currentValueP <*> stateTransitionP\n", + " \n", + "stateDefP = (symbol \"In state\") *> (some letterChar) <* (symbol \":\")\n", + " \n", + "stateRulesP = rulify <$> stateDefP <*> (stateWhenP `sepBy` space)\n", + " where rulify s ts = M.fromList $ map (\\(v, t) -> ((s, v), t)) ts\n", + " \n", + "manyStateRulesP = M.unions <$> (stateRulesP `sepBy` space)\n", + "\n", + "startStateP = (symbol \"Begin in state\") *> (some letterChar) <* fullstop\n", + "stepsP = (symbol \"Perform a diagnostic checksum after\") *> integer <* (symbol \"steps\") <* fullstop\n", + "\n", + "machineDescriptionP = machineify <$> startStateP <*> stepsP <*> manyStateRulesP\n", + " where machineify initial limit rules = \n", + " ( emptyMachine { state = initial, stepsRemaining = limit }\n", + " , rules\n", + " )" + ] + }, + { + "cell_type": "code", + "execution_count": 5, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest writeP \"- Write the value 1.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 6, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "1" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest tapeMovementP \"- Move one slot to the right.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 7, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"Fallow\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest newStateP \"- Continue with state Fallow.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 8, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1}" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest stateTransitionP \"- Write the value 1.\\n - Move one slot to the right.\\n - Continue with state B.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 9, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "(True,StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1})" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest stateWhenP \"If the current value is 1:\\n - Write the value 1.\\n - Move one slot to the right.\\n - Continue with state B.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 10, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"A\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest stateDefP \"In state A:\"" + ] + }, + { + "cell_type": "code", + "execution_count": 11, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "[(False,StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1}),(True,StateTransition {writeValue = False, newState = \"F\", tapeMovement = -1})]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest (stateWhenP `sepBy` space) \"If the current value is 0:\\n - Write the value 1.\\n - Move one slot to the right.\\n - Continue with state B.\\n If the current value is 1:\\n - Write the value 0.\\n - Move one slot to the left.\\n - Continue with state F.\\n\"" + ] + }, + { + "cell_type": "code", + "execution_count": 12, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "fromList [((\"A\",False),StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1}),((\"A\",True),StateTransition {writeValue = False, newState = \"F\", tapeMovement = -1})]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest stateRulesP \"In state A:\\nIf the current value is 0:\\n - Write the value 1.\\n - Move one slot to the right.\\n - Continue with state B.\\n If the current value is 1:\\n - Write the value 0.\\n - Move one slot to the left.\\n - Continue with state F.\\n\"" + ] + }, + { + "cell_type": "code", + "execution_count": 13, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"A\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest startStateP \"Begin in state A.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 14, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "12994925" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "parseTest stepsP \"Perform a diagnostic checksum after 12994925 steps.\"" + ] + }, + { + "cell_type": "code", + "execution_count": 15, + "metadata": {}, + "outputs": [], + "source": [ + "successfulParse :: Text -> (Machine, Rules)\n", + "successfulParse input = \n", + " case parse machineDescriptionP \"input\" input of\n", + " Left _error -> (emptyMachine, M.empty)\n", + " Right machineRules -> machineRules" + ] + }, + { + "cell_type": "code", + "execution_count": 16, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "(Machine {state = \"A\", tape = fromList [], tapeLocation = 0, stepsRemaining = 12994925},fromList [((\"A\",False),StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1}),((\"A\",True),StateTransition {writeValue = False, newState = \"F\", tapeMovement = -1}),((\"B\",False),StateTransition {writeValue = False, newState = \"C\", tapeMovement = 1}),((\"B\",True),StateTransition {writeValue = False, newState = \"D\", tapeMovement = 1}),((\"C\",False),StateTransition {writeValue = True, newState = \"D\", tapeMovement = -1}),((\"C\",True),StateTransition {writeValue = True, newState = \"E\", tapeMovement = 1}),((\"D\",False),StateTransition {writeValue = False, newState = \"E\", tapeMovement = -1}),((\"D\",True),StateTransition {writeValue = False, newState = \"D\", tapeMovement = -1}),((\"E\",False),StateTransition {writeValue = False, newState = \"A\", tapeMovement = 1}),((\"E\",True),StateTransition {writeValue = True, newState = \"C\", tapeMovement = 1}),((\"F\",False),StateTransition {writeValue = True, newState = \"A\", tapeMovement = -1}),((\"F\",True),StateTransition {writeValue = True, newState = \"A\", tapeMovement = 1})])" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "text <- TIO.readFile \"../../data/advent25.txt\"\n", + "successfulParse text" + ] + }, + { + "cell_type": "code", + "execution_count": 24, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "(Machine {state = \"A\", tape = fromList [], tapeLocation = 0, stepsRemaining = 6},fromList [((\"A\",False),StateTransition {writeValue = True, newState = \"B\", tapeMovement = 1}),((\"A\",True),StateTransition {writeValue = False, newState = \"B\", tapeMovement = -1}),((\"B\",False),StateTransition {writeValue = True, newState = \"A\", tapeMovement = -1}),((\"B\",True),StateTransition {writeValue = True, newState = \"A\", tapeMovement = 1})])" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "text <- TIO.readFile \"advent25sample.txt\"\n", + "(sampleMachine, sampleRules) = successfulParse text\n", + "(sampleMachine, sampleRules)" + ] + }, + { + "cell_type": "code", + "execution_count": 26, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "
Redundant bracket
Found:
(tapeLocation m) + (tapeMovement transition)
Why Not:
tapeLocation m + (tapeMovement transition)
Redundant bracket
Found:
(tapeLocation m) + (tapeMovement transition)
Why Not:
(tapeLocation m) + tapeMovement transition
" + ], + "text/plain": [ + "Line 7: Redundant bracket\n", + "Found:\n", + "(tapeLocation m) + (tapeMovement transition)\n", + "Why not:\n", + "tapeLocation m + (tapeMovement transition)Line 7: Redundant bracket\n", + "Found:\n", + "(tapeLocation m) + (tapeMovement transition)\n", + "Why not:\n", + "(tapeLocation m) + tapeMovement transition" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "executeStep = \n", + " do rules <- ask\n", + " m <- get\n", + " let tapeHere = M.findWithDefault False (tapeLocation m) (tape m)\n", + " let transition = rules!(state m, tapeHere)\n", + " let tape' = M.insert (tapeLocation m) (writeValue transition) (tape m)\n", + " let loc' = (tapeLocation m) + (tapeMovement transition)\n", + " let state' = newState transition\n", + " let steps' = stepsRemaining m - 1\n", + " let m' = m {state = state', tape = tape', tapeLocation = loc', stepsRemaining = steps'}\n", + " put m'\n", + " " + ] + }, + { + "cell_type": "code", + "execution_count": 27, + "metadata": {}, + "outputs": [], + "source": [ + "executeSteps = \n", + " do m <- get\n", + " unless (stepsRemaining m == 0) $\n", + " do executeStep\n", + " executeSteps" + ] + }, + { + "cell_type": "code", + "execution_count": 28, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "
Eta reduce
Found:
part1 rules machine0\n", + " = runState (runReaderT executeSteps rules) machine0
Why Not:
part1 rules = runState (runReaderT executeSteps rules)
" + ], + "text/plain": [ + "Line 1: Eta reduce\n", + "Found:\n", + "part1 rules machine0\n", + " = runState (runReaderT executeSteps rules) machine0\n", + "Why not:\n", + "part1 rules = runState (runReaderT executeSteps rules)" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "part1 rules machine0 = \n", + " runState (\n", + " runReaderT executeSteps\n", + " rules \n", + " ) \n", + " machine0" + ] + }, + { + "cell_type": "code", + "execution_count": 29, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "((),Machine {state = \"B\", tape = fromList [(0,True)], tapeLocation = 1, stepsRemaining = 5})" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "runState ( runReaderT executeStep sampleRules ) sampleMachine" + ] + }, + { + "cell_type": "code", + "execution_count": 33, + "metadata": {}, + "outputs": [], + "source": [ + "main :: IO ()\n", + "main = do \n", + " text <- TIO.readFile \"../../data/advent25.txt\"\n", + " let (machine0, rules) = successfulParse text\n", + " let (result, machinef) = part1 rules machine0\n", + " print $ M.size $ M.filter id $ tape machinef\n" + ] + }, + { + "cell_type": "code", + "execution_count": 31, + "metadata": {}, + "outputs": [], + "source": [ + "-- main :: IO ()\n", + "-- main = do \n", + "-- text <- TIO.readFile \"advent25sample.txt\"\n", + "-- let (machine0, rules) = successfulParse text\n", + "-- let (result, machinef) = part1 rules machine0\n", + "-- print $ M.size $ M.filter id $ tape machinef\n" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "main" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Haskell", + "language": "haskell", + "name": "haskell" + }, + "language_info": { + "codemirror_mode": "ihaskell", + "file_extension": ".hs", + "name": "haskell", + "version": "8.0.2" + } + }, + "nbformat": 4, + "nbformat_minor": 2 +} diff --git a/src/advent25/advent25sample.txt b/src/advent25/advent25sample.txt new file mode 100644 index 0000000..52c31b4 --- /dev/null +++ b/src/advent25/advent25sample.txt @@ -0,0 +1,22 @@ +Begin in state A. +Perform a diagnostic checksum after 6 steps. + +In state A: + If the current value is 0: + - Write the value 1. + - Move one slot to the right. + - Continue with state B. + If the current value is 1: + - Write the value 0. + - Move one slot to the left. + - Continue with state B. + +In state B: + If the current value is 0: + - Write the value 1. + - Move one slot to the left. + - Continue with state A. + If the current value is 1: + - Write the value 1. + - Move one slot to the right. + - Continue with state A. \ No newline at end of file -- 2.34.1