src/advent18/advent18b.ipynb

   1 {
   2  "cells": [
   3   {
   4    "cell_type": "code",
   5    "execution_count": 1,
   6    "metadata": {},
   7    "outputs": [],
   8    "source": [
   9     "{-# LANGUAGE NegativeLiterals #-}\n",
  10     "{-# LANGUAGE FlexibleContexts #-}\n",
  11     "{-# LANGUAGE OverloadedStrings #-}\n",
  12     "{-# LANGUAGE TypeFamilies #-}"
  13    ]
  14   },
  15   {
  16    "cell_type": "code",
  17    "execution_count": 2,
  18    "metadata": {},
  19    "outputs": [],
  20    "source": [
  21     "-- import Prelude hiding ((++))\n",
  22     "import Data.Text (Text)\n",
  23     "import qualified Data.Text as T\n",
  24     "import qualified Data.Text.IO as TIO\n",
  25     "\n",
  26     "import Text.Megaparsec hiding (State)\n",
  27     "import qualified Text.Megaparsec.Lexer as L\n",
  28     "import Text.Megaparsec.Text (Parser)\n",
  29     "import qualified Control.Applicative as CA\n",
  30     "\n",
  31     "import qualified Data.Map.Strict as M\n",
  32     "import Data.Map.Strict ((!))\n",
  33     "\n",
  34     "import Control.Monad (when, unless)\n",
  35     "import Control.Monad.State.Lazy\n",
  36     "import Control.Monad.Reader\n",
  37     "import Control.Monad.Writer"
  38    ]
  39   },
  40   {
  41    "cell_type": "code",
  42    "execution_count": 3,
  43    "metadata": {},
  44    "outputs": [],
  45    "source": [
  46     "data Location = Literal Integer | Register Char deriving (Show, Eq)\n",
  47     "data Instruction =   Snd Location\n",
  48     "                   | Set Location Location \n",
  49     "                   | Add Location Location \n",
  50     "                   | Mul Location Location\n",
  51     "                   | Mod Location Location\n",
  52     "                   | Rcv Location\n",
  53     "                   | Jgz Location Location\n",
  54     "                   deriving (Show, Eq)\n",
  55     "\n",
  56     "data Machine = Machine { registers :: M.Map Char Integer\n",
  57     "                       , pc :: Int\n",
  58     "                       , messageQueue :: [Integer]\n",
  59     "                       } \n",
  60     "               deriving (Show, Eq)\n",
  61     "\n",
  62     "data MachinePair = MachinePair { machine0 :: Machine \n",
  63     "                               , machine1 :: Machine \n",
  64     "                               } deriving (Show, Eq)\n",
  65     "\n",
  66     "type ProgrammedMachinePair = WriterT [String] (ReaderT [Instruction] (State MachinePair)) ()"
  67    ]
  68   },
  69   {
  70    "cell_type": "code",
  71    "execution_count": 4,
  72    "metadata": {},
  73    "outputs": [],
  74    "source": [
  75     "emptyMachine = Machine {registers = M.empty, messageQueue = [], pc = 0}\n",
  76     "\n",
  77     "emptyMachinePair = MachinePair { machine0 = emptyMachine {registers = M.singleton 'p' 0}\n",
  78     "                               , machine1 = emptyMachine {registers = M.singleton 'p' 1}\n",
  79     "                               }"
  80    ]
  81   },
  82   {
  83    "cell_type": "code",
  84    "execution_count": 5,
  85    "metadata": {},
  86    "outputs": [],
  87    "source": [
  88     "sc :: Parser ()\n",
  89     "sc = L.space (skipSome spaceChar) CA.empty CA.empty\n",
  90     "\n",
  91     "lexeme  = L.lexeme sc\n",
  92     "\n",
  93     "integer       = lexeme L.integer\n",
  94     "signedInteger = L.signed sc integer\n",
  95     "\n",
  96     "symb = L.symbol sc\n",
  97     "\n",
  98     "reg = lexeme (some letterChar)\n",
  99     "\n",
 100     "location = (Literal <$> signedInteger) <|> register\n",
 101     "register = (Register . head) <$> reg\n",
 102     "\n",
 103     "instructionsP = instructionP `sepBy` space\n",
 104     "instructionP = choice [sndP, setP, addP, mulP, modP, rcvP, jgzP]\n",
 105     "\n",
 106     "sndP = Snd <$> (try (symb \"snd\") *> location)\n",
 107     "setP = Set <$> (try (symb \"set\") *> register) <*> location\n",
 108     "addP = Add <$> (try (symb \"add\") *> register) <*> location\n",
 109     "mulP = Mul <$> (try (symb \"mul\") *> register) <*> location\n",
 110     "modP = Mod <$> (try (symb \"mod\") *> register) <*> location\n",
 111     "rcvP = Rcv <$> (try (symb \"rcv\") *> location)\n",
 112     "jgzP = Jgz <$> (try (symb \"jgz\") *> location) <*> location\n",
 113     "\n",
 114     "successfulParse :: Text -> [Instruction]\n",
 115     "successfulParse input = \n",
 116     "        case parse instructionsP \"input\" input of\n",
 117     "                Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err\n",
 118     "                Right instructions  -> instructions"
 119    ]
 120   },
 121   {
 122    "cell_type": "code",
 123    "execution_count": 6,
 124    "metadata": {},
 125    "outputs": [],
 126    "source": [
 127     "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\""
 128    ]
 129   },
 130   {
 131    "cell_type": "code",
 132    "execution_count": 7,
 133    "metadata": {},
 134    "outputs": [
 135     {
 136      "data": {
 137       "text/plain": [
 138        "[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))]"
 139       ]
 140      },
 141      "metadata": {},
 142      "output_type": "display_data"
 143     }
 144    ],
 145    "source": [
 146     "successfulParse sample"
 147    ]
 148   },
 149   {
 150    "cell_type": "code",
 151    "execution_count": 8,
 152    "metadata": {},
 153    "outputs": [
 154     {
 155      "data": {
 156       "text/plain": [
 157        "[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))]"
 158       ]
 159      },
 160      "metadata": {},
 161      "output_type": "display_data"
 162     }
 163    ],
 164    "source": [
 165     "sampleInstructions = successfulParse sample\n",
 166     "sampleInstructions"
 167    ]
 168   },
 169   {
 170    "cell_type": "code",
 171    "execution_count": 9,
 172    "metadata": {},
 173    "outputs": [],
 174    "source": [
 175     "evaluate :: Machine -> Location -> Integer\n",
 176     "evaluate _ (Literal i)  = i\n",
 177     "evaluate m (Register r) = M.findWithDefault 0 r (registers m)"
 178    ]
 179   },
 180   {
 181    "cell_type": "code",
 182    "execution_count": 10,
 183    "metadata": {},
 184    "outputs": [],
 185    "source": [
 186     "applyInstruction :: Instruction -> [Integer] -> Machine -> (Machine, [Integer])\n",
 187     "\n",
 188     "applyInstruction (Snd a) other m = (m {registers = reg', pc = pc'}, other ++ [y])\n",
 189     "    where pc' = pc m + 1\n",
 190     "          y = evaluate m a\n",
 191     "          sentCount = evaluate m (Register 'x')\n",
 192     "          reg' = M.insert 'x' (sentCount + 1) $ registers m\n",
 193     "\n",
 194     "applyInstruction (Set (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
 195     "    where pc' = pc m + 1\n",
 196     "          y = evaluate m b\n",
 197     "          reg' = M.insert a y $ registers m\n",
 198     "\n",
 199     "applyInstruction (Add (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
 200     "    where pc' = pc m + 1\n",
 201     "          x = evaluate m (Register a) \n",
 202     "          y = evaluate m b\n",
 203     "          reg' = M.insert a (x + y) $ registers m\n",
 204     "\n",
 205     "applyInstruction (Mul (Register a) b) other m = (m {registers = reg', pc = pc'}, other)\n",
 206     "    where pc' = pc m + 1\n",
 207     "          x = evaluate m (Register a) \n",
 208     "          y = evaluate m b\n",
 209     "          reg' = M.insert a (x * y) $ registers m\n",
 210     "\n",
 211     "applyInstruction (Mod (Register a) b) other  m = (m {registers = reg', pc = pc'}, other)\n",
 212     "    where pc' = pc m + 1\n",
 213     "          x = evaluate m (Register a) \n",
 214     "          y = evaluate m b\n",
 215     "          reg' = M.insert a (x `mod` y) $ registers m\n",
 216     "\n",
 217     "applyInstruction (Rcv (Register a)) other m = ( m {registers = reg', messageQueue = mq', pc = pc'}, other)\n",
 218     "    where pc' = pc m + 1\n",
 219     "          reg' = M.insert a (head $ messageQueue m) $ registers m\n",
 220     "          mq' = tail $ messageQueue m\n",
 221     "    \n",
 222     "applyInstruction (Jgz a b) other m = (m {pc = pc'}, other)\n",
 223     "    where x = evaluate m a\n",
 224     "          y = evaluate m b\n",
 225     "          pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1"
 226    ]
 227   },
 228   {
 229    "cell_type": "code",
 230    "execution_count": 11,
 231    "metadata": {},
 232    "outputs": [],
 233    "source": [
 234     "isReceive :: Instruction -> Bool\n",
 235     "isReceive (Rcv _) = True\n",
 236     "isReceive _ = False"
 237    ]
 238   },
 239   {
 240    "cell_type": "code",
 241    "execution_count": 12,
 242    "metadata": {},
 243    "outputs": [],
 244    "source": [
 245     "isSend :: Instruction -> Bool\n",
 246     "isSend (Snd _) = True\n",
 247     "isSend _ = False"
 248    ]
 249   },
 250   {
 251    "cell_type": "code",
 252    "execution_count": 13,
 253    "metadata": {},
 254    "outputs": [],
 255    "source": [
 256     "executeInstruction :: Bool -> ProgrammedMachinePair\n",
 257     "executeInstruction m0Active =\n",
 258     "    do  instrs <- ask\n",
 259     "        mp <- get\n",
 260     "        let (ma, mb) = if m0Active \n",
 261     "                       then (machine0 mp, machine1 mp) \n",
 262     "                       else (machine1 mp, machine0 mp)\n",
 263     "        let mq = messageQueue mb\n",
 264     "        let instr = instrs!!(pc ma)\n",
 265     "        let (ma', mq') = applyInstruction instr mq ma\n",
 266     "        let mb' = mb {messageQueue = mq'}\n",
 267     "        let mp' = if m0Active then mp {machine0 = ma', machine1 = mb'}\n",
 268     "                              else mp {machine0 = mb', machine1 = ma'}\n",
 269     "        put mp'"
 270    ]
 271   },
 272   {
 273    "cell_type": "code",
 274    "execution_count": 14,
 275    "metadata": {},
 276    "outputs": [],
 277    "source": [
 278     "send :: Instruction -> Machine -> Integer\n",
 279     "send (Snd a) m = evaluate m a\n",
 280     "send _ _ = 0"
 281    ]
 282   },
 283   {
 284    "cell_type": "code",
 285    "execution_count": 26,
 286    "metadata": {},
 287    "outputs": [],
 288    "source": [
 289     "executeInstructions = \n",
 290     "    do  instrs <- ask\n",
 291     "        mp <- get\n",
 292     "        let m0 = machine0 mp\n",
 293     "        let m1 = machine1 mp\n",
 294     "        let instr0 = instrs !! pc m0\n",
 295     "        let m0Blocked = isReceive instr0 && null (messageQueue m0)\n",
 296     "        let instr1 = instrs !! pc m1\n",
 297     "        let m1Blocked = isReceive instr1 && null (messageQueue m1)\n",
 298     "        let (ma, mb) = if m0Blocked then (m1, m0) else (m0, m1)\n",
 299     "          \n",
 300     "        unless (m0Blocked && m1Blocked)\n",
 301     "            $\n",
 302     "            when (pc ma >= 0 && pc ma < length instrs)\n",
 303     "                $\n",
 304     "                do let m0Active = not m0Blocked\n",
 305     "                   when (m0Blocked && isSend instr1) (tell [\"sending: \" ++ show mp])\n",
 306     "                   executeInstruction m0Active\n",
 307     "                   executeInstructions\n"
 308    ]
 309   },
 310   {
 311    "cell_type": "code",
 312    "execution_count": 27,
 313    "metadata": {},
 314    "outputs": [
 315     {
 316      "data": {
 317       "text/plain": [
 318        "(((),[\"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 = []}})"
 319       ]
 320      },
 321      "metadata": {},
 322      "output_type": "display_data"
 323     }
 324    ],
 325    "source": [
 326     "runState (runReaderT (runWriterT executeInstructions) sampleInstructions ) emptyMachinePair"
 327    ]
 328   },
 329   {
 330    "cell_type": "code",
 331    "execution_count": 28,
 332    "metadata": {},
 333    "outputs": [],
 334    "source": [
 335     "sampleInstructions2 = successfulParse \"snd 1\\nsnd 2\\nsnd p\\nrcv a\\nrcv b\\nrcv c\\nrcv d\""
 336    ]
 337   },
 338   {
 339    "cell_type": "code",
 340    "execution_count": 29,
 341    "metadata": {},
 342    "outputs": [
 343     {
 344      "data": {
 345       "text/plain": [
 346        "(((),[\"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 = []}})"
 347       ]
 348      },
 349      "metadata": {},
 350      "output_type": "display_data"
 351     }
 352    ],
 353    "source": [
 354     "runState (runReaderT (runWriterT executeInstructions) sampleInstructions2 ) emptyMachinePair"
 355    ]
 356   },
 357   {
 358    "cell_type": "code",
 359    "execution_count": 30,
 360    "metadata": {},
 361    "outputs": [
 362     {
 363      "data": {
 364       "text/plain": [
 365        "(((),[\"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 = []}})"
 366       ]
 367      },
 368      "metadata": {},
 369      "output_type": "display_data"
 370     }
 371    ],
 372    "source": [
 373     "runState (\n",
 374     "    runReaderT (\n",
 375     "        runWriterT executeInstructions\n",
 376     "               ) \n",
 377     "        sampleInstructions\n",
 378     "         ) \n",
 379     "         emptyMachinePair"
 380    ]
 381   },
 382   {
 383    "cell_type": "code",
 384    "execution_count": 31,
 385    "metadata": {},
 386    "outputs": [
 387     {
 388      "data": {
 389       "text/plain": [
 390        "[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))]"
 391       ]
 392      },
 393      "metadata": {},
 394      "output_type": "display_data"
 395     }
 396    ],
 397    "source": [
 398     "sampleInstructions"
 399    ]
 400   },
 401   {
 402    "cell_type": "code",
 403    "execution_count": 32,
 404    "metadata": {},
 405    "outputs": [],
 406    "source": [
 407     "part2 instructions = \n",
 408     "    runState (\n",
 409     "        runReaderT (\n",
 410     "            runWriterT executeInstructions\n",
 411     "                   ) \n",
 412     "            instructions \n",
 413     "             ) \n",
 414     "             emptyMachinePair"
 415    ]
 416   },
 417   {
 418    "cell_type": "code",
 419    "execution_count": 35,
 420    "metadata": {},
 421    "outputs": [],
 422    "source": [
 423     "main :: IO ()\n",
 424     "main = do \n",
 425     "        text <- TIO.readFile \"../../data/advent18.txt\"\n",
 426     "        let instrs = successfulParse text\n",
 427     "        let ((result, l), statef) = part2 instrs\n",
 428     "        print $ length l"
 429    ]
 430   },
 431   {
 432    "cell_type": "code",
 433    "execution_count": 36,
 434    "metadata": {},
 435    "outputs": [
 436     {
 437      "data": {
 438       "text/plain": [
 439        "5969"
 440       ]
 441      },
 442      "metadata": {},
 443      "output_type": "display_data"
 444     }
 445    ],
 446    "source": [
 447     "main"
 448    ]
 449   },
 450   {
 451    "cell_type": "code",
 452    "execution_count": 24,
 453    "metadata": {},
 454    "outputs": [
 455     {
 456      "data": {
 457       "text/plain": [
 458        "11938"
 459       ]
 460      },
 461      "metadata": {},
 462      "output_type": "display_data"
 463     }
 464    ],
 465    "source": [
 466     "5969*2"
 467    ]
 468   },
 469   {
 470    "cell_type": "code",
 471    "execution_count": 25,
 472    "metadata": {},
 473    "outputs": [
 474     {
 475      "data": {
 476       "text/plain": [
 477        "12065"
 478       ]
 479      },
 480      "metadata": {},
 481      "output_type": "display_data"
 482     }
 483    ],
 484    "source": [
 485     "5969+6096"
 486    ]
 487   },
 488   {
 489    "cell_type": "code",
 490    "execution_count": null,
 491    "metadata": {},
 492    "outputs": [],
 493    "source": []
 494   }
 495  ],
 496  "metadata": {
 497   "kernelspec": {
 498    "display_name": "Haskell",
 499    "language": "haskell",
 500    "name": "haskell"
 501   },
 502   "language_info": {
 503    "codemirror_mode": "ihaskell",
 504    "file_extension": ".hs",
 505    "name": "haskell",
 506    "version": "8.0.2"
 507   }
 508  },
 509  "nbformat": 4,
 510  "nbformat_minor": 2
 511 }