在 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' 的精力,但这是否解决了您所有的问题?
我想创建一个函数列表,用于在 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' 的精力,但这是否解决了您所有的问题?