--- /dev/null
+{
+ "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": [
+ "<style>/* Styles used for the Hoogle display in the pager */\n",
+ ".hoogle-doc {\n",
+ "display: block;\n",
+ "padding-bottom: 1.3em;\n",
+ "padding-left: 0.4em;\n",
+ "}\n",
+ ".hoogle-code {\n",
+ "display: block;\n",
+ "font-family: monospace;\n",
+ "white-space: pre;\n",
+ "}\n",
+ ".hoogle-text {\n",
+ "display: block;\n",
+ "}\n",
+ ".hoogle-name {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-head {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-sub {\n",
+ "display: block;\n",
+ "margin-left: 0.4em;\n",
+ "}\n",
+ ".hoogle-package {\n",
+ "font-weight: bold;\n",
+ "font-style: italic;\n",
+ "}\n",
+ ".hoogle-module {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-class {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".get-type {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "font-family: monospace;\n",
+ "display: block;\n",
+ "white-space: pre-wrap;\n",
+ "}\n",
+ ".show-type {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "font-family: monospace;\n",
+ "margin-left: 1em;\n",
+ "}\n",
+ ".mono {\n",
+ "font-family: monospace;\n",
+ "display: block;\n",
+ "}\n",
+ ".err-msg {\n",
+ "color: red;\n",
+ "font-style: italic;\n",
+ "font-family: monospace;\n",
+ "white-space: pre;\n",
+ "display: block;\n",
+ "}\n",
+ "#unshowable {\n",
+ "color: red;\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".err-msg.in.collapse {\n",
+ "padding-top: 0.7em;\n",
+ "}\n",
+ ".highlight-code {\n",
+ "white-space: pre;\n",
+ "font-family: monospace;\n",
+ "}\n",
+ ".suggestion-warning { \n",
+ "font-weight: bold;\n",
+ "color: rgb(200, 130, 0);\n",
+ "}\n",
+ ".suggestion-error { \n",
+ "font-weight: bold;\n",
+ "color: red;\n",
+ "}\n",
+ ".suggestion-name {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ "</style><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(tapeLocation m) + (tapeMovement transition)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">tapeLocation m + (tapeMovement transition)</div></div><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(tapeLocation m) + (tapeMovement transition)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">(tapeLocation m) + tapeMovement transition</div></div>"
+ ],
+ "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": [
+ "<style>/* Styles used for the Hoogle display in the pager */\n",
+ ".hoogle-doc {\n",
+ "display: block;\n",
+ "padding-bottom: 1.3em;\n",
+ "padding-left: 0.4em;\n",
+ "}\n",
+ ".hoogle-code {\n",
+ "display: block;\n",
+ "font-family: monospace;\n",
+ "white-space: pre;\n",
+ "}\n",
+ ".hoogle-text {\n",
+ "display: block;\n",
+ "}\n",
+ ".hoogle-name {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-head {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-sub {\n",
+ "display: block;\n",
+ "margin-left: 0.4em;\n",
+ "}\n",
+ ".hoogle-package {\n",
+ "font-weight: bold;\n",
+ "font-style: italic;\n",
+ "}\n",
+ ".hoogle-module {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".hoogle-class {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".get-type {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "font-family: monospace;\n",
+ "display: block;\n",
+ "white-space: pre-wrap;\n",
+ "}\n",
+ ".show-type {\n",
+ "color: green;\n",
+ "font-weight: bold;\n",
+ "font-family: monospace;\n",
+ "margin-left: 1em;\n",
+ "}\n",
+ ".mono {\n",
+ "font-family: monospace;\n",
+ "display: block;\n",
+ "}\n",
+ ".err-msg {\n",
+ "color: red;\n",
+ "font-style: italic;\n",
+ "font-family: monospace;\n",
+ "white-space: pre;\n",
+ "display: block;\n",
+ "}\n",
+ "#unshowable {\n",
+ "color: red;\n",
+ "font-weight: bold;\n",
+ "}\n",
+ ".err-msg.in.collapse {\n",
+ "padding-top: 0.7em;\n",
+ "}\n",
+ ".highlight-code {\n",
+ "white-space: pre;\n",
+ "font-family: monospace;\n",
+ "}\n",
+ ".suggestion-warning { \n",
+ "font-weight: bold;\n",
+ "color: rgb(200, 130, 0);\n",
+ "}\n",
+ ".suggestion-error { \n",
+ "font-weight: bold;\n",
+ "color: red;\n",
+ "}\n",
+ ".suggestion-name {\n",
+ "font-weight: bold;\n",
+ "}\n",
+ "</style><div class=\"suggestion-name\" style=\"clear:both;\">Eta reduce</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">part1 rules machine0\n",
+ " = runState (runReaderT executeSteps rules) machine0</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">part1 rules = runState (runReaderT executeSteps rules)</div></div>"
+ ],
+ "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
+}