X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=src%2Fadvent18%2Fadvent18b.ipynb;fp=src%2Fadvent18%2Fadvent18b.ipynb;h=56bc384c3e199d34f5fa5407ae9a3bb80747a470;hb=eefbb6bc370b6ae9c2ad16f7daaeac78642025d3;hp=0000000000000000000000000000000000000000;hpb=9ce2b21f9734aa6e51186d2cc0075083a5864155;p=advent-of-code-17.git diff --git a/src/advent18/advent18b.ipynb b/src/advent18/advent18b.ipynb new file mode 100644 index 0000000..56bc384 --- /dev/null +++ b/src/advent18/advent18b.ipynb @@ -0,0 +1,511 @@ +{ + "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 +}