Day 17 Part 2 & Day 22

2024/R/day17.qmd

@@ -12,13 +12,13 @@ author:
 # Libraries
 library(tidyverse)
 library(unglue)
+library(bit64)
 
 # Read input from file
 input <- read_lines("../input/day17.txt", skip_empty_rows = TRUE) |> 
   unglue_data(patterns = c(
     "{label}: {value}"
   ))
-
 ```
 
 ## Part 1
@@ -89,11 +89,30 @@ run_machine <- function(machine) {
     operand <- machine$program[machine$pointer + 2]
     machine <- run_opcode(machine, opcode, operand)
   }
-  print(machine$output)
+  return(machine$output)
 }
 
 ```
 
+Need to define custom bitwise XOR function to handle very large integers without error:
+
+```{r}
+bitwXor64 <- function(x, y) {
+  x <- as.bitstring(as.integer64(x))
+  y <- as.bitstring(as.integer64(y))
+  
+  base::xor(
+    as.integer(str_split_1(x, "")), 
+    as.integer(str_split_1(y, ""))
+  ) |> 
+    as.integer() |> 
+    str_c(collapse = "") |> 
+    structure(class = "bitstring") |> 
+    as.integer64() |> 
+    as.numeric()
+}
+```
+
 Define the opcode functions:
 
 ```{r}
@@ -105,7 +124,7 @@ adv <- function(machine, operand) {
 }
 
 bxl <- function(machine, operand) {
-  machine$B <- bitwXor(machine$B, operand)
+  machine$B <- bitwXor64(machine$B, operand)
   machine$pointer <- machine$pointer + 2
   return(machine)
 }
@@ -125,16 +144,15 @@ jnz <- function(machine, operand) {
 }
 
 bxc <- function(machine, operand) {
-  machine$B <- bitwXor(machine$B, machine$C)
+  machine$B <- bitwXor64(machine$B, machine$C)
   machine$pointer <- machine$pointer + 2
   return(machine)
 }
 
 out <- function(machine, operand) {
-  machine$output <- str_c(
+  machine$output <- c(
     machine$output, 
-    combo(machine, operand) %% 8, 
-    sep = ","
+    combo(machine, operand) %% 8
   )
   machine$pointer <- machine$pointer + 2
   return(machine)
@@ -158,8 +176,46 @@ Run on puzzle input:
 
 ```{r}
 
-run_machine(machine)
+run_machine(machine) |> 
+  str_c(collapse = ",")
 
 ```
 
+## Part 2
+
+Reverse engineer, testing sequences of 3 bits at a time. Thanks to hints from [Reddit](https://www.reddit.com/r/adventofcode/comments/1hg38ah/comment/m2odsfl/?utm_source=share&utm_medium=web3x&utm_name=web3xcss&utm_term=1&utm_content=share_button):
 
+```{r}
+
+run_machine_a <- function(a) run_machine(list(
+  program = program, 
+  A = a, 
+  B = B, 
+  C = C, 
+  pointer = 0L, 
+  output = NULL
+))
+
+reveng <- function(program, digit = 1, a = 0) {
+  if (digit > length(program))
+    return(a)
+  
+  df <- tibble(candidates = 8 * a + 0:7) |> 
+    mutate(
+      output = map(candidates, run_machine_a),
+      output = map(output, head, n = 1)
+    ) |> 
+    filter(output == rev(program)[digit]) |> 
+    mutate(
+      res = map_dbl(candidates, ~ reveng(program, digit + 1, .x))
+    ) |> 
+    filter(!is.na(res))
+  
+  if (nrow(df) == 0) return(Inf)
+  else return(min(df$res))
+}
+
+reveng(program) |> 
+  format(scientific = FALSE)
+
+```

2024/R/day22.qmd

@@ -0,0 +1,121 @@
+---
+title: "Day 22"
+date: 2024-12-22
+author:
+  name: https://adventofcode.com/2024/day/22
+  url: https://adventofcode.com/2024/day/22
+---
+
+## Setup
+
+```{r setup}
+# Libraries
+library(tidyverse)
+library(bit64)
+library(memoise)
+
+# Read input from file
+input <- read_lines("../input/day22.txt", skip_empty_rows = TRUE) |> 
+  as.numeric()
+```
+
+## Part 1
+
+Define custom bitwise XOR function, needed to handle large integers:
+
+```{r}
+bitwXor64 <- function(x, y) {
+  x <- as.bitstring(as.integer64(x))
+  y <- as.bitstring(as.integer64(y))
+  
+  map2_chr(
+    x |> str_split("") |> map(as.integer), 
+    y |> str_split("") |> map(as.integer),
+    ~ base::xor(.x, .y) |> 
+      as.integer() |> 
+      str_c(collapse = "")
+  ) |> 
+    structure(class = "bitstring") |>
+    as.integer64() |>
+    as.numeric()
+}
+```
+
+Define the algorithm for producing a sequence of "secret" numbers:
+
+```{r}
+
+mix   <- memoise::memoise(\(a, b) bitwXor64(a, b))
+prune <- \(x) x %% 16777216
+
+secret_alg <- function(x) {
+  x1 <- prune(mix(x, x * 64))
+  x2 <- prune(mix(x1, floor(x1 / 32)))
+  x3 <- prune(mix(x2, x2 * 2048))
+  return(x3)
+}
+
+secret_seq <- function(init, len) {
+  out <- list(init)
+  for (i in 2:len) {
+    out[[i]] <- secret_alg(pluck(out, i - 1))
+  }
+  out
+}
+
+```
+
+Run puzzle input:
+
+```{r}
+
+secret_nums <- secret_seq(input, len = 2001)
+
+secret_nums |> 
+  tail(n = 1) |> 
+  unlist() |> 
+  sum()
+
+```
+
+## Part 2
+
+```{r}
+
+# Convert sequences to a data frame by buyer and time
+diffs <- secret_nums |> 
+  imap_dfr(\(x, idx) tibble(time = idx, secret_number = x)) |> 
+  mutate(
+    buyer_id = row_number(),
+    .by = time
+  ) |> 
+  mutate(
+    # Get the price at each time by taking the ones digit of each secret number
+    price = secret_number %% 10L,
+    # Compute the difference in price at the current time vs the previous time
+    diff = price - lag(price),
+    # Compute the sequence of 4 price changes preceeding the current price
+    lag1 = lag(diff, n = 1L),
+    lag2 = lag(diff, n = 2L),
+    lag3 = lag(diff, n = 3L),
+    diff_seq = str_c(lag3, lag2, lag1, diff, sep = ","),
+    .by = buyer_id
+  ) |> 
+  arrange(buyer_id, time)
+
+# For each price change seq, compute the bananas you will get from each buyer:
+bananas_by_seq <- diffs |> 
+  filter(!is.na(diff_seq)) |> 
+  summarize(
+    bananas = head(price, 1),
+    .by = c(buyer_id, diff_seq)
+  )
+
+# Find the most advantageous sequence:
+bananas_by_seq |> 
+  summarize(bananas = sum(bananas), .by = diff_seq) |> 
+  slice_max(bananas) |> 
+  pull(bananas)
+
+```
+