在 R 中使用循环创建函数列表

creating list of functions using loop in R

我想创建一个函数列表,用于在 flexdashboard 中自动生成选项卡。

在下面的代码中,我想使用 tab_name_list 值来创建 plot_list 列表,而不是手动编码航空公司("DF"、“9E”等) 如下所示(随着时间的推移,值将超过三个)。 plot_list 随后被传递到循环以在 flexdashboard 中自动创建选项卡。

提供了使用 nycflights 数据的可重现示例:

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

我还没有明白你想达到什么目的。您可以使用简单的 lapply(或者 purrr::map)生成 plot_list

plot_list <- lapply(tab_names_list, create_dt)

这会为您节省 'manually coding the airline carriers' 的精力,但这是否解决了您所有的问题?