How to preserve output and add multiple outputs with Shiny modules? - r

Question

I would like to preserve the output from one input and then add more outputs.
Code:
if (interactive()) {
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
)
),
mainPanel(
plotOutput("plot")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
if (input$plotType == "scatter") {
plot(x, y)
} else {
breaks <- input$breaks
if (breaks == "custom") {
breaks <- input$breakCount
}
hist(x, breaks = breaks)
}
})
}
shinyApp(ui, server)
}
Right now the output from "Scatter" disappears if for instance I select "Histogram". I would like to keep the scatter plot and add the histogram below it, and I would like to do this indefinitely.
I tried to do a few things but I didn't know what I needed to look for or learn.
Perhaps, I can add a button called Insert new plot which resets the inputs and saves the recently made plot, and then I can choose new inputs and generate a plot, and so on.
I merged two screenshots to create a picture of what I would like to achieve

Answer 1

Here is a solution that only shows the histogram when the plottype was selected, but keeps the scatter plot and also the histogram once it was selected. For this I use a second plot output and req with a flag if the histogram was already selected.
if (interactive()) {
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
)
),
mainPanel(
plotOutput("plot"),
plotOutput("plot_2")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
hist_flag <- FALSE
output$plot <- renderPlot({
plot(x, y)
})
output$plot_2 <- renderPlot({
req(input$plotType == "hist" || hist_flag)
breaks <- input$breaks
if (breaks == "custom") {
breaks <- input$breakCount
}
hist_flag <<- TRUE
hist(x, breaks = breaks)
})
}
shinyApp(ui, server)
}
Edit
The scenario you describe is a good use-case for modules. I've created a module that contains all the logic and ui to output one plot, and then add another module every time one clicks the button:
library(shiny)
one_plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
one_plot <- function(id, x, y, type, breaks, break_counts) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot({
if (type == "scatter") {
plot(x, y)
} else {
if (breaks == "custom") {
breaks <- break_counts
}
hist(x, breaks = breaks)
}
})
}
)
}
ui <- fluidPage(
sidebarPanel(
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
),
actionButton("make_plot", "Insert new plot")
),
mainPanel(
div(id = "add_here")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
counter_plots <- 1
observeEvent(input$make_plot, {
current_id <- paste0("plot_", counter_plots)
# call the logic for one plot
one_plot(id = current_id,
x = x,
y = y,
type = input$plotType,
breaks = input$breaks,
break_counts = input$breakCount)
# show the plot
insertUI(selector = "#add_here",
ui = one_plotUI(current_id))
# update the counter
counter_plots <<- counter_plots + 1
})
}
shinyApp(ui, server)

Answer 2

Here is a way to create an arbitrary number of plots.
library(tidyverse)
library(shiny)
library(glue)
ui <- fluidPage(actionButton("add_sepal_length", "Add Sepal.Length Histogram"),
actionButton("add_sepal_width", "Add Sepal.Width Histogram"),
uiOutput("plot_ui"))
server <- function(input, output, session){
number_of_plots <- reactiveVal(0L)
output$plot_ui <- renderUI({
req(number_of_plots()>0)
seq(number_of_plots(),1) %>% map(~plotOutput(glue("plot_{.}")))
})
observeEvent(input$add_sepal_length,{
output[[glue("plot_{number_of_plots() +1}")]] <- renderPlot(hist(iris$Sepal.Length))
number_of_plots(number_of_plots() + 1L)
})
observeEvent(input$add_sepal_width,{
output[[glue("plot_{number_of_plots() +1}")]] <- renderPlot(hist(iris$Sepal.Width))
number_of_plots(number_of_plots() + 1L)
})
}
shinyApp(ui = ui, server = server)
The basic idea is that you can use renderPlot to add to ouput$ by string. The observeEvent creates the plot on demand. Put whatever plotting logic you want in here. This takes care of the server part. The UI is handled by a single renderUI which returns a list of plotOutputs.
My logic here is very simple. I use a map() function which only needs to know the id. You could do something fancy involving a whole lot of parameters. One time I did a project where I had arbitrarily many selectInputs. I stored the parameters in a tibble inside of a reactiveVal and used pmap() inside the renderUI.