advent2017-day18.fs

// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Input data
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

type State = {
    exec: int;
    registers: Map<char, int64>;
    lastSound: int64;
    receiving: bool;
    sendsCount: int;
    sndQueue: int64 list;
    rcvQueue: int64 list;
}

let getRegisterValue register state =
    let registerValue = state.registers |> Map.tryFind register
    match registerValue with
    | Some v -> v
    | _ -> 0L

let createValueGetter (value: string) =
    if (value.[0] >= 'a' && value.[0] <= 'z') then
        getRegisterValue value.[0]
    else
        let parsedValue = int64 value
        (fun (_: State) -> parsedValue)

let set register valueGetter state =
    let newRegisters = state.registers |> Map.add register (valueGetter state)
    { state with exec = state.exec + 1; registers = newRegisters }

let add register valueGetter state =
    let newRegisters = state.registers |> Map.add register ((getRegisterValue register state) + (valueGetter state))
    { state with exec = state.exec + 1; registers = newRegisters }

let mul register valueGetter state =
    let newRegisters = state.registers |> Map.add register ((getRegisterValue register state) * (valueGetter state))
    { state with exec = state.exec + 1; registers = newRegisters }

let mod' register valueGetter state =
    let newRegisters = state.registers |> Map.add register ((getRegisterValue register state) % (valueGetter state))
    { state with exec = state.exec + 1; registers = newRegisters }

let snd valueGetter state =
    { state with exec = state.exec + 1; lastSound = (valueGetter state) }

let rcv register state =
    if (getRegisterValue register state) = 0L then { state with exec = state.exec + 1 } // ignore
    else { state with exec = -1 } // terminate

let jgz valueGetterCondition valueGetterOffset state =
    let newExec =
        if (valueGetterCondition state) > 0L then state.exec + (int (valueGetterOffset state))
        else state.exec + 1
    { state with exec = newExec }
    
let parse filename actualSnd actualRcv =
    File.ReadAllLines(filename)
    |> Seq.map 
        (fun line ->
            let parts = line.Split(' ')
            match parts.[0] with
            | "set" -> set parts.[1].[0] (createValueGetter parts.[2])
            | "add" -> add parts.[1].[0] (createValueGetter parts.[2])
            | "mul" -> mul parts.[1].[0] (createValueGetter parts.[2])
            | "mod" -> mod' parts.[1].[0] (createValueGetter parts.[2])
            | "snd" -> actualSnd (createValueGetter parts.[1])
            | "rcv" -> actualRcv parts.[1].[0]
            | "jgz" -> jgz (createValueGetter parts.[1]) (createValueGetter parts.[2])
            | _ -> raise (InvalidOperationException ("Unknown instruction " + parts.[0])))
    |> Array.ofSeq


// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Problem A
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let run (instructions: (State -> State) array) =
    let rec run' state =
        if state.exec < 0 || state.exec >= instructions.Length then state
        else
            let op = instructions.[state.exec]
            run' (op state) // tail recursion
    run' { exec = 0; registers = Map.empty<char, int64>; lastSound = -1L; receiving = false; sendsCount = 0; sndQueue = []; rcvQueue = [] }
    
(run (parse "queries/Advent/Advent2017-day18.txt" snd rcv)).Dump("Run solo")


// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Problem B
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let sndDuet valueGetter state =
    { state with exec = state.exec + 1; sendsCount = state.sendsCount + 1; sndQueue = state.sndQueue @ [valueGetter state] }

let rcvDuet register state =
    match state.rcvQueue with
    | head::tail ->
        let newRegisters = state.registers |> Map.add register head
        { state with exec = state.exec + 1; registers = newRegisters; rcvQueue = tail; receiving = false }
    | _ ->
        { state with receiving = true }

let runDuet (instructions: (State -> State) array) =
    let rec runDuet' state0 send0 state1 send1 =
        if state0.exec < 0 || state0.exec >= instructions.Length || state1.exec < 0 || state1.exec >= instructions.Length || (state0.receiving && state1.receiving) then (state0, state1)
        else
            let op0 = instructions.[state0.exec]
            let op0State = op0 { state0 with sndQueue = send0; rcvQueue = send1 }
            let op1 = instructions.[state1.exec]
            let op1State = op1 { state1 with sndQueue = op0State.rcvQueue; rcvQueue = op0State.sndQueue } // pick up updated queues after op0
            runDuet' op0State op1State.rcvQueue op1State op1State.sndQueue // tail recursion; pick up updated queues after op1

    let initState0 = { exec = 0; registers = Map.empty<char, int64> |> Map.add 'p' 0L; lastSound = -1L; receiving = false; sendsCount = 0; sndQueue = []; rcvQueue = [] }
    let initState1 = { exec = 0; registers = Map.empty<char, int64> |> Map.add 'p' 1L; lastSound = -1L; receiving = false; sendsCount = 0; sndQueue = []; rcvQueue = [] }
    runDuet' initState0 [] initState1 [] 

(runDuet (parse "queries/Advent/Advent2017-day18.txt" sndDuet rcvDuet)).Dump("Run duet")