--- /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.Strict as M\n",
+ "import Data.Map.Strict ((!))\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": [
+ "data Location = Literal Integer | Register Char deriving (Show, Eq)\n",
+ "data Instruction = Snd Location\n",
+ " | Set Location Location \n",
+ " | Add Location Location \n",
+ " | Mul Location Location\n",
+ " | Mod Location Location\n",
+ " | Rcv Location\n",
+ " | Jgz Location Location\n",
+ " deriving (Show, Eq)\n",
+ "\n",
+ "data Machine = Machine { registers :: M.Map Char Integer\n",
+ " , pc :: Int\n",
+ " , messageQueue :: [Integer]\n",
+ " } \n",
+ " deriving (Show, Eq)\n",
+ "\n",
+ "data MachinePair = MachinePair { machine0 :: Machine \n",
+ " , machine1 :: Machine \n",
+ " } deriving (Show, Eq)\n",
+ "\n",
+ "type ProgrammedMachinePair = WriterT [String] (ReaderT [Instruction] (State MachinePair)) ()"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 4,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "emptyMachine = Machine {registers = M.empty, messageQueue = [], pc = 0}\n",
+ "\n",
+ "emptyMachinePair = MachinePair { machine0 = emptyMachine {registers = M.singleton 'p' 0}\n",
+ " , machine1 = emptyMachine {registers = M.singleton 'p' 1}\n",
+ " }"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 5,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "sc :: Parser ()\n",
+ "sc = L.space (skipSome spaceChar) CA.empty CA.empty\n",
+ "\n",
+ "lexeme = L.lexeme sc\n",
+ "\n",
+ "integer = lexeme L.integer\n",
+ "signedInteger = L.signed sc integer\n",
+ "\n",
+ "symb = L.symbol sc\n",
+ "\n",
+ "reg = lexeme (some letterChar)\n",
+ "\n",
+ "location = (Literal <$> signedInteger) <|> register\n",
+ "register = (Register . head) <$> reg\n",
+ "\n",
+ "instructionsP = instructionP `sepBy` space\n",
+ "instructionP = choice [sndP, setP, addP, mulP, modP, rcvP, jgzP]\n",
+ "\n",
+ "sndP = Snd <$> (try (symb \"snd\") *> location)\n",
+ "setP = Set <$> (try (symb \"set\") *> register) <*> location\n",
+ "addP = Add <$> (try (symb \"add\") *> register) <*> location\n",
+ "mulP = Mul <$> (try (symb \"mul\") *> register) <*> location\n",
+ "modP = Mod <$> (try (symb \"mod\") *> register) <*> location\n",
+ "rcvP = Rcv <$> (try (symb \"rcv\") *> location)\n",
+ "jgzP = Jgz <$> (try (symb \"jgz\") *> location) <*> location\n",
+ "\n",
+ "successfulParse :: Text -> [Instruction]\n",
+ "successfulParse input = \n",
+ " case parse instructionsP \"input\" input of\n",
+ " Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err\n",
+ " Right instructions -> instructions"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 6,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "sample = T.pack \"set a 1\\nadd a 2\\nmul a a\\nmod a 5\\nsnd a\\nset a 0\\nrcv a\\njgz a -1\\nset a 1\\njgz a -2\""
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 7,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "[Set (Register 'a') (Literal 1),Add (Register 'a') (Literal 2),Mul (Register 'a') (Register 'a'),Mod (Register 'a') (Literal 5),Snd (Register 'a'),Set (Register 'a') (Literal 0),Rcv (Register 'a'),Jgz (Register 'a') (Literal (-1)),Set (Register 'a') (Literal 1),Jgz (Register 'a') (Literal (-2))]"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "successfulParse sample"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 8,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "[Set (Register 'a') (Literal 1),Add (Register 'a') (Literal 2),Mul (Register 'a') (Register 'a'),Mod (Register 'a') (Literal 5),Snd (Register 'a'),Set (Register 'a') (Literal 0),Rcv (Register 'a'),Jgz (Register 'a') (Literal (-1)),Set (Register 'a') (Literal 1),Jgz (Register 'a') (Literal (-2))]"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "sampleInstructions = successfulParse sample\n",
+ "sampleInstructions"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 9,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "evaluate :: Machine -> Location -> Integer\n",
+ "evaluate _ (Literal i) = i\n",
+ "evaluate m (Register r) = M.findWithDefault 0 r (registers m)"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 10,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "applyInstruction :: Instruction -> [Integer] -> Machine -> (Machine, [Integer])\n",
+ "\n",
+ "applyInstruction (Snd a) other m = (m {registers = reg', pc = pc'}, other ++ [y])\n",
+ " where pc' = pc m + 1\n",
+ " y = evaluate m a\n",
+ " sentCount = evaluate m (Register 'x')\n",
+ " reg' = M.insert 'x' (sentCount + 1) $ registers m\n",
+ "\n",
+ "applyInstruction (Set (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
+ " where pc' = pc m + 1\n",
+ " y = evaluate m b\n",
+ " reg' = M.insert a y $ registers m\n",
+ "\n",
+ "applyInstruction (Add (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
+ " where pc' = pc m + 1\n",
+ " x = evaluate m (Register a) \n",
+ " y = evaluate m b\n",
+ " reg' = M.insert a (x + y) $ registers m\n",
+ "\n",
+ "applyInstruction (Mul (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
+ " where pc' = pc m + 1\n",
+ " x = evaluate m (Register a) \n",
+ " y = evaluate m b\n",
+ " reg' = M.insert a (x * y) $ registers m\n",
+ "\n",
+ "applyInstruction (Mod (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
+ " where pc' = pc m + 1\n",
+ " x = evaluate m (Register a) \n",
+ " y = evaluate m b\n",
+ " reg' = M.insert a (x `mod` y) $ registers m\n",
+ "\n",
+ "applyInstruction (Rcv (Register a)) other m = ( m {registers = reg', messageQueue = mq', pc = pc'}, other)\n",
+ " where pc' = pc m + 1\n",
+ " reg' = M.insert a (head $ messageQueue m) $ registers m\n",
+ " mq' = tail $ messageQueue m\n",
+ " \n",
+ "applyInstruction (Jgz a b) other m = (m {pc = pc'}, other)\n",
+ " where x = evaluate m a\n",
+ " y = evaluate m b\n",
+ " pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 11,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "isReceive :: Instruction -> Bool\n",
+ "isReceive (Rcv _) = True\n",
+ "isReceive _ = False"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 12,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "isSend :: Instruction -> Bool\n",
+ "isSend (Snd _) = True\n",
+ "isSend _ = False"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 13,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "executeInstruction :: Bool -> ProgrammedMachinePair\n",
+ "executeInstruction m0Active =\n",
+ " do instrs <- ask\n",
+ " mp <- get\n",
+ " let (ma, mb) = if m0Active \n",
+ " then (machine0 mp, machine1 mp) \n",
+ " else (machine1 mp, machine0 mp)\n",
+ " let mq = messageQueue mb\n",
+ " let instr = instrs!!(pc ma)\n",
+ " let (ma', mq') = applyInstruction instr mq ma\n",
+ " let mb' = mb {messageQueue = mq'}\n",
+ " let mp' = if m0Active then mp {machine0 = ma', machine1 = mb'}\n",
+ " else mp {machine0 = mb', machine1 = ma'}\n",
+ " put mp'"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 14,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "send :: Instruction -> Machine -> Integer\n",
+ "send (Snd a) m = evaluate m a\n",
+ "send _ _ = 0"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 26,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "executeInstructions = \n",
+ " do instrs <- ask\n",
+ " mp <- get\n",
+ " let m0 = machine0 mp\n",
+ " let m1 = machine1 mp\n",
+ " let instr0 = instrs !! pc m0\n",
+ " let m0Blocked = isReceive instr0 && null (messageQueue m0)\n",
+ " let instr1 = instrs !! pc m1\n",
+ " let m1Blocked = isReceive instr1 && null (messageQueue m1)\n",
+ " let (ma, mb) = if m0Blocked then (m1, m0) else (m0, m1)\n",
+ " \n",
+ " unless (m0Blocked && m1Blocked)\n",
+ " $\n",
+ " when (pc ma >= 0 && pc ma < length instrs)\n",
+ " $\n",
+ " do let m0Active = not m0Blocked\n",
+ " when (m0Blocked && isSend instr1) (tell [\"sending: \" ++ show mp])\n",
+ " executeInstruction m0Active\n",
+ " executeInstructions\n"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 27,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "(((),[\"sending: MachinePair {machine0 = Machine {registers = fromList [('a',0),('p',0),('x',1)], pc = 6, messageQueue = []}, machine1 = Machine {registers = fromList [('a',4),('p',1)], pc = 4, messageQueue = [4]}}\"]),MachinePair {machine0 = Machine {registers = fromList [('a',4),('p',0),('x',1)], pc = 6, messageQueue = []}, machine1 = Machine {registers = fromList [('a',4),('p',1),('x',1)], pc = 6, messageQueue = []}})"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "runState (runReaderT (runWriterT executeInstructions) sampleInstructions ) emptyMachinePair"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 28,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "sampleInstructions2 = successfulParse \"snd 1\\nsnd 2\\nsnd p\\nrcv a\\nrcv b\\nrcv c\\nrcv d\""
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 29,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "(((),[\"sending: MachinePair {machine0 = Machine {registers = fromList [('p',0),('x',3)], pc = 3, messageQueue = []}, machine1 = Machine {registers = fromList [('p',1)], pc = 0, messageQueue = [1,2,0]}}\",\"sending: MachinePair {machine0 = Machine {registers = fromList [('a',1),('p',0),('x',3)], pc = 4, messageQueue = []}, machine1 = Machine {registers = fromList [('p',1),('x',1)], pc = 1, messageQueue = [1,2,0]}}\",\"sending: MachinePair {machine0 = Machine {registers = fromList [('a',1),('b',2),('p',0),('x',3)], pc = 5, messageQueue = []}, machine1 = Machine {registers = fromList [('p',1),('x',2)], pc = 2, messageQueue = [1,2,0]}}\"]),MachinePair {machine0 = Machine {registers = fromList [('a',1),('b',2),('c',1),('p',0),('x',3)], pc = 6, messageQueue = []}, machine1 = Machine {registers = fromList [('a',1),('b',2),('c',0),('p',1),('x',3)], pc = 6, messageQueue = []}})"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "runState (runReaderT (runWriterT executeInstructions) sampleInstructions2 ) emptyMachinePair"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 30,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "(((),[\"sending: MachinePair {machine0 = Machine {registers = fromList [('a',0),('p',0),('x',1)], pc = 6, messageQueue = []}, machine1 = Machine {registers = fromList [('a',4),('p',1)], pc = 4, messageQueue = [4]}}\"]),MachinePair {machine0 = Machine {registers = fromList [('a',4),('p',0),('x',1)], pc = 6, messageQueue = []}, machine1 = Machine {registers = fromList [('a',4),('p',1),('x',1)], pc = 6, messageQueue = []}})"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "runState (\n",
+ " runReaderT (\n",
+ " runWriterT executeInstructions\n",
+ " ) \n",
+ " sampleInstructions\n",
+ " ) \n",
+ " emptyMachinePair"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 31,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "[Set (Register 'a') (Literal 1),Add (Register 'a') (Literal 2),Mul (Register 'a') (Register 'a'),Mod (Register 'a') (Literal 5),Snd (Register 'a'),Set (Register 'a') (Literal 0),Rcv (Register 'a'),Jgz (Register 'a') (Literal (-1)),Set (Register 'a') (Literal 1),Jgz (Register 'a') (Literal (-2))]"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "sampleInstructions"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 32,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "part2 instructions = \n",
+ " runState (\n",
+ " runReaderT (\n",
+ " runWriterT executeInstructions\n",
+ " ) \n",
+ " instructions \n",
+ " ) \n",
+ " emptyMachinePair"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 35,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "main :: IO ()\n",
+ "main = do \n",
+ " text <- TIO.readFile \"../../data/advent18.txt\"\n",
+ " let instrs = successfulParse text\n",
+ " let ((result, l), statef) = part2 instrs\n",
+ " print $ length l"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 36,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "5969"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "main"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 24,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "11938"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "5969*2"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 25,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "12065"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "5969+6096"
+ ]
+ },
+ {
+ "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
+}
projects / advent-of-code-17.git / blobdiff