Day 12: Leonardo's Monorail



In [1]:

    
inputLines = lines <$> readFile "input/day12.txt"



In [2]:

    
import qualified Data.Map as Map
import Data.Array
import Data.Char (isLetter)
import Data.Maybe (fromJust)

Data Types

The computer memory stores the values of the registers. It is implemented as a Map that maps the register name to the corresponding value.



In [3]:

    
type ComputerMemory = Map.Map String Int

The state of the computer consists of the instruction pointer (the integer index of the next instruction) and the memory.



In [4]:

    
type ComputerState = (Int, ComputerMemory)

An instruction maps a computer state to the next computer state.



In [5]:

    
type Instruction = ComputerState -> ComputerState

A program is an array of instructions.



In [6]:

    
type Program = Array Int Instruction

Asembunny instructions are made of an opcode and one or two operands. An operand is either a constant integer or a register value.



In [7]:

    
data Operand = Const Int | Register String deriving(Show)

Functions for handling operands

getValue determines the value of an operand. Access to the computer memory is needed if the operand is a register. If a register has not been written to, its value is zero.



In [8]:

    
getValue :: Operand -> ComputerMemory -> Int
getValue (Const value) _ = value
getValue (Register registerName) memory = Map.findWithDefault 0 registerName memory

parseOperand takes a String and returns the corresponding Operand.



In [9]:

    
parseOperand :: String -> Operand
parseOperand text
    | isLetter $ head text = Register text
    | otherwise = Const $ read text
    
-- Test if it works
map parseOperand ["-5", "d"] -- [Const (-5), Register "d"]









    





[Const (-5),Register "d"]

Functions that build the instructions

The following functions take one or two Operands and return the corresponding Instruction, i.e., the function that takes a computer state and returns the new state after the instruction is executed. Note that the instructions for all opcodes except for jnz increase the instruction pointer by one.

cpy writes the value of its first Operand to the second Operand, which must be a register



In [10]:

    
cpy :: Operand -> Operand -> Instruction
cpy source (Register registerName) (ip, memory) =
    (succ ip, Map.insert registerName (getValue source memory) memory)

modifyRegister takes a function that modifies an Int and a register. The resulting instruction applies that modification to the register value.



In [11]:

    
modifyRegister :: (Int -> Int) -> Operand -> Instruction
modifyRegister modifier (Register registerName) (ip, memory) = 
    (succ ip,
     Map.insert registerName (modifier $ Map.findWithDefault 0 registerName memory) memory)

inc and dec use modifyRegister to increase and decrease a register value, respectively.



In [12]:

    
inc :: Operand -> Instruction
inc = modifyRegister succ



In [13]:

    
dec :: Operand -> Instruction
dec = modifyRegister pred

jnz adds its first Operand to the instruction pointer, unless its second operand is zero.



In [14]:

    
jnz :: Operand -> Operand -> Instruction
jnz value offset (ip, memory)
    | getValue value memory == 0 = (succ ip, memory)
    | otherwise = (ip + getValue offset memory, memory)

Parsing instructions

parseInstruction takes a line of asembunny code and returns the corresponding Instruction.



In [15]:

    
parseInstruction :: String -> Instruction
parseInstruction line
    | opcode `Map.member` unaryFunctions = 
        fromJust (opcode `Map.lookup` unaryFunctions)
                 (getSingleOperand operands)
    | opcode `Map.member` binaryFunctions =
        fromJust (opcode `Map.lookup` binaryFunctions)
                 (getFirstOperand operands)
                 (getSecondOperand operands)
    where
        tokens = words line
        opcode = head tokens
        operands = tail tokens
        
        unaryFunctions = Map.fromList [("inc", inc), ("dec", dec)]      
        binaryFunctions = Map.fromList [("cpy", cpy), ("jnz", jnz)]
        
        getSingleOperand [p] = parseOperand p
        
        getFirstOperand [p1, p2] = parseOperand p1
        
        getSecondOperand [p1, p2] = parseOperand p2

Verify that a few parsed instructions behave as expected



In [16]:

    
initialState = (42, Map.fromList [("a", 1)])

instructionsAndExpectedStates = [
    ("inc a",    (43, Map.fromList [("a", 2)])),
    ("inc b",    (43, Map.fromList [("a", 1), ("b", 1)])),
    ("dec c",    (43, Map.fromList [("a", 1), ("c", -1)])),
    ("cpy a b",  (43, Map.fromList [("a", 1), ("b", 1)])),
    ("cpy -5 d", (43, Map.fromList [("a", 1), ("d", -5)])),
    ("jnz a 10", (52, Map.fromList [("a", 1)])),
    ("jnz b 10", (43, Map.fromList [("a", 1)]))]
    
finalStates = map ((\f -> f initialState) . parseInstruction . fst) instructionsAndExpectedStates
expectedStates = map snd instructionsAndExpectedStates

all (uncurry (==)) $ zip finalStates expectedStates









    





True

Compile an asembunny program



In [17]:

    
compileProgram :: [String] -> Program
compileProgram sourceLines = listArray (0, lastIndex) $ map parseInstruction sourceLines
    where
        lastIndex = pred numberOfInstructions
        numberOfInstructions = length sourceLines

Continue running a program in a specific computer state

This function takes a program, the final value of the instruction pointer that causes the program to terminate, and the current computer state. It returns the state that the computer memory will have after program termination.



In [18]:

    
continueExecution :: Program -> Int -> ComputerState -> ComputerMemory
continueExecution program finalIp state
    | ip == finalIp = memory
    | otherwise = continueExecution program finalIp newState
    where
        (ip, memory) = state
        newState = currentInstruction state
        currentInstruction = program ! ip

Run a program from the beginning until it terminates

The function takes the initial state of the computer memory and a program, and returns the computer memory after program termination.



In [19]:

    
runProgram :: ComputerMemory -> Program -> ComputerMemory
runProgram initialMemory program = continueExecution program finalIp initialState
    where
        (minIp, maxIp) = bounds program
        finalIp = succ maxIp
        initialState = (minIp, initialMemory)

Compile the given program



In [20]:

    
program = compileProgram <$> inputLines

Part 1: Run the program with uninitialized memory and read the value from register `"a"`



In [21]:

    
Map.lookup "a" . runProgram Map.empty <$> program









    




Just317993

Part 2: Set the value of register `"c"` to 1



In [22]:

    
Map.lookup "a" . runProgram (Map.singleton "c" 1) <$> program









    




Just9227647