Search code examples
rflexdashboard

creating list of functions using loop in R


I'd like to create a list of functions to be used in the auto-generation of tabs in a flexdashboard.

In the below code, I'd like to use tab_name_list values to create the plot_list list instead of manually coding the airline carriers ("DF", "9E", etc) as I have below (there will be many more values than three over time). plot_list is subsequently passed to a loop to automatically create tabs in a flexdashboard.

provided reproducible example using nycflights data:

---
title: "function loop test"
output:
 flexdashboard::flex_dashboard:
   vertical_layout: fill
   theme: bootstrap
---


```{r setup, include=FALSE, warning=FALSE, cache=FALSE}
knitr::opts_chunk$set(echo = TRUE)
options(knitr.table.format = "html") 
library(rmarkdown)
library(knitr)
library(tidyr)
library(dplyr)
library(plotly)
library(ggplot2)
library(pander)
library(htmlwidgets)
library(webshot)
library(htmltools)
library(flexdashboard)
library(nycflights13)
library(DT)
```

```{R tidy failure data, include=FALSE, warning=FALSE, cache=FALSE}
top_carrier <- flights %>%
  group_by(carrier) %>%
  summarise(n = n()) %>%
  ungroup() %>%
  head(5) %>%
  select(carrier)

flights_grouped <- flights %>%
  group_by(carrier, origin, time_hour) %>%
  summarise(n = n()) %>%
  ungroup() %>%
  inner_join(top_carrier)
```


```{R plot functions, include=FALSE, warning=FALSE, cache=FALSE}
#create dt
create_dt <- function(airline) {
  df <- flights_grouped %>%
    filter(carrier==airline) %>%
    head(500)

   dt <- datatable(df, options = list(autoWidth = TRUE, "scrollY", pageLength = 500),filter = list(position = 'top', clear = FALSE), rownames = FALSE, class = 'cell-border stripe')
}
```

```{r dashboard all, results = 'asis', fig.keep = 'all', echo=F}
pander::panderOptions('knitr.auto.asis', FALSE)

tab_names_list <- sort(unique(flights_grouped$carrier))

plot_list <- list(
  create_dt("9E"),
  create_dt("AA"), 
  create_dt("AS"), 
  create_dt("B6"), 
  create_dt("DL"))


createForLoop<- function(view) {
   user_plots <- view[[i]]
      if(inherits(user_plots,"character")) {
        cat(noquote(paste0(user_plots,collapse="\n")))
      } else {
        cat(renderTags(user_plots)$html)
      }
}

createHTML <- function(view) {
  deps1 <- lapply(Filter(function(view) {
  inherits(view, "htmlwidget")
  }, view),
  function(hw) {
    renderTags(hw)$dependencies
    })
attachDependencies(tagList(),
                   unlist(deps1, recursive = FALSE))

}

 for (i in 1:length(tab_names_list)) {
   cat(" ", tab_names_list[[i]], "=====================================", " ", "Column {.tabset .tabset-fade}", "-----------------------------------------------------------------------", " ", "### dt", sep = "\n")
   createForLoop(plot_list)
   cat("\n")
 }

#attach dependencies for all html widgets printing within for loop
createHTML(plot_list)
```

Solution

  • I have not yet understood what you try to achieve. You could generate plot_list with a simple lapply (or alternatively purrr::map):

    plot_list <- lapply(tab_names_list, create_dt)
    

    This would save you the effort of 'manually coding the airline carriers', but does this solve all of your problems?