基于单元格值的Flextable脚注

Question

我正在创建一些表格，并遇到了另一个障碍。我试图根据单元格值（在这种情况下为c）将脚注放入表格正文中。使其比标准更加棘手的是使用动态生成的名称，如示例中所表示的b.*。我已经成功地根据单元格值进行了有选择性的颜色处理，但相同的解决方案似乎不适用于脚注。问题明确出现在footnotes(i=)部分，在这种情况下，我尝试卸载一些公式。任何建议都将不胜感激。

library(tidyverse) 
library(rlang)

a <- as_tibble(x =cbind( Year = c(2018, 2019, 2020),
                         a = 1:3,
                         b.1 = c("a", "b", "c"),
                         b.2 = c("c", "b", "a"), 
                         fac = c("This", "This","That"))) %>% 
  mutate(across(Year:a, ~as.numeric(.)),
         across(where(is.character), ~ as.factor(.)))


foo <- function(x, y, z, ...){
  y_var <- enquo(y)
  
  x %>%
    filter(Year %in% c(2019, 2020),
           ...) %>%
    mutate(!!quo_name(y_var) := factor(!!y_var,
                              levels = z,
                              ordered = TRUE)) %>%
    arrange(!!y_var)
    
}


to.table <- function(x, y, z, ...){
  y_var <- enquo(y)
  
  df.in <- foo(x=x,
               y=!!y_var,
               z= z)
  cond <- as.formula(glue::glue('~ !is.na({quo_name(y_var)})'))
 
  #Columns to evaluate
  cols.eval <- names(df.in)[startsWith(names(df.in), prefix = "b")]
  bg_picker <- scales::col_factor(
    domain = c("a", "b", "c"),
    palette = c("green", "white", "Red3"),
    levels = c("a", "b", "c"),
    ordered = TRUE
  )
  
  
  
  flextable(df.in) %>%
    bold(i = cond,
         part = "body") %>%
    bg(j = cols.eval,
       bg = bg_picker) %>%
    footnote(j = cols.eval,
             i = lapply(paste("~ ", cols.eval, " == \"c\""), as.formula),
             value = as_paragraph("This is the first footnote"),
             ref_symbols = "a",
             part = "body", inline = TRUE)

}

to.table(x=a,
         y=Year,
         z= c(2020,2018,2019),
         fac == "This")

- Reed

---

你能提供一个在函数外硬编码值并符合你期望的示例代码吗？ - Ronak Shah

Answer 1

我不熟悉`flextable`，也许有更好的方法来实现这个，但我认为我已经把它做好了。现在，表格会在任何包含`b.*`列中的'c'单元格上放置一个上标'a'。

library(tidyverse) 
library(rlang)
library(flextable)

a <- as_tibble(x =cbind( Year = c(2018, 2019, 2020),
  a = 1:3,
  b.1 = c("a", "b", "c"),
  b.2 = c("c", "b", "a"), 
  fac = c("This", "This","That"))) %>% 
  mutate(across(Year:a, ~as.numeric(.)),
    across(where(is.character), ~ as.factor(.)))


foo <- function(x, y, z, ...){
  y_var <- enquo(y)
  
  x %>%
    filter(Year %in% c(2019, 2020),
      ...) %>%
    mutate(!!quo_name(y_var) := factor(!!y_var,
      levels = z,
      ordered = TRUE)) %>%
    arrange(!!y_var)
  
}


to.table <- function(x, y, z, ...){
  y_var <- enquo(y)
  
  df.in <- foo(x=x,
    y=!!y_var,
    z= z)
  cond <- as.formula(glue::glue('~ !is.na({quo_name(y_var)})'))
  
  #Columns to evaluate
  cols.eval <- names(df.in)[startsWith(names(df.in), prefix = "b")]
  bg_picker <- scales::col_factor(
    domain = c("a", "b", "c"),
    palette = c("green", "white", "Red3"),
    levels = c("a", "b", "c"),
    ordered = TRUE
  )
  
  # edits start here
  get_foot_coords <- function(MARGIN, value) {
    apply(df.in[, cols.eval], MARGIN, function(x) any(x == value))
  }
  
  c_col <- cols.eval[get_foot_coords(2, 'c')]
  c_row <- get_foot_coords(1, 'c')
  
  flextable(df.in) %>%
    bold(i = cond,
      part = "body") %>%
    bg(j = cols.eval,
      bg = bg_picker) %>%
    footnote(j = c_col,
      i = c_row,
      value = as_paragraph("This is the first footnote"),
      ref_symbols = "a",
      part = "body", inline = TRUE)
  
}

to.table(x=a,
  y=Year,
  z= c(2020,2018,2019),
  fac == "This")

- ngwalton