2022 Day 17, Part 2

2022/R/day17.qmd

@@ -14,11 +14,282 @@ author:
 library(tidyverse)
 
 # Read input from file
-input <- read_lines("../input/day17.txt", skip_empty_rows = TRUE)
+input <- read_lines("../input/day17.txt", skip_empty_rows = TRUE) |> 
+  str_split_1("") 
 
 ```
 
+## Part 1
+
+Representing obstacles as 1s and empty space as 0s, represent the shapes of the falling blocks, the floor, and the walls as bitwise integers:
+
+```{r}
+
+block1 <- strtoi(c("000111100"                                    ), base = 2)
+block2 <- strtoi(c("000010000","000111000","000010000"            ), base = 2)
+block3 <- strtoi(c("000111000","000001000","000001000"            ), base = 2)
+block4 <- strtoi(c("000100000","000100000","000100000","000100000"), base = 2)
+block5 <- strtoi(c("000110000","000110000"                        ), base = 2)
+
+walls  <- strtoi("100000001", base = 2)
+floor  <- strtoi("111111111", base = 2)
+
+blocks <- list(block1, block2, block3, block4, block5)
+
+```
+
+Define functions that give properties of the tower:
+
+```{r}
+
+# Print tower to terminal (for debugging)
+print_tower <- function(tower) {
+  tower |>
+  imap_chr(\(row, name) {
+    row |> 
+      intToBits() |> 
+      rev() |> 
+      tail(9) |> 
+      as.integer() |> 
+      case_match(0 ~ "·", 1 ~ "#") |> 
+      modify_at(.at = c(1L, 9L), .f = ~ "|") |> 
+      str_c(collapse = "") |> 
+      str_c(name, sep = " ")
+  }) |> 
+  modify_at(.at = 1L, .f = ~ if_else(.x == "|#######| 0", "+-------+ 0", .x)) |> 
+  rev() |> 
+  cat(sep = "\n")
+}
+
+tower_height <- function(tower) {
+  idx <- max(which(tower != walls))
+  tower[idx] |>
+    names() |> 
+    as.double()
+}
+
+tower_base <- function(tower) {
+  idx <- max(which(accumulate(tower, bitwOr, .dir = "backward") == floor))
+  tower[idx] |>
+    names() |> 
+    as.double()
+}
+
+trim_tower <- function(tower) {
+  base <- tower_base(tower)
+  top  <- tower_height(tower)
+  tower[as.character(base:top)]
+}
+
+```
+
+Define functions that move blocks and check if the move is valid:
+
+```{r}
+
+shift_block <- function(block, dir) {
+  f <- switch(dir, 
+    "<" = bitwShiftL, 
+    ">" = bitwShiftR
+  )
+  f(block, 1)
+}
+
+is_collision <- function(block, tower_slice) {
+  any(bitwAnd(block, tower_slice) > 0)
+}
+
+# Try to move the block L/R if the move is valid, or return the old one if not
+try_shift_block <- function(block, dir, tower_slice) {
+  new <- shift_block(block, dir)
+  if (is_collision(new, tower_slice))
+    block
+  else
+    new
+}
+
+```
+
+Define a function to drop blocks onto a tower:
+
+```{r}
+
+drop_blocks <- function(jets, n_blocks) {
+  
+  tower        <- floor
+  names(tower) <- 1:length(tower) - 1
+  
+  n_jets <- length(jets)
+  time   <- 0
+  
+  # Cycle through the list of blocks and drop them in order
+  for (i in 1:n_blocks) {
+    
+    block_idx <- (i - 1) %% length(blocks) + 1
+    block     <- blocks[[block_idx]]
+    
+    # Initialize the vertical location of the block
+    block_loc <- 1:length(block) + 3 + tower_height(tower)
+    
+    # Add empty wall space to the top of the tower
+    add_walls <- rep(walls, length(block) + 3) |> 
+      set_names(c(min(block_loc) - 3:1, block_loc))
+    tower <- c(tower, add_walls)
+    
+    # Drop block until it comes to rest
+    repeat {
+      jet_idx <- time %% n_jets + 1
+      
+      # Apply jet blast & increment time
+      block <- try_shift_block(block, jets[jet_idx], tower[as.character(block_loc)])
+      time <- time + 1
+      
+      # Check if block has come to rest; if so, add block to tower
+      if (is_collision(block, tower[as.character(block_loc - 1)])) {
+        tower[as.character(block_loc)] <- bitwOr(tower[as.character(block_loc)], block)
+        tower <- trim_tower(tower)
+        break
+        
+      } 
+      # Otherwise drop block one unit and repeat the block jet seq
+      else {
+        block_loc <- block_loc - 1
+      }
+    }
+  }
+  
+  tower
+}
+
+```
+
+Run on puzzle input:
+
+```{r}
+
+input |> 
+  drop_blocks(2022) |> 
+  tower_height()
+
+```
+
+## Part 2
+
+Modify the drop_blocks function to loop until a cycle is found and return cycle info:
+
+```{r}
+
+find_cycle <- function(jets) {
+  
+  tower        <- floor
+  names(tower) <- 1:length(tower) - 1
+  
+  n_jets <- length(jets)
+  time   <- 0
+  states <- tibble(
+    n_blocks  = numeric(0),
+    tower_idx = list(),
+    tower_val = list(), 
+    block_idx = numeric(0), 
+    jet_idx   = numeric(0)
+  )
+  
+  i <- 1
+  # Cycle through the list of blocks and drop them in order
+  repeat {
+    
+    block_idx <- (i - 1) %% length(blocks) + 1
+    block     <- blocks[[block_idx]]
+    
+    # Initialize the vertical location of the block
+    block_loc <- 1:length(block) + 3 + tower_height(tower)
+    
+    # Add empty wall space to the top of the tower
+    add_walls <- rep(walls, length(block) + 3) |> 
+      set_names(c(min(block_loc) - 3:1, block_loc))
+    tower <- c(tower, add_walls)
+    
+    # Drop block until it comes to rest
+    repeat {
+      jet_idx <- time %% n_jets + 1
+      
+      # Apply jet blast & increment time
+      block <- try_shift_block(block, jets[jet_idx], tower[as.character(block_loc)])
+      time <- time + 1
+      
+      # Check if block has come to rest; if so, add block to tower
+      if (is_collision(block, tower[as.character(block_loc - 1)])) {
+        tower[as.character(block_loc)] <- bitwOr(tower[as.character(block_loc)], block)
+        tower <- trim_tower(tower)
+        
+        # Add block and jet index to the states list
+        states <- states |> 
+          add_row(
+            n_blocks  = i,
+            tower_idx = list(names(tower)),
+            tower_val = list(unname(tower)),
+            block_idx = block_idx,
+            jet_idx   = jet_idx
+          )
+        # print(tower)
+        break
+        
+      } 
+      # Otherwise drop block one unit and repeat the block jet seq
+      else {
+        block_loc <- block_loc - 1
+      }
+    }
+    
+    i <- i + 1
+    
+    # After each block is dropped, check if a cycle has been found and return it
+    dupes <- states |> 
+      filter(n_distinct(tower_val) != n(), .by = c(block_idx, jet_idx))
+    
+    if (nrow(dupes) > 0) {
+      
+      cycle_length <- dupes |>
+        pull(n_blocks) |>
+        reduce(`-`) |>
+        abs()
+
+      cycle_start <- dupes |>
+        pull(n_blocks) |>
+        min()
+      
+      cycle_height <- dupes |>
+        pull(tower_idx) |> 
+        map(as.numeric) |> 
+        reduce(`-`) |> 
+        unique() |> 
+        abs()
+
+      return(list(length = cycle_length, start = cycle_start, height = cycle_height))
+      return(dupes)
+    }
+  }
+}
+
+```
+
+Get the cycle of the puzzle input:
+
+```{r}
+
+cycle <- find_cycle(input)
+
+```
+
+Using the cycle info from the output, compute the majority of the height using the cycle, then and add the height of the remaineder:
+
 ```{r}
 
+n_cycles <- floor((1000000000000 - cycle$start) / cycle$length)
+n_blocks <- (1000000000000 - cycle$start) %% cycle$length + cycle$start
+
+((n_cycles * cycle$height) + tower_height(drop_blocks(input, n_blocks))) |> 
+  format(scientific = FALSE)
+
 ```
 

_freeze/2022/R/day17/execute-results/html.json

@@ -0,0 +1,15 @@
+{
+  "hash": "af1897f0c7a96af5f4b5d699c1a86e00",
+  "result": {
+    "engine": "knitr",
+    "markdown": "---\ntitle: \"Day 17\"\ndate: 2022-12-17\nauthor:\n  name: https://adventofcode.com/2022/day/17\n  url: https://adventofcode.com/2022/day/17\n---\n\n\n\n\n## Setup\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Libraries\nlibrary(tidyverse)\n\n# Read input from file\ninput <- read_lines(\"../input/day17.txt\", skip_empty_rows = TRUE) |> \n  str_split_1(\"\") \n```\n:::\n\n\n\n\n## Part 1\n\nRepresenting obstacles as 1s and empty space as 0s, represent the shapes of the falling blocks, the floor, and the walls as bitwise integers:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nblock1 <- strtoi(c(\"000111100\"                                    ), base = 2)\nblock2 <- strtoi(c(\"000010000\",\"000111000\",\"000010000\"            ), base = 2)\nblock3 <- strtoi(c(\"000111000\",\"000001000\",\"000001000\"            ), base = 2)\nblock4 <- strtoi(c(\"000100000\",\"000100000\",\"000100000\",\"000100000\"), base = 2)\nblock5 <- strtoi(c(\"000110000\",\"000110000\"                        ), base = 2)\n\nwalls  <- strtoi(\"100000001\", base = 2)\nfloor  <- strtoi(\"111111111\", base = 2)\n\nblocks <- list(block1, block2, block3, block4, block5)\n```\n:::\n\n\n\n\nDefine functions that give properties of the tower:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# Print tower to terminal (for debugging)\nprint_tower <- function(tower) {\n  tower |>\n  imap_chr(\\(row, name) {\n    row |> \n      intToBits() |> \n      rev() |> \n      tail(9) |> \n      as.integer() |> \n      case_match(0 ~ \"·\", 1 ~ \"#\") |> \n      modify_at(.at = c(1L, 9L), .f = ~ \"|\") |> \n      str_c(collapse = \"\") |> \n      str_c(name, sep = \" \")\n  }) |> \n  modify_at(.at = 1L, .f = ~ if_else(.x == \"|#######| 0\", \"+-------+ 0\", .x)) |> \n  rev() |> \n  cat(sep = \"\\n\")\n}\n\ntower_height <- function(tower) {\n  idx <- max(which(tower != walls))\n  tower[idx] |>\n    names() |> \n    as.double()\n}\n\ntower_base <- function(tower) {\n  idx <- max(which(accumulate(tower, bitwOr, .dir = \"backward\") == floor))\n  tower[idx] |>\n    names() |> \n    as.double()\n}\n\ntrim_tower <- function(tower) {\n  base <- tower_base(tower)\n  top  <- tower_height(tower)\n  tower[as.character(base:top)]\n}\n```\n:::\n\n\n\n\nDefine functions that move blocks and check if the move is valid:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nshift_block <- function(block, dir) {\n  f <- switch(dir, \n    \"<\" = bitwShiftL, \n    \">\" = bitwShiftR\n  )\n  f(block, 1)\n}\n\nis_collision <- function(block, tower_slice) {\n  any(bitwAnd(block, tower_slice) > 0)\n}\n\n# Try to move the block L/R if the move is valid, or return the old one if not\ntry_shift_block <- function(block, dir, tower_slice) {\n  new <- shift_block(block, dir)\n  if (is_collision(new, tower_slice))\n    block\n  else\n    new\n}\n```\n:::\n\n\n\n\nDefine a function to drop blocks onto a tower:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ndrop_blocks <- function(jets, n_blocks) {\n  \n  tower        <- floor\n  names(tower) <- 1:length(tower) - 1\n  \n  n_jets <- length(jets)\n  time   <- 0\n  \n  # Cycle through the list of blocks and drop them in order\n  for (i in 1:n_blocks) {\n    \n    block_idx <- (i - 1) %% length(blocks) + 1\n    block     <- blocks[[block_idx]]\n    \n    # Initialize the vertical location of the block\n    block_loc <- 1:length(block) + 3 + tower_height(tower)\n    \n    # Add empty wall space to the top of the tower\n    add_walls <- rep(walls, length(block) + 3) |> \n      set_names(c(min(block_loc) - 3:1, block_loc))\n    tower <- c(tower, add_walls)\n    \n    # Drop block until it comes to rest\n    repeat {\n      jet_idx <- time %% n_jets + 1\n      \n      # Apply jet blast & increment time\n      block <- try_shift_block(block, jets[jet_idx], tower[as.character(block_loc)])\n      time <- time + 1\n      \n      # Check if block has come to rest; if so, add block to tower\n      if (is_collision(block, tower[as.character(block_loc - 1)])) {\n        tower[as.character(block_loc)] <- bitwOr(tower[as.character(block_loc)], block)\n        tower <- trim_tower(tower)\n        break\n        \n      } \n      # Otherwise drop block one unit and repeat the block jet seq\n      else {\n        block_loc <- block_loc - 1\n      }\n    }\n  }\n  \n  tower\n}\n```\n:::\n\n\n\n\nRun on puzzle input:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ninput |> \n  drop_blocks(2022) |> \n  tower_height()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n[1] 3133\n```\n\n\n:::\n:::\n\n\n\n\n## Part 2\n\nModify the drop_blocks function to loop until a cycle is found and return cycle info:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nfind_cycle <- function(jets) {\n  \n  tower        <- floor\n  names(tower) <- 1:length(tower) - 1\n  \n  n_jets <- length(jets)\n  time   <- 0\n  states <- tibble(\n    n_blocks  = numeric(0),\n    tower_idx = list(),\n    tower_val = list(), \n    block_idx = numeric(0), \n    jet_idx   = numeric(0)\n  )\n  \n  i <- 1\n  # Cycle through the list of blocks and drop them in order\n  repeat {\n    \n    block_idx <- (i - 1) %% length(blocks) + 1\n    block     <- blocks[[block_idx]]\n    \n    # Initialize the vertical location of the block\n    block_loc <- 1:length(block) + 3 + tower_height(tower)\n    \n    # Add empty wall space to the top of the tower\n    add_walls <- rep(walls, length(block) + 3) |> \n      set_names(c(min(block_loc) - 3:1, block_loc))\n    tower <- c(tower, add_walls)\n    \n    # Drop block until it comes to rest\n    repeat {\n      jet_idx <- time %% n_jets + 1\n      \n      # Apply jet blast & increment time\n      block <- try_shift_block(block, jets[jet_idx], tower[as.character(block_loc)])\n      time <- time + 1\n      \n      # Check if block has come to rest; if so, add block to tower\n      if (is_collision(block, tower[as.character(block_loc - 1)])) {\n        tower[as.character(block_loc)] <- bitwOr(tower[as.character(block_loc)], block)\n        tower <- trim_tower(tower)\n        \n        # Add block and jet index to the states list\n        states <- states |> \n          add_row(\n            n_blocks  = i,\n            tower_idx = list(names(tower)),\n            tower_val = list(unname(tower)),\n            block_idx = block_idx,\n            jet_idx   = jet_idx\n          )\n        # print(tower)\n        break\n        \n      } \n      # Otherwise drop block one unit and repeat the block jet seq\n      else {\n        block_loc <- block_loc - 1\n      }\n    }\n    \n    i <- i + 1\n    \n    # After each block is dropped, check if a cycle has been found and return it\n    dupes <- states |> \n      filter(n_distinct(tower_val) != n(), .by = c(block_idx, jet_idx))\n    \n    if (nrow(dupes) > 0) {\n      \n      cycle_length <- dupes |>\n        pull(n_blocks) |>\n        reduce(`-`) |>\n        abs()\n\n      cycle_start <- dupes |>\n        pull(n_blocks) |>\n        min()\n      \n      cycle_height <- dupes |>\n        pull(tower_idx) |> \n        map(as.numeric) |> \n        reduce(`-`) |> \n        unique() |> \n        abs()\n\n      return(list(length = cycle_length, start = cycle_start, height = cycle_height))\n      return(dupes)\n    }\n  }\n}\n```\n:::\n\n\n\n\nGet the cycle of the puzzle input:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ncycle <- find_cycle(input)\n```\n:::\n\n\n\n\nUsing the cycle info from the output, compute the majority of the height using the cycle, then and add the height of the remaineder:\n\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nn_cycles <- floor((1000000000000 - cycle$start) / cycle$length)\nn_blocks <- (1000000000000 - cycle$start) %% cycle$length + cycle$start\n\n((n_cycles * cycle$height) + tower_height(drop_blocks(input, n_blocks))) |> \n  format(scientific = FALSE)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n[1] \"1547953216393\"\n```\n\n\n:::\n:::\n",
+    "supporting": [],
+    "filters": [
+      "rmarkdown/pagebreak.lua"
+    ],
+    "includes": {},
+    "engineDependencies": {},
+    "preserve": {},
+    "postProcess": true
+  }
+}

docs/2022/R/day01.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 1</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day02.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 2</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day03.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 3</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day04.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 4</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day05.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 5</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day06.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 6</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>

docs/2022/R/day07.html

@@ -400,6 +400,12 @@ <h1 class="quarto-secondary-nav-title">Day 7</h1>
   <a href="../../2022/R/day16.html" class="sidebar-item-text sidebar-link">
  <span class="menu-text">Day 16</span></a>
   </div>
+</li>
+          <li class="sidebar-item">
+  <div class="sidebar-item-container"> 
+  <a href="../../2022/R/day17.html" class="sidebar-item-text sidebar-link">
+ <span class="menu-text">Day 17</span></a>
+  </div>
 </li>
       </ul>
   </li>