X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=src%2Fadvent18%2Fadvent18a.ipynb;fp=src%2Fadvent18%2Fadvent18a.ipynb;h=c2f0b577dd1570a1cac2c86c7d007fd14096925d;hb=eefbb6bc370b6ae9c2ad16f7daaeac78642025d3;hp=0000000000000000000000000000000000000000;hpb=9ce2b21f9734aa6e51186d2cc0075083a5864155;p=advent-of-code-17.git

diff --git a/src/advent18/advent18a.ipynb b/src/advent18/advent18a.ipynb
new file mode 100644
index 0000000..c2f0b57
--- /dev/null
+++ b/src/advent18/advent18a.ipynb
@@ -0,0 +1,441 @@
+{
+ "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
+}