2.1.1 Description

cpy 2 a
tgl a
tgl a
tgl a
cpy 1 a
dec a
dec a

2.1.2 Solution

This time we have to fall back to the parser, as the tgl command makes the workflow not predictable. However, we have to pre-process the instructions to simplify the multiplication block.

Look at the instructions 5 to 10:

codes <- puzzle_data  %>% 
  slice(5:10) %>% 
  set_colnames(c("Operation", "Argument 1", "Argument 2"))

datatable(
  codes, 
  class = c("compact", "nowrap", "hover", "row-border"),
  options = list(
    pageLength = nrow(codes),
    dom = "t",
    ordering = FALSE,
    columnDefs = list(
      list(
        className = "dt-center", targets = "_all"
      )
    ))
)

This translates into the following code:

while (d > 0) {
  c <- b
  while (c > 0) {
    a <- a + 1L
    c <- c - 1L
  }
  d <- d - 1L
}

This can be rewritten as

a <- a + d * c

which tremendously reduces the number of necessary iterations. Thus, we introduce 2 new operations mul and add responsible for the multiplication and the addition respectively.

• mul a b: Multiply the value of register b by the value of register a (or a constant) and store the result in register b.
• add a b: Add the value of register a (or a constant) to the value of register b and store the result in register b.

This leads to the following optimizes assembly code as a replacement of the loop based instructions:

cpy b c
mul c d
add d a
jnz 1 3

The last jnz is added to skip the next lines from the old loop. We also mark this lines as altered, to raise an error in case a later tgl wants to change any of these lines.

N.B. There would be also some improvement potential for the other add ops, but fixing this expensive loops is alrady sufficient. Analyzing the instructions one will notice certain patterns:

optimize_ops <- function(ops = puzzle_data) {
  ops <- ops %>% 
    mutate(is_altered = FALSE)
  n <- nrow(ops)
  for (i in n:6) {
    ## idea transform this:
    ## cpy b c  
    ##   inc a
    ##   dec c
    ##   jnz c -2
    ## dec d    
    ## jnz d -5 
    ## 
    ## into this
    ## 
    ## cpy b c
    ## mul d c => c <- c * d
    ## add c a => a <- a + c 
    ## jnz 1 3 (skip the rest of the old loop)
    idx <- (i - 5L):i
    op_seq <- ops %>% 
      slice(idx) %>% 
      summarize(op_seq = paste(op, collapse = "|")) %>% 
      pull(op_seq)
    if (op_seq == "cpy|inc|dec|jnz|dec|jnz") {
      ## set flag that ops are altered as a safeguard
      ## if a toggle tries to change any of the altered code raise an error
      ## (remove first op from flagging as we will keep this)
      ops[tail(idx, -1L), "is_altered"] <- TRUE
      args <- ops %>% 
        slice(i - c(4:3, 1)) %>% 
        summarize(args = list(c(arg1))) %>% 
        pull(args) %>% 
        unlist()
      ops[i - 4L, "op"] <- "mul"
      ops[i - 4L, "arg1"] <- args[3L]
      ops[i - 4L, "arg2"] <- args[2L]
      ops[i - 3L, "op"] <- "add"
      ops[i - 3L, "arg1"] <- args[2L]
      ops[i - 3L, "arg2"] <- args[1L]
      ops[i - 2L, "op"] <- "jnz"
      ops[i - 2L, "arg1"] <- "1"
      ops[i - 2L, "arg2"] <- "3"
    }
  }
  ops
}

automata <- function(eggs, ops = puzzle_data) {
  reg = c(a = eggs, b = 0L, c = 0L, d = 0L)
  line <- 1
  i <- 1
  
  get <- function(arg, ref = FALSE) {
    if (is.na(suppressWarnings(as.integer(arg)))) {
      if (ref) {
        type <- "ref"
      } else {
        arg <- reg[arg]
        type <- "reg"
      }
    } else {
      arg <- as.integer(arg)
      type <- "val"
    }
    attr(arg, "type") <- type
    arg
  }
  
  cpy <- function(arg1, arg2, ...) {
    i <<- i + 1
    new <- get(arg1)
    arg2 <- get(arg2, TRUE)
    if (attr(arg2, "type") == "ref") {
      ## need to check that we have a valid op 
      ## cpy 1 2 would be invalid and should be skipped
      reg[arg2] <<- new
    }
    line <<- line + 1L
  }
  
  inc <- function(arg1, ...) {
    i <<- i + 1
    reg[arg1] <<- reg[arg1] + 1L
    line <<- line + 1L
  }
  
  dec <- function(arg1, ...) {
    i <<- i + 1
    reg[arg1] <<- reg[arg1] - 1L
    line <<- line + 1L
  }
  
  jnz <- function(arg1, arg2, ...) {
    i <<- i + 1
    arg1 <- get(arg1)
    arg2 <- get(arg2)
    if (arg1 != 0L) {
      line <<- line + arg2
    } else {
      line <<- line + 1
    }
  }
  
  mul <- function(arg1, arg2, ...) {
    i <<- i + 1
    arg1 <- get(arg1)
    arg2 <- get(arg2, TRUE)
    stopifnot(attr(arg2, "type") == "ref")
    reg[arg2] <<- arg1 * reg[arg2] 
    line <<- line + 1
  }
  
  add <- function(arg1, arg2, ...) {
    i <<- i + 1
    arg1 <- get(arg1)
    arg2 <- get(arg2, TRUE)
    stopifnot(attr(arg2, "type") == "ref")
    reg[arg2] <<- arg1 + reg[arg2] 
    line <<- line + 1
  }
  
  tgl <- function(arg1, arg2, ...) {
    offset <- get(arg1)
    if (between(line + offset, 1L, n)) {
      op <- ops %>% 
        slice(line + offset) %>% 
        as.list()
      if (op$is_altered) {
        stop("Trying to change an instruction form a pre-processed op")
      }
      if (op$op == "inc") {
        ops[offset + line, "op"] <<- "dec"
      } else if (op$op %in% c("dec", "tgl")) {
        ops[offset + line, "op"] <<- "inc"
      } else if (op$op == "jnz") {
        ops[offset + line, "op"] <<- "cpy"
      } else if (op$op == "cpy") {
        ops[offset + line, "op"] <<- "jnz"
      } else {
        stop("tgl hit an unknown op")
      }
    }
    i <<- i + 1
    line <<- line + 1
  }
  n <- nrow(ops)
  while (line <= n) {
    ops %>% 
      slice(line) %>% 
      rename(name = op) %>% 
      as.list() %>% 
      do.call(call, .) %>% 
      eval()
  }
  list(i = i, reg = reg)
}

optimized_ops <- optimize_ops(puzzle_data)

automata(7L, optimized_ops)

## $i
## [1] 19459
## 
## $reg
##     a     b     c     d 
## 11415     1     0     0

2.2.1 Description

2.2.2 Solution

With the optimization we can also call the function with a different starting value and get a result in a reasonable time.

automata(12L, optimized_ops)

## $i
## [1] 19639
## 
## $reg
##         a         b         c         d 
## 479007975         1         0         0