.x purrr:reduce 的输出只显示第一次迭代

Question

我使用

kableExtra

和

purrr:reduce

的组合得到了一个奇怪的结果。取以下数据：

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"
)

在下面的代码中，我制作了一个表格，对单元格进行颜色编码，并有条件地将数值设为白色/黑色。请注意，在函数调用（下面的第二个块）中，我正在打印出

.x

和

.y

的结果。正如预期的那样，在

reduce

的每次迭代中，

.x

包含构成 kable 表的所有 html，而

.y

包含迭代次数。

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 = .
  )

但是，如果我向名为

constant

的 tibble 添加一个新列，它只是所有行中的单个字符串值，并尝试运行相同的函数，则

.x

值仅包含

 的第一次迭代中的相关 html 输出reduce

并且在后续迭代中为空。

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 in xml_children(x)[[search]] : subscript out of bounds

或：

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.

有人能看出我哪里错了吗？