--- /dev/null
+set i 31
+set a 1
+mul p 17
+jgz p p
+mul a 2
+add i -1
+jgz i -2
+add a -1
+set i 127
+set p 464
+mul p 8505
+mod p a
+mul p 129749
+add p 12345
+mod p a
+set b p
+mod b 10000
+snd b
+add i -1
+jgz i -9
+jgz a 3
+rcv b
+jgz b -1
+set f 0
+set i 126
+rcv a
+rcv b
+set p a
+mul p -1
+add p b
+jgz p 4
+snd a
+set a b
+jgz 1 3
+snd b
+set f 1
+add i -1
+jgz i -11
+snd a
+jgz f -16
+jgz a -19
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html>
+<html lang="en-us">
+<head>
+<meta charset="utf-8"/>
+<title>Day 18 - Advent of Code 2017</title>
+<!--[if lt IE 9]><script src="/static/html5.js"></script><![endif]-->
+<link href='//fonts.googleapis.com/css?family=Source+Code+Pro:300&subset=latin,latin-ext' rel='stylesheet' type='text/css'>
+<link rel="stylesheet" type="text/css" href="/static/style.css?12"/>
+<link rel="stylesheet alternate" type="text/css" href="/static/highcontrast.css?0" title="High Contrast"/>
+<link rel="shortcut icon" href="/favicon.ico?2"/>
+</head><!--
+
+
+
+
+Oh, hello! Funny seeing you here.
+
+I appreciate your enthusiasm, but you aren't going to find much down here.
+There certainly aren't clues to any of the puzzles. The best surprises don't
+even appear in the source until you unlock them for real.
+
+Please be careful with automated requests; I'm not Google, and I can only take
+so much traffic. Please be considerate so that everyone gets to play.
+
+If you're curious about how Advent of Code works, it's running on some custom
+Perl code. Other than a few integrations (auth, analytics, ads, social media),
+I built the whole thing myself, including the design, animations, prose, and
+all of the puzzles.
+
+The puzzles probably took the longest; the easiest ones took an hour or two
+each, but the harder ones took 4-5 hours, and a few even longer than that. A
+lot of effort went into building this thing - I hope you're enjoying playing it
+as much as I enjoyed making it for you!
+
+If you'd like to hang out, I'm @ericwastl on Twitter.
+
+- Eric Wastl
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+-->
+<body>
+<header><div><h1 class="title-global"><a href="/">Advent of Code</a></h1><nav><ul><li><a href="/2017/about">[About]</a></li><li><a href="/2017/support">[AoC++]</a></li><li><a href="/2017/events">[Events]</a></li><li><a href="/2017/settings">[Settings]</a></li><li><a href="/2017/auth/logout">[Log Out]</a></li></ul></nav><div class="user">Neil Smith <span class="supporter">(AoC++)</span> <span class="star-count">36*</span></div></div><div><h1 class="title-event"> <span class="title-event-wrap">/*</span><a href="/2017">2017</a><span class="title-event-wrap">*/</span></h1><nav><ul><li><a href="/2017">[Calendar]</a></li><li><a href="/2017/leaderboard">[Leaderboard]</a></li><li><a href="/2017/stats">[Stats]</a></li><li><a href="/2017/sponsors">[Sponsors]</a></li></ul></nav></div></header>
+
+<div id="sidebar">
+<div id="sponsor"><div class="quiet">Our <a href="/2017/sponsors">sponsors</a> help make Advent of Code possible:</div><p><a href="http://winton.com/" target="_blank" onclick="if(ga)ga('send','event','sponsor','click',this.href);" rel="noopener">Winton</a> - a data science and investment management company</p></div>
+<p class="quiet">By popular demand, there are now AoC-themed objects available (until Jan. 3rd)! Get them shipped <a href="https://teespring.com/advent-of-code" target="_blank">from the US</a> or <a href="https://teespring.com/advent-of-code-eu" target="_blank">from Europe</a>.</p>
+
+</div><!--/sidebar-->
+
+<main>
+<article class="day-desc"><h2>--- Day 18: Duet ---</h2><p>You discover a tablet containing some strange assembly code labeled simply "<a href="https://en.wikipedia.org/wiki/Duet">Duet</a>". Rather than bother the sound card with it, you decide to run the code yourself. Unfortunately, you don't see any documentation, so you're left to figure out what the instructions mean on your own.</p>
+<p>It seems like the assembly is meant to operate on a set of <em>registers</em> that are each named with a single letter and that can each hold a single <a href="https://en.wikipedia.org/wiki/Integer">integer</a>. You suppose each register should start with a value of <code>0</code>.</p>
+<p>There aren't that many instructions, so it shouldn't be hard to figure out what they do. Here's what you determine:</p>
+<ul>
+<li><code>snd X</code> <em><span title="I don't recommend actually trying this.">plays a sound</span></em> with a frequency equal to the value of <code>X</code>.</li>
+<li><code>set X Y</code> <em>sets</em> register <code>X</code> to the value of <code>Y</code>.</li>
+<li><code>add X Y</code> <em>increases</em> register <code>X</code> by the value of <code>Y</code>.</li>
+<li><code>mul X Y</code> sets register <code>X</code> to the result of <em>multiplying</em> the value contained in register <code>X</code> by the value of <code>Y</code>.</li>
+<li><code>mod X Y</code> sets register <code>X</code> to the <em>remainder</em> of dividing the value contained in register <code>X</code> by the value of <code>Y</code> (that is, it sets <code>X</code> to the result of <code>X</code> <a href="https://en.wikipedia.org/wiki/Modulo_operation">modulo</a> <code>Y</code>).</li>
+<li><code>rcv X</code> <em>recovers</em> the frequency of the last sound played, but only when the value of <code>X</code> is not zero. (If it is zero, the command does nothing.)</li>
+<li><code>jgz X Y</code> <em>jumps</em> with an offset of the value of <code>Y</code>, but only if the value of <code>X</code> is <em>greater than zero</em>. (An offset of <code>2</code> skips the next instruction, an offset of <code>-1</code> jumps to the previous instruction, and so on.)</li>
+</ul>
+<p>Many of the instructions can take either a register (a single letter) or a number. The value of a register is the integer it contains; the value of a number is that number.</p>
+<p>After each <em>jump</em> instruction, the program continues with the instruction to which the <em>jump</em> jumped. After any other instruction, the program continues with the next instruction. Continuing (or jumping) off either end of the program terminates it.</p>
+<p>For example:</p>
+<pre><code>set a 1
+add a 2
+mul a a
+mod a 5
+snd a
+set a 0
+rcv a
+jgz a -1
+set a 1
+jgz a -2
+</code></pre>
+<ul>
+<li>The first four instructions set <code>a</code> to <code>1</code>, add <code>2</code> to it, square it, and then set it to itself modulo <code>5</code>, resulting in a value of <code>4</code>.</li>
+<li>Then, a sound with frequency <code>4</code> (the value of <code>a</code>) is played.</li>
+<li>After that, <code>a</code> is set to <code>0</code>, causing the subsequent <code>rcv</code> and <code>jgz</code> instructions to both be skipped (<code>rcv</code> because <code>a</code> is <code>0</code>, and <code>jgz</code> because <code>a</code> is not greater than <code>0</code>).</li>
+<li>Finally, <code>a</code> is set to <code>1</code>, causing the next <code>jgz</code> instruction to activate, jumping back two instructions to another jump, which jumps again to the <code>rcv</code>, which ultimately triggers the <em>recover</em> operation.</li>
+</ul>
+<p>At the time the <em>recover</em> operation is executed, the frequency of the last sound played is <code>4</code>.</p>
+<p><em>What is the value of the recovered frequency</em> (the value of the most recently played sound) the <em>first</em> time a <code>rcv</code> instruction is executed with a non-zero value?</p>
+</article>
+<p>Your puzzle answer was <code>1187</code>.</p><article class="day-desc"><h2>--- Part Two ---</h2><p>As you congratulate yourself for a job well done, you notice that the documentation has been on the back of the tablet this entire time. While you actually got most of the instructions correct, there are a few key differences. This assembly code isn't about sound at all - it's meant to be run <em>twice at the same time</em>.</p>
+<p>Each running copy of the program has its own set of registers and follows the code independently - in fact, the programs don't even necessarily run at the same speed. To coordinate, they use the <em>send</em> (<code>snd</code>) and <em>receive</em> (<code>rcv</code>) instructions:</p>
+<ul>
+<li><code>snd X</code> <em>sends</em> the value of <code>X</code> to the other program. These values wait in a queue until that program is ready to receive them. Each program has its own message queue, so a program can never receive a message it sent.</li>
+<li><code>rcv X</code> <em>receives</em> the next value and stores it in register <code>X</code>. If no values are in the queue, the program <em>waits for a value to be sent to it</em>. Programs do not continue to the next instruction until they have received a value. Values are received in the order they are sent.</li>
+</ul>
+<p>Each program also has its own <em>program ID</em> (one <code>0</code> and the other <code>1</code>); the register <code>p</code> should begin with this value.</p>
+<p>For example:</p>
+<pre><code>snd 1
+snd 2
+snd p
+rcv a
+rcv b
+rcv c
+rcv d
+</code></pre>
+<p>Both programs begin by sending three values to the other. Program <code>0</code> sends <code>1, 2, 0</code>; program <code>1</code> sends <code>1, 2, 1</code>. Then, each program receives a value (both <code>1</code>) and stores it in <code>a</code>, receives another value (both <code>2</code>) and stores it in <code>b</code>, and then each receives the program ID of the other program (program <code>0</code> receives <code>1</code>; program <code>1</code> receives <code>0</code>) and stores it in <code>c</code>. Each program now sees a different value in its own copy of register <code>c</code>.</p>
+<p>Finally, both programs try to <code>rcv</code> a <em>fourth</em> time, but no data is waiting for either of them, and they reach a <em>deadlock</em>. When this happens, both programs terminate.</p>
+<p>It should be noted that it would be equally valid for the programs to run at different speeds; for example, program <code>0</code> might have sent all three values and then stopped at the first <code>rcv</code> before program <code>1</code> executed even its first instruction.</p>
+<p>Once both of your programs have terminated (regardless of what caused them to do so), <em>how many times did program <code>1</code> send a value</em>?</p>
+</article>
+<p>Your puzzle answer was <code>5969</code>.</p><p class="day-success">Both parts of this puzzle are complete! They provide two gold stars: **</p>
+<p>At this point, you should <a href="/2017">return to your advent calendar</a> and try another puzzle.</p>
+<p>If you still want to see it, you can <a href="18/input" target="_blank">get your puzzle input</a>.</p>
+<p>You can also <span class="share">[Share<span class="share-content">on
+ <a href="https://twitter.com/intent/tweet?text=I%27ve+completed+%22Duet%22+%2D+Day+18+%2D+Advent+of+Code+2017&url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F18&related=ericwastl&hashtags=AdventOfCode" target="_blank">Twitter</a>
+ <a href="https://plus.google.com/share?url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F18" target="_blank">Google+</a>
+ <a href="http://www.reddit.com/submit?url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F18&title=I%27ve+completed+%22Duet%22+%2D+Day+18+%2D+Advent+of+Code+2017" target="_blank">Reddit</a
+></span>]</span> this puzzle.</p>
+</main>
+
+<!-- ga -->
+<script>
+(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+})(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+ga('create', 'UA-69522494-1', 'auto');
+ga('send', 'pageview');
+</script>
+<!-- /ga -->
+</body>
+</html>
\ No newline at end of file
--- /dev/null
+module Advent18Parser (successfulParse, Location(..), Instruction(..)) where
+
+import Data.Text (Text)
+import Text.Megaparsec hiding (State)
+import qualified Text.Megaparsec.Lexer as L
+import Text.Megaparsec.Text (Parser)
+import qualified Control.Applicative as CA
+
+data Location = Literal Integer | Register Char deriving (Show, Eq)
+data Instruction = Snd Location
+ | Set Location Location
+ | Add Location Location
+ | Mul Location Location
+ | Mod Location Location
+ | Rcv Location
+ | Jgz Location Location
+ deriving (Show, Eq)
+
+
+sc :: Parser ()
+sc = L.space (skipSome spaceChar) CA.empty CA.empty
+
+lexeme = L.lexeme sc
+
+integer = lexeme L.integer
+signedInteger = L.signed sc integer
+
+symb = L.symbol sc
+reg = lexeme (some letterChar)
+
+location = (Literal <$> signedInteger) <|> register
+register = (Register . head) <$> reg
+
+instructionsP = instructionP `sepBy` space
+instructionP = choice [sndP, setP, addP, mulP, modP, rcvP, jgzP]
+
+sndP = Snd <$> (try (symb "snd") *> location)
+setP = Set <$> (try (symb "set") *> register) <*> location
+addP = Add <$> (try (symb "add") *> register) <*> location
+mulP = Mul <$> (try (symb "mul") *> register) <*> location
+modP = Mod <$> (try (symb "mod") *> register) <*> location
+rcvP = Rcv <$> (try (symb "rcv") *> location)
+jgzP = Jgz <$> (try (symb "jgz") *> location) <*> location
+
+successfulParse :: Text -> [Instruction]
+successfulParse input =
+ case parse instructionsP "input" input of
+ Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+ Right instructions -> instructions
\ No newline at end of file
--- /dev/null
+{-# 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 qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+
+import Control.Monad (when)
+import Control.Monad.State.Lazy
+import Control.Monad.Reader
+import Control.Monad.Writer
+
+import Advent18Parser
+
+data Machine = Machine { registers :: M.Map Char Integer
+ , lastSound :: Integer
+ , pc :: Int
+ }
+ deriving (Show, Eq)
+
+type ProgrammedMachine = WriterT [Integer] (ReaderT [Instruction] (State Machine)) ()
+
+emptyMachine = Machine {registers = M.empty, lastSound = 0, pc = 0}
+
+main :: IO ()
+main = do
+ text <- TIO.readFile "data/advent18.txt"
+ let instrs = successfulParse text
+ let ((result, l), machinef) = part1 instrs
+ print $ head l
+
+part1 :: [Instruction] -> (((), [Integer]), Machine)
+part1 instructions =
+ runState (
+ runReaderT (
+ runWriterT executeInstructions
+ )
+ instructions
+ )
+ emptyMachine
+
+executeInstructions :: ProgrammedMachine
+executeInstructions =
+ do instrs <- ask
+ m <- get
+ when (pc m >= 0 && pc m < length instrs)
+ $
+ do let rt = recoverTriggers instrs m
+ if rt
+ then tell [lastSound m]
+ else do executeInstruction
+ executeInstructions
+
+executeInstruction :: ProgrammedMachine
+executeInstruction =
+ do instrs <- ask
+ m <- get
+ let instr = instrs!!(pc m)
+ put (applyInstruction instr m)
+
+
+isRecover :: Instruction -> Bool
+isRecover (Rcv _) = True
+isRecover _ = False
+
+
+recoverTriggers :: [Instruction] -> Machine -> Bool
+recoverTriggers instrs m =
+ if isRecover instr
+ then (x /= 0)
+ else False
+ where instr = instrs!!(pc m)
+ Rcv a = instr
+ x = evaluate m a
+
+
+applyInstruction :: Instruction -> Machine -> Machine
+
+applyInstruction (Snd sound) m = m {lastSound = freq, pc = pc'}
+ where pc' = pc m + 1
+ freq = evaluate m sound
+
+applyInstruction (Set (Register a) b) m = m {registers = reg', pc = pc'}
+ where pc' = pc m + 1
+ y = evaluate m b
+ reg' = M.insert a y $ registers m
+
+applyInstruction (Add (Register a) b) m = m {registers = reg', pc = pc'}
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x + y) $ registers m
+
+applyInstruction (Mul (Register a) b) m = m {registers = reg', pc = pc'}
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x * y) $ registers m
+
+applyInstruction (Mod (Register a) b) m = m {registers = reg', pc = pc'}
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x `mod` y) $ registers m
+
+applyInstruction (Rcv _a) m = m {pc = pc'}
+ where pc' = pc m + 1
+
+applyInstruction (Jgz a b) m = m {pc = pc'}
+ where x = evaluate m a
+ y = evaluate m b
+ pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1
+
+
+evaluate :: Machine -> Location -> Integer
+evaluate _ (Literal i) = i
+evaluate m (Register r) = M.findWithDefault 0 r (registers m)
+
--- /dev/null
+{
+ "cells": [
+ {
+ "cell_type": "code",
+ "execution_count": 47,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "{-# LANGUAGE NegativeLiterals #-}\n",
+ "{-# LANGUAGE FlexibleContexts #-}\n",
+ "{-# LANGUAGE OverloadedStrings #-}\n",
+ "{-# LANGUAGE TypeFamilies #-}"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 48,
+ "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)\n",
+ "import Control.Monad.State.Lazy\n",
+ "import Control.Monad.Reader\n",
+ "import Control.Monad.Writer"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 49,
+ "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",
+ " , lastSound :: Integer\n",
+ " , pc :: Int\n",
+ " } \n",
+ " deriving (Show, Eq)\n",
+ "\n",
+ "type ProgrammedMachine = WriterT [Integer] (ReaderT [Instruction] (State Machine)) ()"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 50,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "emptyMachine = Machine {registers = M.empty, lastSound = 0, pc = 0}"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 51,
+ "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 :: Parser String\n",
+ "-- reg = id <$> some letterChar\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": 52,
+ "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": 53,
+ "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": 54,
+ "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": 55,
+ "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": 56,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "applyInstruction :: Instruction -> Machine -> Machine\n",
+ "\n",
+ "applyInstruction (Snd sound) m = m {lastSound = freq, pc = pc'}\n",
+ " where pc' = pc m + 1\n",
+ " freq = evaluate m sound\n",
+ "\n",
+ "applyInstruction (Set (Register a) b) m = m {registers = reg', pc = pc'}\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) m = m {registers = reg', pc = pc'}\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) m = m {registers = reg', pc = pc'}\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) m = m {registers = reg', pc = pc'}\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 a) m = m {pc = pc'}\n",
+ " where pc' = pc m + 1\n",
+ " \n",
+ "applyInstruction (Jgz a b) m = m {pc = pc'}\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": 57,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "executeInstruction :: ProgrammedMachine\n",
+ "executeInstruction =\n",
+ " do instrs <- ask\n",
+ " m <- get\n",
+ " let instr = instrs!!(pc m)\n",
+ "-- tell [(\"pc = \" ++ show (pc m))]\n",
+ " put (applyInstruction instr m)"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 58,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "isRecover :: Instruction -> Bool\n",
+ "isRecover (Rcv _) = True\n",
+ "isRecover _ = False"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 59,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "-- handleRecover :: ProgrammedMachine\n",
+ "-- handleRecover = \n",
+ "-- do instrs <- ask\n",
+ "-- m <- get\n",
+ "-- let instr = instrs!!(pc m)\n",
+ "-- when (isReceive instr)\n",
+ "-- $\n",
+ "-- do let Rcv a = instr\n",
+ "-- let x = evaluate m a\n",
+ "-- when (x /= 0) (tell ([\"reccovering \" ++ (show (lastSound m))]))"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 60,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "recoverTriggers :: [Instruction] -> Machine -> Bool\n",
+ "recoverTriggers instrs m = \n",
+ " if isRecover instr\n",
+ " then (x /= 0)\n",
+ " else False\n",
+ " where instr = instrs!!(pc m)\n",
+ " Rcv a = instr\n",
+ " x = evaluate m a"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 61,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "executeInstructions = \n",
+ " do instrs <- ask\n",
+ " m <- get\n",
+ "-- tell [\"instrs = \" ++ (show instrs)]\n",
+ " when (pc m >= 0 && pc m < length instrs)\n",
+ " $\n",
+ " do let rt = recoverTriggers instrs m\n",
+ " if rt\n",
+ " then tell [lastSound m]\n",
+ " else do executeInstruction\n",
+ " executeInstructions"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": null,
+ "metadata": {},
+ "outputs": [],
+ "source": []
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 62,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "(((),[4]),Machine {registers = fromList [('a',1)], lastSound = 4, pc = 6})"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "runState (runReaderT (runWriterT executeInstructions) sampleInstructions ) emptyMachine"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 63,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "(((),[]),Machine {registers = fromList [('a',0)], lastSound = 4, pc = 7})"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "source": [
+ "runState (\n",
+ " runReaderT (\n",
+ " runWriterT executeInstructions\n",
+ " ) \n",
+ " (take 7 sampleInstructions) \n",
+ " ) \n",
+ " emptyMachine"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 64,
+ "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": 65,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "part1 instructions = \n",
+ " runState (\n",
+ " runReaderT (\n",
+ " runWriterT executeInstructions\n",
+ " ) \n",
+ " instructions \n",
+ " ) \n",
+ " emptyMachine"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 68,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "main :: IO ()\n",
+ "main = do \n",
+ " text <- TIO.readFile \"../../data/advent18.txt\"\n",
+ " let instrs = successfulParse text\n",
+ " let ((result, l), machinef) = part1 instrs\n",
+ " print $ head l\n",
+ "-- print $ part2 instrs"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 69,
+ "metadata": {},
+ "outputs": [
+ {
+ "data": {
+ "text/plain": [
+ "1187"
+ ]
+ },
+ "metadata": {},
+ "output_type": "display_data"
+ }
+ ],
+ "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
+}
--- /dev/null
+{-# 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 qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+
+import Control.Monad (when, unless)
+import Control.Monad.State.Lazy
+import Control.Monad.Reader
+import Control.Monad.Writer
+
+import Advent18Parser
+
+
+data Machine = Machine { registers :: M.Map Char Integer
+ , pc :: Int
+ , messageQueue :: [Integer]
+ }
+ deriving (Show, Eq)
+
+data MachinePair = MachinePair { machine0 :: Machine
+ , machine1 :: Machine
+ } deriving (Show, Eq)
+
+type ProgrammedMachinePair = WriterT [String] (ReaderT [Instruction] (State MachinePair)) ()
+
+
+emptyMachine = Machine {registers = M.empty, messageQueue = [], pc = 0}
+
+emptyMachinePair = MachinePair { machine0 = emptyMachine {registers = M.singleton 'p' 0}
+ , machine1 = emptyMachine {registers = M.singleton 'p' 1}
+ }
+
+main :: IO ()
+main = do
+ text <- TIO.readFile "data/advent18.txt"
+ let instrs = successfulParse text
+ let ((result, l), statef) = part2 instrs
+ print $ length l
+
+part2 :: [Instruction] -> (((), [String]), MachinePair)
+part2 instructions =
+ runState (
+ runReaderT (
+ runWriterT executeInstructions
+ )
+ instructions
+ )
+ emptyMachinePair
+
+executeInstructions :: ProgrammedMachinePair
+executeInstructions =
+ do instrs <- ask
+ mp <- get
+ let m0 = machine0 mp
+ let m1 = machine1 mp
+ let instr0 = instrs !! pc m0
+ let m0Blocked = isReceive instr0 && null (messageQueue m0)
+ let instr1 = instrs !! pc m1
+ let m1Blocked = isReceive instr1 && null (messageQueue m1)
+ let (ma, mb) = if m0Blocked then (m1, m0) else (m0, m1)
+
+ unless (m0Blocked && m1Blocked)
+ $
+ when (pc ma >= 0 && pc ma < length instrs)
+ $
+ do let m0Active = not m0Blocked
+ when (m0Blocked && isSend instr1) (tell ["sending: " ++ show mp])
+ executeInstruction m0Active
+ executeInstructions
+
+executeInstruction :: Bool -> ProgrammedMachinePair
+executeInstruction m0Active =
+ do instrs <- ask
+ mp <- get
+ let (ma, mb) = if m0Active
+ then (machine0 mp, machine1 mp)
+ else (machine1 mp, machine0 mp)
+ let mq = messageQueue mb
+ let instr = instrs!!(pc ma)
+ let (ma', mq') = applyInstruction instr mq ma
+ let mb' = mb {messageQueue = mq'}
+ let mp' = if m0Active then mp {machine0 = ma', machine1 = mb'}
+ else mp {machine0 = mb', machine1 = ma'}
+ put mp'
+applyInstruction :: Instruction -> [Integer] -> Machine -> (Machine, [Integer])
+
+-- applyInstruction (Snd a) other m = (m {registers = reg', pc = pc'}, other ++ [y])
+-- where pc' = pc m + 1
+-- y = evaluate m a
+-- sentCount = evaluate m (Register 'x')
+-- reg' = M.insert 'x' (sentCount + 1) $ registers m
+applyInstruction (Snd a) other m = (m {pc = pc'}, other ++ [y])
+ where pc' = pc m + 1
+ y = evaluate m a
+
+applyInstruction (Set (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
+ where pc' = pc m + 1
+ y = evaluate m b
+ reg' = M.insert a y $ registers m
+
+applyInstruction (Add (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x + y) $ registers m
+
+applyInstruction (Mul (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x * y) $ registers m
+
+applyInstruction (Mod (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
+ where pc' = pc m + 1
+ x = evaluate m (Register a)
+ y = evaluate m b
+ reg' = M.insert a (x `mod` y) $ registers m
+
+applyInstruction (Rcv (Register a)) other m = ( m {registers = reg', messageQueue = mq', pc = pc'}, other)
+ where pc' = pc m + 1
+ reg' = M.insert a (head $ messageQueue m) $ registers m
+ mq' = tail $ messageQueue m
+
+applyInstruction (Jgz a b) other m = (m {pc = pc'}, other)
+ where x = evaluate m a
+ y = evaluate m b
+ pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1
+
+evaluate :: Machine -> Location -> Integer
+evaluate _ (Literal i) = i
+evaluate m (Register r) = M.findWithDefault 0 r (registers m)
+
+isReceive :: Instruction -> Bool
+isReceive (Rcv _) = True
+isReceive _ = False
+
+isSend :: Instruction -> Bool
+isSend (Snd _) = True
+isSend _ = False
\ No newline at end of file
--- /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 / commitdiff