基于单元格值的灵活脚注

如何解决基于单元格值的灵活脚注

我正在创建一些表，但遇到了另一个绊脚石。我试图根据单元格值将脚注放入表格正文中，在本例中为 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","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,...) %>%
    mutate(!!quo_name(y_var) := factor(!!y_var,levels = z,ordered = TRUE)) %>%
    arrange(!!y_var)
    
}


to.table <- function(x,...){
  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",palette = c("green","white","Red3"),levels = c("a",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")

解决方法

我不熟悉 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","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,...) %>%
    mutate(!!quo_name(y_var) := factor(!!y_var,levels = z,ordered = TRUE)) %>%
    arrange(!!y_var)
  
}


to.table <- function(x,...){
  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",palette = c("green","white","Red3"),levels = c("a",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")