Day 23 done
authorNeil Smith <neil.git@njae.me.uk>
Sat, 23 Dec 2017 18:38:48 +0000 (18:38 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Sat, 23 Dec 2017 18:38:48 +0000 (18:38 +0000)
advent-of-code.cabal
data/advent23.txt [new file with mode: 0644]
problems/day23.html [new file with mode: 0644]
src/advent23/advent23.hs [new file with mode: 0644]
src/advent23/advent23.ipynb [new file with mode: 0644]

index 39e555b0fd048280066fdf802038f657d108998f..60df43b990a6ea77dd10ce36144bd7e8960a8d39 100644 (file)
@@ -259,3 +259,14 @@ executable advent22bh
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , unordered-containers
+
+executable advent23
+  hs-source-dirs:      src/advent23
+  main-is:             advent23.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , containers
+                     , mtl
+                     , text
+                     , megaparsec
+                     , primes
\ No newline at end of file
diff --git a/data/advent23.txt b/data/advent23.txt
new file mode 100644 (file)
index 0000000..30229f6
--- /dev/null
@@ -0,0 +1,32 @@
+set b 84
+set c b
+jnz a 2
+jnz 1 5
+mul b 100
+sub b -100000
+set c b
+sub c -17000
+set f 1
+set d 2
+set e 2
+set g d
+mul g e
+sub g b
+jnz g 2
+set f 0
+sub e -1
+set g e
+sub g b
+jnz g -8
+sub d -1
+set g d
+sub g b
+jnz g -13
+jnz f 2
+sub h -1
+set g b
+sub g c
+jnz g 2
+jnz 1 3
+sub b -17
+jnz 1 -23
\ No newline at end of file
diff --git a/problems/day23.html b/problems/day23.html
new file mode 100644 (file)
index 0000000..0f3ec7b
--- /dev/null
@@ -0,0 +1,138 @@
+<!DOCTYPE html>
+<html lang="en-us">
+<head>
+<meta charset="utf-8"/>
+<title>Day 23 - 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">46*</span></div></div><div><h1 class="title-event">&nbsp;&nbsp;&nbsp;<span class="title-event-wrap">var y=</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://kx.com/" target="_blank" onclick="if(ga)ga('send','event','sponsor','click',this.href);" rel="noopener">Kx Systems</a> - kdb+, the in-memory time series technology standard</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 23: Coprocessor Conflagration ---</h2><p>You decide to head directly to the CPU and fix the printer from there. As you get close, you find an <em>experimental coprocessor</em> doing so much work that the local programs are afraid it will <a href="https://en.wikipedia.org/wiki/Halt_and_Catch_Fire">halt and catch fire</a>. This would cause serious issues for the rest of the computer, so you head in and see what you can do.</p>
+<p>The code it's running seems to be a variant of the kind you saw recently on that <a href="18">tablet</a>. The general functionality seems <em>very similar</em>, but some of the instructions are different:</p>
+<ul>
+<li><code>set X Y</code> <em>sets</em> register <code>X</code> to the value of <code>Y</code>.</li>
+<li><code>sub X Y</code> <em>decreases</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>jnz 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>not 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>
+<p>Only the instructions listed above are used. The eight registers here, named <code>a</code> through <code>h</code>, all start at <code>0</code>.</p>
+</ul>
+<p>The coprocessor is currently set to some kind of <em>debug mode</em>, which allows for testing, but prevents it from doing any meaningful work.</p>
+<p>If you run the program (your puzzle input), <em>how many times is the <code>mul</code> instruction invoked?</em></p>
+</article>
+<p>Your puzzle answer was <code>6724</code>.</p><article class="day-desc"><h2>--- Part Two ---</h2><p>Now, it's time to fix the problem.</p>
+<p>The <em>debug mode switch</em> is wired directly to register <code>a</code>.  You <span title="From 'magic' to 'more magic'.">flip the switch</span>, which makes <em>register <code>a</code> now start at <code>1</code></em> when the program is executed.</p>
+<p>Immediately, the coprocessor begins to overheat.  Whoever wrote this program obviously didn't choose a very efficient implementation.  You'll need to <em>optimize the program</em> if it has any hope of completing before Santa needs that printer working.</p>
+<p>The coprocessor's ultimate goal is to determine the final value left in register <code>h</code> once the program completes. Technically, if it had that... it wouldn't even need to run the program.</p>
+<p>After setting register <code>a</code> to <code>1</code>, if the program were to run to completion, <em>what value would be left in register <code>h</code>?</em></p>
+</article>
+<p>Your puzzle answer was <code>903</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="23/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+%22Coprocessor+Conflagration%22+%2D+Day+23+%2D+Advent+of+Code+2017&amp;url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F23&amp;related=ericwastl&amp;hashtags=AdventOfCode" target="_blank">Twitter</a>
+  <a href="https://plus.google.com/share?url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F23" target="_blank">Google+</a>
+  <a href="http://www.reddit.com/submit?url=http%3A%2F%2Fadventofcode%2Ecom%2F2017%2Fday%2F23&amp;title=I%27ve+completed+%22Coprocessor+Conflagration%22+%2D+Day+23+%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
diff --git a/src/advent23/advent23.hs b/src/advent23/advent23.hs
new file mode 100644 (file)
index 0000000..516819f
--- /dev/null
@@ -0,0 +1,152 @@
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- import Prelude hiding ((++))
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import Text.Megaparsec hiding (State)
+import qualified Text.Megaparsec.Lexer as L
+import Text.Megaparsec.Text (Parser)
+import qualified Control.Applicative as CA
+
+import qualified Data.Map.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 qualified Data.Numbers.Primes as P
+
+data Location = Literal Integer | Register Char deriving (Show, Eq)
+data Instruction =   Set Location Location 
+                   | Sub Location Location 
+                   | Mul Location Location
+                   | Jnz Location Location
+                   deriving (Show, Eq)
+
+data Machine = Machine { registers :: M.Map Char Integer
+                       , pc :: Int
+                       } 
+               deriving (Show, Eq)
+
+type ProgrammedMachine = WriterT [Int] (ReaderT [Instruction] (State Machine)) ()
+
+emptyMachine = Machine {registers = M.empty, pc = 0}
+
+
+
+main :: IO ()
+main = do 
+        text <- TIO.readFile "data/advent23.txt"
+        let instrs = successfulParse text
+        let ((result, l), machinef) = part1 instrs
+        print $ length l
+        print $ part2
+
+
+part1 instructions = 
+    runState (
+        runReaderT (
+            runWriterT executeInstructions
+                   ) 
+            instructions 
+             ) 
+             emptyMachine
+
+
+
+-- Part 2 following results of analysis by Dario Petrillo
+-- https://github.com/dp1/AoC17/blob/master/day23.5.txt
+part2 = length $ filter (not . P.isPrime) [start, start + 17 .. end]
+    where start = 84 * 100 + 100000
+          end = start + 17000
+
+executeInstructions = 
+    do  instrs <- ask
+        m <- get
+        when (pc m >= 0 && pc m < length instrs)
+            $
+            do when (isMul $ instrs !! pc m) (tell [1])
+               executeInstruction
+               executeInstructions
+
+executeInstruction :: ProgrammedMachine
+executeInstruction =
+    do  instrs <- ask
+        m <- get
+        let instr = instrs!!(pc m)
+        put (applyInstruction instr m)
+
+
+applyInstruction :: Instruction -> Machine -> Machine
+
+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 (Sub (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 (Jnz 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
+
+
+isMul :: Instruction -> Bool
+isMul (Mul _ _ ) = True
+isMul _ = False
+
+evaluate :: Machine -> Location -> Integer
+evaluate _ (Literal i)  = i
+evaluate m (Register r) = M.findWithDefault 0 r (registers m)
+
+
+
+sc :: Parser ()
+sc = L.space (skipSome spaceChar) CA.empty CA.empty
+
+lexeme  = L.lexeme sc
+
+integer       = lexeme L.integer
+signedInteger = L.signed sc integer
+
+symbol = L.symbol sc
+
+-- reg :: Parser String
+-- reg = id <$> some letterChar
+
+reg = lexeme (some letterChar)
+
+location = (Literal <$> signedInteger) <|> register
+register = (Register . head) <$> reg
+
+instructionsP = instructionP `sepBy` space
+instructionP = choice [setP, subP, mulP, jnzP]
+
+setP = Set <$> (try (symbol "set") *> register) <*> location
+subP = Sub <$> (try (symbol "sub") *> register) <*> location
+mulP = Mul <$> (try (symbol "mul") *> register) <*> location
+jnzP = Jnz <$> (try (symbol "jnz") *> 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
diff --git a/src/advent23/advent23.ipynb b/src/advent23/advent23.ipynb
new file mode 100644 (file)
index 0000000..e6d3944
--- /dev/null
@@ -0,0 +1,906 @@
+{
+ "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": [
+    {
+     "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><span class='err-msg'>&lt;interactive&gt;:1:1: error:<br/>    Failed to load interface for ‘Data.Numbers.Primes’</span>"
+      ],
+      "text/plain": [
+       "<interactive>:1:1: error:\n",
+       "    Failed to load interface for ‘Data.Numbers.Primes’\n",
+       "    Use -v to see a list of the files searched for."
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "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\n",
+    "\n",
+    "import Data.Numbers.Primes"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 3,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "data Location = Literal Integer | Register Char deriving (Show, Eq)\n",
+    "data Instruction =   Set Location Location \n",
+    "                   | Sub Location Location \n",
+    "                   | Mul Location Location\n",
+    "                   | Jnz Location Location\n",
+    "                   deriving (Show, Eq)\n",
+    "\n",
+    "data Machine = Machine { registers :: M.Map Char Integer\n",
+    "                       , pc :: Int\n",
+    "                       } \n",
+    "               deriving (Show, Eq)\n",
+    "\n",
+    "type ProgrammedMachine = WriterT [String] (ReaderT [Instruction] (State Machine)) ()"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 4,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "emptyMachine = Machine {registers = M.empty, pc = 0}"
+   ]
+  },
+  {
+   "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",
+    "symbol = 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 [setP, subP, mulP, jnzP]\n",
+    "\n",
+    "setP = Set <$> (try (symbol \"set\") *> register) <*> location\n",
+    "subP = Sub <$> (try (symbol \"sub\") *> register) <*> location\n",
+    "mulP = Mul <$> (try (symbol \"mul\") *> register) <*> location\n",
+    "jnzP = Jnz <$> (try (symbol \"jnz\") *> 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\\nsub a 2\\nmul a a\\njnz a 5\""
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 7,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "[Set (Register 'a') (Literal 1),Sub (Register 'a') (Literal 2),Mul (Register 'a') (Register 'a'),Jnz (Register 'a') (Literal 5)]"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "sampleInstructions = successfulParse sample\n",
+    "sampleInstructions"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 8,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "isMul :: Instruction -> Bool\n",
+    "isMul (Mul _ _ ) = True\n",
+    "isMul _ = False"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 9,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "isJnz :: Instruction -> Bool\n",
+    "isJnz (Jnz _ _ ) = True\n",
+    "isJnz _ = False"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 10,
+   "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": 11,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "applyInstruction :: Instruction -> Machine -> Machine\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 (Sub (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 (Jnz 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": 28,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "executeInstructionPeep :: ProgrammedMachine\n",
+    "executeInstructionPeep =\n",
+    "    do  instrs <- ask\n",
+    "        m <- get\n",
+    "        let sample1 = take (length sample1Target) $ drop (pc m) $ instrs\n",
+    "        if sample1 == sample1Target\n",
+    "            -- then trace (\"Peeping 1 \" ++ (show m) ++ \" to \" ++ (show m1)) m1\n",
+    "            then do let reg1 = M.union (M.fromList [ ('d', 2), ('e', evaluate m (Register 'b'))\n",
+    "                                                   , ('f', 0), ('g', 0)\n",
+    "                                                   ]) \n",
+    "                                       (registers m)\n",
+    "                    let m1 = m {registers = reg1, pc = pc m + (length sample1)}\n",
+    "                    put m1\n",
+    "            else executeInstruction\n",
+    "    where \n",
+    "--           sample1 = take (length sample1Target) $ drop (pc m) $ instrs\n",
+    "          sample1Target = [ Set (Register 'b') (Literal 4)\n",
+    "                          , Set (Register 'f') (Literal 1)\n",
+    "                          , Set (Register 'd') (Literal 2)\n",
+    "                          , Set (Register 'e') (Literal 2)\n",
+    "                          , Set (Register 'g') (Register 'd')\n",
+    "                          , Mul (Register 'g') (Register 'e')\n",
+    "                          , Sub (Register 'g') (Register 'b')\n",
+    "                          , Jnz (Register 'g') (Literal 2)\n",
+    "                          , Set (Register 'f') (Literal 0)\n",
+    "                          , Sub (Register 'e') (Literal (-1))\n",
+    "                          , Set (Register 'g') (Register 'e')\n",
+    "                          , Sub (Register 'g') (Register 'b')\n",
+    "                          , Jnz (Register 'g') (Literal (-8))\n",
+    "                          ]\n",
+    "--           reg1 = M.union (M.fromList [ ('d', 2), ('e', evaluate m (Register 'b'))\n",
+    "--                                      , ('f', 0), ('g', 0)\n",
+    "--                                      ]) \n",
+    "--                          (registers m)\n",
+    "--           m1 = m {registers = reg1, pc = pc m + (length sample1)}\n",
+    "          "
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 29,
+   "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": 30,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "executeInstructions = \n",
+    "    do  instrs <- ask\n",
+    "        m <- get\n",
+    "        when (pc m >= 0 && pc m < length instrs)\n",
+    "            $\n",
+    "            do when (isMul $ instrs !! pc m) (tell [\"mul\"])\n",
+    "               when (isJnz $ instrs !! pc m) (tell [show m])\n",
+    "--                executeInstructionPeep\n",
+    "               executeInstruction\n",
+    "               executeInstructions"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 39,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "executeInstructionsPeep = \n",
+    "    do  instrs <- ask\n",
+    "        m <- get\n",
+    "        when (pc m >= 0 && pc m < length instrs)\n",
+    "            $\n",
+    "            do -- when (isMul $ instrs !! pc m) (tell [\"mul\"])\n",
+    "               -- when (isJnz $ instrs !! pc m) (tell [show m])\n",
+    "               executeInstructionPeep\n",
+    "               executeInstructionsPeep"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "metadata": {},
+   "outputs": [],
+   "source": []
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 40,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "(((),[\"mul\",\"Machine {registers = fromList [('a',1)], pc = 3}\"]),Machine {registers = fromList [('a',1)], pc = 8})"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "runState (runReaderT (runWriterT executeInstructions) sampleInstructions ) emptyMachine"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 41,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "(((),[\"mul\",\"Machine {registers = fromList [('a',1)], pc = 3}\"]),Machine {registers = fromList [('a',1)], pc = 8})"
+      ]
+     },
+     "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": 42,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "[Set (Register 'a') (Literal 1),Sub (Register 'a') (Literal 2),Mul (Register 'a') (Register 'a'),Jnz (Register 'a') (Literal 5)]"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "sampleInstructions"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 43,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "part1 instructions = \n",
+    "    runState (\n",
+    "        runReaderT (\n",
+    "            runWriterT executeInstructions\n",
+    "                   ) \n",
+    "            instructions \n",
+    "             ) \n",
+    "             emptyMachine"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 44,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "main :: IO ()\n",
+    "main = do \n",
+    "        text <- TIO.readFile \"../../data/advent23.txt\"\n",
+    "        let instrs = successfulParse text\n",
+    "        let ((result, l), machinef) = part1 instrs\n",
+    "--         print $ head l\n",
+    "        print $ length $ filter (== \"mul\") l\n",
+    "--         print $ part2 instrs"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 45,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "6724"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "main"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 46,
+   "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\">runTest instructions machine0\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructions) instructions)\n",
+       "      machine0</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">runTest instructions\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructions) instructions)</div></div>"
+      ],
+      "text/plain": [
+       "Line 1: Eta reduce\n",
+       "Found:\n",
+       "runTest instructions machine0\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructions) instructions)\n",
+       "      machine0\n",
+       "Why not:\n",
+       "runTest instructions\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructions) instructions)"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "runTest instructions machine0 = \n",
+    "    runState (\n",
+    "        runReaderT (\n",
+    "            runWriterT executeInstructions\n",
+    "                   ) \n",
+    "            instructions \n",
+    "             ) \n",
+    "             machine0"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 47,
+   "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\">runTestPeep instructions machine0\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructionsPeep) instructions)\n",
+       "      machine0</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">runTestPeep instructions\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructionsPeep) instructions)</div></div>"
+      ],
+      "text/plain": [
+       "Line 1: Eta reduce\n",
+       "Found:\n",
+       "runTestPeep instructions machine0\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructionsPeep) instructions)\n",
+       "      machine0\n",
+       "Why not:\n",
+       "runTestPeep instructions\n",
+       "  = runState\n",
+       "      (runReaderT (runWriterT executeInstructionsPeep) instructions)"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "runTestPeep instructions machine0 = \n",
+    "    runState (\n",
+    "        runReaderT (\n",
+    "            runWriterT executeInstructionsPeep\n",
+    "                   ) \n",
+    "            instructions \n",
+    "             ) \n",
+    "             machine0"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 48,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "[Set (Register 'b') (Literal 4),Set (Register 'f') (Literal 1),Set (Register 'd') (Literal 2),Set (Register 'e') (Literal 2),Set (Register 'g') (Register 'd'),Mul (Register 'g') (Register 'e'),Sub (Register 'g') (Register 'b'),Jnz (Register 'g') (Literal 2),Set (Register 'f') (Literal 0),Sub (Register 'e') (Literal (-1)),Set (Register 'g') (Register 'e'),Sub (Register 'g') (Register 'b'),Jnz (Register 'g') (Literal (-8))]"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "peepTest1T = T.pack \"set b 4\\nset f 1\\nset d 2\\nset e 2\\nset g d\\nmul g e\\nsub g b\\njnz g 2\\nset f 0\\nsub e -1\\nset g e\\nsub g b\\njnz g -8\"\n",
+    "peepTest1 = successfulParse peepTest1T\n",
+    "peepTest1"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 49,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "[\"mul\",\"Machine {registers = fromList [('b',4),('d',2),('e',2),('f',1),('g',0)], pc = 7}\",\"Machine {registers = fromList [('b',4),('d',2),('e',3),('f',0),('g',-1)], pc = 12}\",\"mul\",\"Machine {registers = fromList [('b',4),('d',2),('e',3),('f',0),('g',2)], pc = 7}\",\"Machine {registers = fromList [('b',4),('d',2),('e',4),('f',0),('g',0)], pc = 12}\"]"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "((v, t), m) = runTest peepTest1 emptyMachine\n",
+    "t"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 50,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "text <- TIO.readFile \"../../data/advent23.txt\"\n",
+    "let fullInstrs = successfulParse text"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 51,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "[Set (Register 'b') (Literal 84),Set (Register 'c') (Register 'b'),Jnz (Register 'a') (Literal 2),Jnz (Literal 1) (Literal 5),Mul (Register 'b') (Literal 100),Sub (Register 'b') (Literal (-100000)),Set (Register 'c') (Register 'b'),Sub (Register 'c') (Literal (-17000)),Set (Register 'f') (Literal 1),Set (Register 'd') (Literal 2),Set (Register 'e') (Literal 2),Set (Register 'g') (Register 'd'),Mul (Register 'g') (Register 'e'),Sub (Register 'g') (Register 'b'),Jnz (Register 'g') (Literal 2),Set (Register 'f') (Literal 0),Sub (Register 'e') (Literal (-1)),Set (Register 'g') (Register 'e'),Sub (Register 'g') (Register 'b'),Jnz (Register 'g') (Literal (-8)),Sub (Register 'd') (Literal (-1)),Set (Register 'g') (Register 'd'),Sub (Register 'g') (Register 'b'),Jnz (Register 'g') (Literal (-13)),Jnz (Register 'f') (Literal 2),Sub (Register 'h') (Literal (-1)),Set (Register 'g') (Register 'b'),Sub (Register 'g') (Register 'c'),Jnz (Register 'g') (Literal 2),Jnz (Literal 1) (Literal 3),Sub (Register 'b') (Literal (-17)),Jnz (Literal 1) (Literal (-23))]"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "fullInstrs"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 52,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "Machine {registers = fromList [('b',84),('c',84),('d',84),('e',84),('f',0),('g',0),('h',1)], pc = 32}"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "((v, t), m) = runTest fullInstrs emptyMachine\n",
+    "m"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 53,
+   "metadata": {},
+   "outputs": [
+    {
+     "data": {
+      "text/plain": [
+       "Machine {registers = fromList [('b',84),('c',84),('d',84),('e',84),('f',0),('g',0),('h',1)], pc = 32}"
+      ]
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "((v, t), m) = runTestPeep fullInstrs emptyMachine\n",
+    "m"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "((v, t), m) = runTestPeep fullInstrs (emptyMachine {registers = M.fromList [('a', 1)]})\n",
+    "m"
+   ]
+  },
+  {
+   "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
+}