Interactive Flexdashboard for Grouped Data Visualization

Based on the provided code and your request, I made the following adjustments to help you achieve your goal:

fn_plot <- function(df) {
  df_reactive <- df[, c("x", "y")] %>% highlight_key()
  pl <- ggplotly(ggplot(df, aes(x = x, y = y)) +
                 geom_point())
  t <- reactable(df_reactive)
  
  output <- bscols(widths = c(6, NA),
                     div(style = css(width = "100%", height = "100%"),
                         list(t)),
                     div(style = css(width = "100%", height = "700px"),
                         list(pl)))
  
  return(output)
}

create.page <- function(df_source.list, i) {
  df.label <- names(df_source.list)[[i]]
  df <- df_source.list[[i]]
  df.cols <- colnames(df)

  # define unique pair combinations
  subgroup_names <- sort(unique(df$subgroup))

  hcs <- map(.x = subgroup_names,
             ~ fn_plot(df %>% filter(subgroup == .x))) %>%
    setNames(subgroup_names)

  out <- map(seq_along(hcs), function(i) {
    a1 <- knit_expand(text = sprintf("### %s\n", names(hcs)[i])) 
    a2 <- knit_expand(text = "\n```{r}")
    a3 <- knit_expand(text = sprintf("\nhcs[[%d]]", i)) 
    a4 <- knit_expand(text = "\n```\n")
    paste(a1, a2, a3, a4, collapse = '\n') 
  })

  cat("Page", i, "-", df.label, "\n")
  cat("====================\n")
  cat("Column {.tabset .tabset-fade}\n")
  cat("-----------------------------\n")

  cat(knit(text = paste(out, collapse = '\n'),
           quiet = TRUE))

}

invisible(lapply(seq_along(df_source.list), function(i) create.page(df_source.list, i)))

Based on the updated functions above, you should now be able to create an interactive flexdashboard with pages corresponding to groups, tabs corresponding to subgroups, and x ~ y scatterplots.


Last modified on 2023-10-03