R Markdown Shiny renderPlot 来自 lapply 的绘图列表

cha*_*off 4 r lapply r-markdown shiny openair

我正在开发 R Markdown Shiny 文档来:

  1. 对数据框进行子集化以包含“日期”列和一些数字数据列。设置闪亮的用户输入的方式,您选择要包含的数据列的单选按钮,然后单击“子集数据”按钮进行创建d()- 没有问题:)
  2. 生成一个绘图列表 ( plotList),每个数值数据列一个(针对日期列绘制)。我正在使用openairtimePlot函数来生成绘图,并lapply生成绘图对象列表(plotList) - 没有问题:)
  3. 用于renderPlot将所有绘图输出plotList到 R Markdown 文档中 - 问题:(

我知道也有类似的问题(例如https://gist.github.com/wch/5436415/,R闪亮的反应性与玩具示例,并使用闪亮动态添加绘图到网页),请相信我我已经尝试过并尝试过(例如,使用 for 循环而不是 lapply - 不是我的偏好,但如果它有效那么谁在乎;添加 local() 和/或observe();等等)。无论我做什么,我都无法让它发挥作用。我是 R Markdown 和 Shiny 的新手,我只是无法弄清楚这一点 - 请帮忙!

这是一个可重现的示例(作为 R markdown 闪亮文档运行)。

首先是创建反应式数据集的块d()

```{r reactive-dataset, echo=FALSE,message=FALSE}
library(openair)
library(dplyr)
data<-mydata[1:50,]
print(tbl_df(data))

inputPanel(
  checkboxGroupInput(inputId="p",
                label="select pollutants to plot",
                choices=names(data)[-1]
              ),
  actionButton(inputId="import",
               label="Subset Data")
)


d<-eventReactive(input$import,{
  d<-data %>% select(date,one_of(input$p))
  })

renderPrint({tbl_df(d())})
```
Run Code Online (Sandbox Code Playgroud)

现在是第二个块,创建plotList并输出它(部分不起作用):

尝试 1:仅显示最后一个图

 ```{r plot,echo=FALSE,message=FALSE}
 renderPlot({
  i<-names(d())[-1]
  tp<-function(x){
    p<-timePlot(d(),
         pollutant=print(x),
         main="Minute Validation",
         ylab="Minute Conc. (ug/m3 or ppb)",
         key=T)
    p$plot
    }
  lapply(i,tp)

  }) 
  ``` 
Run Code Online (Sandbox Code Playgroud)

尝试 2(基于R闪亮的反应性和玩具示例)。没有显示任何图

```{r plot,echo=FALSE,message=FALSE}
plotList<-reactive({
  i<-names(d())[-1]
  tp<-function(x){
    p<-timePlot(d(),
         pollutant=print(x),
         main="Minute Validation",
         ylab="Minute Conc. (ug/m3 or ppb)",
         key=T)
    p$plot
    }
  lapply(i,tp)
  })


observe({
  for (j in 1:length(plotList())){
    local({
      my_j<-j
      renderPlot({plotList()[[my_j]]})

      })#end local
    } #end for loop
}) #end observe
```
Run Code Online (Sandbox Code Playgroud)

我无休止地摆弄这个问题,参考我上面链接的类似问题。

Xio*_*Jin 5

[新答案]

我终于把这个解决了。关键是完全遵循帖子第三个链接中的示例,首先使用 renderUI!

```{r plot,echo=FALSE,message=FALSE}
tp_list <- reactive({
  i<-names(d())[-1]
  tp<-function(x){
    p<-timePlot(d(),
         pollutant=print(x),
         main="Minute Validation",
         ylab="Minute Conc. (ug/m3 or ppb)",
         key=T)
    p$plot
  }
  lapply(i, tp)
}) 

renderUI({
    plot_output_list <- lapply(1:length(tp_list()), function(i) {
        plotname <- paste("plot", i, sep="")
        plotOutput(plotname)
    })
    do.call(tagList, plot_output_list)
})

observe({
for (i in 1:length(tp_list())) {
    local({
        my_i <- i
        plotname <- paste("plot", my_i, sep="")
        output[[plotname]] <- renderPlot({
            tp_list()[[my_i]]
        })
    })
}
})
```
Run Code Online (Sandbox Code Playgroud)

[基于格子面板的原始答案]

这并不完全是你想要的,但我把所有的图都显示在一个图中。

```{r plot,echo=FALSE,message=FALSE}
renderPlot({
  i<-names(d())[-1]
  tp<-function(x){
    p<-timePlot(d(),
         pollutant=print(x),
         main="Minute Validation",
         ylab="Minute Conc. (ug/m3 or ppb)",
         key=T)
    p$plot
  }
  tp(i)
}) 
``` 
Run Code Online (Sandbox Code Playgroud)