Add on-hover column descriptions for several tables on Shiny with reactable

Question

The app will contains several tables. Some of the column names aro common among them, but some are different. I want to add a brief description of some columns that must show on hover over the column header. I would like to describe this text only once for the whole document, and not every time I code a new table, also so that it can be more easily manipulated in the future to add or remove column texts.

I managed to make it work for the first table, but not for a second one. The reason is, all the columns for which I defined a text description are present in table_1 -eventhough it contains more columns than those- but not all of them are present in table_2. Thus, I get an error "Error: columns names must exist in data".

A reproducible example of the code would be this one (tables are reactable because in the original code the user must select from a dropdown menu for which company he wants the data to be shown):

library(shiny)
library(shinydashboard)
library(tidyverse)
library(reactable)
library(reactable.extras)
library(htmltools)
library(shinycssloaders)
library(tippy)
library(gtExtras)

ui <- fluidPage(  
    tabItem(tabName = "tab_1",
            fluidRow(div(withSpinner(reactableOutput('table_1'))))
    ),
    tabItem(tabName = "tab_2",
            fluidRow(div(withSpinner(reactableOutput('table_2'))))
    )
)

server <- function(input, output) {
  
  df_1 <- data.frame(
    Column_A = c(10, 11, 12),
    Column_B = c(13, 17, 19),
    Column_C = c(13, 14, 15)
  )
  
  df_2 <- data.frame(
    Column_B = c(13, 17, 19),
    Column_C = c(13, 14, 15)
  )

  # Text to be shown on hover:
  columns_df <- data.frame(
    column_names = c("Column_A", "Column_B"),
    column_descriptions = c("Text_A", "Text_B")
  )
  
  output$table_1 <- renderReactable({
    df_1 %>%
      reactable(
        bordered = TRUE,
        striped = TRUE,
        highlight = TRUE,
        searchable = TRUE,
        filterable = TRUE,
        selection = "multiple",
        defaultSelected = 1:nrow(.),
        columns = pmap(columns_df, ~ {
          ..1 = colDef(header = with_tooltip(..1, HTML(paste0('<span style="font-size: 20px;">', ..2, '</span>'))))
        }) %>% set_names(columns_df$column_names)
      )
  })
  
  output$table_2 <- renderReactable({
    df_2 %>%
      reactable(
        bordered = TRUE,
        striped = TRUE,
        highlight = TRUE,
        searchable = TRUE,
        filterable = TRUE,
        selection = "multiple",
        defaultSelected = 1:nrow(.),
        columns = pmap(columns_df, ~ {
          ..1 = colDef(header = with_tooltip(..1, HTML(paste0('<span style="font-size: 20px;">', ..2, '</span>'))))
        }) %>% set_names(columns_df$column_names)
      )
  })
}

shinyApp(ui = ui, server = server)

What I need is something similar to an "if" statement that checks if there's a defined text for that column name, and does not add any "bubble" if there is none. I tried the following, but it didn't work:

columns = pmap(columns_df, ~ {
  if((..1) %in% names(df_1)) {
    ..1 = colDef(header = with_tooltip(..1, HTML(paste0('<span style="font-size: 20px;">', ..2, '</span>'))))
  } else {    
  }
}) %>% set_names(columns_df$column_names)

The "brute" solution would be for columns_df to contain the column names of all the tables, even if as en empty string. But, as I say, I'm looking for a smart and clean solution. Do you know where the problem in my code is?

Answer 1

Why not

    columns = pmap(columns_df, ~ {
      if((..1) %in% names(df_2)) {
        ..1 = colDef(header = with_tooltip(..1, HTML(paste0('<span style="font-size: 20px;">', ..2, '</span>'))))
      }
    }) %>% setNames(columns_df$column_names) %>% Filter(Negate(is.null), .)