.x output of purrr:reduce only showing for first iteration

Context (and code that works as expected):

I’m getting a strange result using a combination of kableExtra and purrr:reduce. Take the below data:

d1 <- tibble::tribble(
        ~dimension, ~albania, ~georgia, ~croatia, ~slovakia, ~czechia,  ~albania_stat_sig, ~georgia_stat_sig,  ~croatia_stat_sig, ~slovakia_stat_sig,  ~czechia_stat_sig,
         "beaches",       1L,       3L,       4L,        6L,       4L,  "positive, small",  "positive, large",  "positive, small", "positive, medium",        "no change",
           "coast",       5L,       1L,       4L,        2L,       2L,        "no change", "positive, medium",  "positive, large",  "positive, small",        "no change",
          "forest",       2L,       2L,       2L,        5L,       1L,  "positive, small",       "no change", "negative, medium",  "positive, small", "positive, medium",
  "cost of living",       1L,       7L,       3L,        8L,       5L, "positive, medium",       "no change",        "no change", "positive, medium",  "positive, small",
   "public safety",       6L,       9L,       1L,        2L,       7L,  "negative, large", "negative, small",        "no change",  "negative, large",  "negative, small"
)

In the code below, I make a table that color codes the cells and makes the numeric values conditionally white/black. Note that in the function call (second chunk below) i’m printing out the results of .x and .y. As expected, on each iteration of reduce, .x contains all the html that comprises the kable table, and .y contains the number of the iteration.

library(kableExtra)
library(dplyr)
library(purrr)

pal_color <- function(x) {
  case_when(
    x == "positive, small" ~ "#9AFF9A",
    x == "positive, medium" ~ "#7CCD7C",
    x == "positive, large" ~ "#548B54",
    x == "negative, small" ~ "#FF6A6A",
    x == "negative, medium" ~ "#CD5555",
    x == "negative, large" ~ "#8B3A3A",
    TRUE ~ "white"
  )
}

pal_textcolor <- function(x) {
  case_when(
    x == "positive, medium" ~ "white",
    x == "positive, large" ~ "white",
    x == "negative, large" ~ "white",
    TRUE ~ "black"
  )
}

d1 %>%
  select(1:6) %>%
  kbl() %>%
  kable_paper(full_width = F) %>%
  purrr::reduce(
    2:6, function(.x, .y) {
      col <- names(d1)[[.y]]
      print(paste("x =", .x))
      print(paste("y =", .y))
      column_spec(.x, .y,
                  background = pal_color(d1[[paste0(col, "_stat_sig")]]),
                  color = pal_textcolor(d1[[paste0(col, "_stat_sig")]])
      )  
    },
    .init = .
  )

Code that does not work as expected:

However, if I add a new column to the tibble called constant that is just a single string value in all rows and try and run the same function the .x value only contains the relevant html output in the first iteration of reduce and is empty on subsequent iterations.

d2 <- tibble::tribble(
~constant,       ~dimension, ~albania, ~georgia, ~croatia, ~slovakia, ~czechia,  ~albania_stat_sig, ~georgia_stat_sig,  ~croatia_stat_sig, ~slovakia_stat_sig,  ~czechia_stat_sig,
 "AAAAAA",        "beaches",       1L,       3L,       4L,        6L,       4L,  "positive, small",  "positive, large",  "positive, small", "positive, medium",        "no change",
 "AAAAAA",          "coast",       5L,       1L,       4L,        2L,       2L,        "no change", "positive, medium",  "positive, large",  "positive, small",        "no change",
 "AAAAAA",         "forest",       2L,       2L,       2L,        5L,       1L,  "positive, small",       "no change", "negative, medium",  "positive, small", "positive, medium",
 "AAAAAA", "cost of living",       1L,       7L,       3L,        8L,       5L, "positive, medium",       "no change",        "no change", "positive, medium",  "positive, small",
 "AAAAAA",  "public safety",       6L,       9L,       1L,        2L,       7L,  "negative, large", "negative, small",        "no change",  "negative, large",  "negative, small"
)

d2 %>%
  select(2:7) %>%
  kbl() %>%
  kable_paper(full_width = F) %>%
  purrr::reduce(
    3:7, function(.x, .y) {
      col <- names(d2)[[.y]]
      print(paste("x =", .x))
      print(paste("y =", .y))
      # column_spec(.x, .y,
      #             background = pal_color(d2[[paste0(col, "_stat_sig")]]),
      #             color = pal_textcolor(d2[[paste0(col, "_stat_sig")]])
      # )  
    },
    .init = .
  )

Error messages:

I have been trying to troubleshoot this for hours and honestly have no idea what’s going on. I’ve tried every combination of numbers I can think of for the indexing, but I always get one of two errors:

Error in xml_children(x)[[search]] : subscript out of bounds

or:

Error in if (substr(color, 1, 1) != "#" | nchar(color) != 9) return(color) : 
  missing value where TRUE/FALSE needed
In addition: Warning messages:
1: In ensure_len_html(color, nrows, "color") :
  The number of provided values in color does not equal to the number of rows. 
2: In ensure_len_html(background, nrows, "background") :
  The number of provided values in background does not equal to the number of rows. 

Can anyone see where i’m going wrong here?

>Solution :

Let’s take a look at your code:

d2 %>%
  select(2:7) %>%
  kbl() %>%
  kable_paper(full_width = F)

This creates an object with 7 - 2 + 1 = 6 columns because you just select 2:7. So your next step, using reduce on 3:7 will try to access column 7 which doesn’t exists, resulting in a subscript out of bounds error.

To correct your code, you need to do some small adjustments:

d2 %>%
  select(2:7) %>%
  kbl() %>%
  kable_paper(full_width = F) %>% 
  purrr::reduce(
    2:6, # just iterate from 2 to 6 like in d1
    function(.x, .y) {
      col <- names(d2)[[.y + 1]]  # add 1 to take care of the new 'constant' column
      print(paste("x =", .x))
      print(paste("y =", .y + 1)) # add 1
      column_spec(.x, .y, # don't add 1
                  background = pal_color(d2[[paste0(col, "_stat_sig")]]),
                  color = pal_textcolor(d2[[paste0(col, "_stat_sig")]])
      )
    },
    .init = .
  )

This returns