Search code examples
rshinyr-markdownlapplyopenair

R Markdown Shiny renderPlot list of plots from lapply


I am developing an R Markdown Shiny document to:

  1. Subset a data frame to include the "date" column and some numeric data columns. The way the shiny user input is set up, you select radio buttons for the data columns to include, then hit the "Subset Data" button to create d() - NO PROBLEM:)
  2. Generate a list of plots (plotList), one for each numeric data column (plotted against the date column). I am using the openair package timePlot function to generate the plots, and lapply to generate the list of plot objects (plotList) - NO PROBLEM:)
  3. use renderPlot to output all the plots in plotList to the R Markdown document - PROBLEM:(

I know there have been similar questions (e.g https://gist.github.com/wch/5436415/, Reactivity in R shiny with toy example, and dynamically add plots to web page using shiny), and please believe me I have tried and tried (e.g. using a for loop in stead of lapply-not my preference, but if it worked then who cares; adding local() and/or observe(); etc). No matter what I do I can't get it to to work. I am new to R Markdown and to Shiny, I just can't figure this out - please help!

Here is a reproducible example (to be run as an R markdown shiny document).

First the chunk that creates a reactive dataset 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())})
```

Now the second chunk, to create plotList and output it (PART THAT DOESN'T WORK):

Attempt 1: only last plot is displayed

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

  }) 
  ``` 

Attempt 2 (based on Reactivity in R shiny with toy example). No plots are displayed

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

I have fiddled with this endlessly, referring the to similar questions that I have linked to above.


Solution

  • [New answer]

    I finally got this worked out. The key is to exactly follow the example in the third link of your post, using renderUI first!

    ```{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]]
            })
        })
    }
    })
    ```
    

    [Original answer based on lattice panels]

    This is not exactly what you want, but I got all the plots displayed in one plot.

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