Flextable footnotes based on cell value

Question

I'm working on creating some tables and have run into another stumbling block. I am attempting to place footnotes into the body of the table based on the cell value, in this case c . What makes this a bit more tricky than standard is the use of dynamically generated names, represented in the example as b.* . I've managed to get them to color selectively based on cell value, but the same solution does not appear to work for the footnotes. The issue lies specifically in the footnotes(i=) portion where in this instance I attempt to dump some formulas. Any suggestions would be greatly appreciated.

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

Answer 1

I'm not familiar with flextable and there may be a more elegant way to do this, but I think I've got it working. The table now places a superscript 'a' on any cells containing a 'c' in the b.* columns.

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