In Shiny Dashboard in a Tab I am plotting graphs one below the another, based on the selection of checkbox inputs. When the check boxes are selected accordingly the graphs will get displayed one below the another. Kindly find the code below which i used.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
radioButtons(
"Choose",
"Choose One",
c("Year" = "p", "Numbers" = "l")
),
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"),
uiOutput("graph_1"))
)
)
))
server <- function(input, output, session) {
z_1 <- reactiveValues(years = NULL)
z_2 <- reactiveValues(numbers = NULL)
observeEvent(input$X, {
z_1$years <- input$X
})
observeEvent(input$X_1, {
z_2$numbers <- input$X_1
})
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("X",
"year",
choices = (unique(d$year)),selected = z_1$years)
} else{
checkboxGroupInput("X_1",
"Numbers",
choices = c("1","2","3","4"), ,selected = z_2$numbers)
}
})
output$graph <- renderUI({
ntabs = length(input$X)
if(input$Choose == "p"){
myTabs = lapply(seq_len(ntabs), function(i) {
fluidRow(plotOutput(paste0("plot", i)))
})
}else return(NULL)
})
output$graph_1 <- renderUI({
ntabs = length(input$X_1)
if(input$Choose == "l"){
myTabs = lapply(seq_len(ntabs), function(i) {
fluidRow(plotOutput(paste0("plot_1", i)))
})
}else return(NULL)
})
observe (lapply(length(input$X), function(i) {
output[[paste0("plot", i)]] <- renderPlot({
if (length(input$X) > 0) {
d %>%
ggplot(aes(Product_Name, Cost)) +
geom_col(aes(fill = Product_desc),
position = position_dodge(preserve = "single")) +
facet_wrap( ~ input$X[i],
scales = "free_x",
strip.position = "bottom") +
theme(strip.placement = "outside") +
theme_bw()
}
})
}))
observe (lapply(length(input$X_1), function(i) {
output[[paste0("plot_1", i)]] <- renderPlot({
if (length(input$X_1) > 0) {
d %>%
ggplot(aes(Product_Name, Cost)) +
theme(strip.placement = "outside") +
theme_bw()
}
})
}))
}
shinyApp(ui, server)
What I am trying to do now is I "Wanted to download these plots" which are getting dynamically generated based on the user check box input. If the user had generated 1 graph I wanted to download it. If the user had generated 3 graphs then i want to download all the generated graphs in one single jpeg file.
I tried using downloadHandler, but unfortunately i was very very unsuccessful in it.
The issue which I am facing in this case is as the graphs are dynamic in Nature I am not able to store or write a code in the downloadHandler. The dynamic Nature of the Graph is making it difficult.
Can someone please suggest me how to overcome this.
Shiny Modules [*] would be a neat possibility here.
Note. I did not fully understand what you tried with your dynamic checkboxGroup, so I replaced it by a static one. Also I was not quite clear what you want to plot in particular. This is however anyways not crucial to the problem at hand, which can be described as follows
Download a dynamic amount of figures in one file.
So here we go, explanation below.
Setup
library(shiny)
library(dplyr)
library(gridExtra)
d <- data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c("Table", "Chair", "Bed", "Table", "Chair", "Bed", "Table",
"Chair", "Bed"),
Product_desc = rep(LETTERS[24:26], each = 3),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
Shiny Modules
plot_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("graph"))
}
plot_server <- function(input, output, session, my_data, graph_type) {
get_graph <- reactive({
base_plot <- ggplot(my_data,
aes(Product_Name, Cost)) +
theme(strip.placement = "outside") +
theme_bw()
if (graph_type() == "b") {
res <- base_plot +
geom_col(aes(fill = Product_desc),
position = position_dodge(preserve = "single")) +
facet_wrap(~year)
} else if (graph_type() == "p") {
res <- base_plot +
geom_point()
}
res
})
output$graph <- renderPlot({
get_graph()
})
list(graph = get_graph)
}
Main App
ui <- fluidPage(
titlePanel("Modules to the Rescue!"),
sidebarLayout(
sidebarPanel(
radioButtons(
"type",
"Graph Type",
c(Bars = "b", Points = "p")
),
checkboxGroupInput("selector",
"Year",
choices = unique(d$year)),
downloadButton("download", "Download Graphs")
),
mainPanel(div(id = "container", div("test content")))
)
)
server <- function(input, output, session) {
## store active plot handlers
all_plots <- reactiveVal()
## counter to ensure unique ids for the module uis
cnt <- reactiveVal(0)
## when we change selector draw plots anew
observe({
## remove all existing plots
removeUI("#container *", immediate = TRUE, multiple = TRUE)
## for each selection create a new plot
## SIDE EFFECT: create the UI
handlers <- lapply(input$selector, function(x) {
cnt(isolate(cnt()) + 1)
my_dat <- d %>%
dplyr::filter(year == x)
new_id <- paste("plot", isolate(cnt()))
insertUI("#container", ui = plot_ui(new_id))
callModule(plot_server, new_id,
my_data = my_dat,
graph_type = reactive(input$type))
})
all_plots(handlers)
})
output$download <- downloadHandler(
filename = function() {
paste0("plots-", Sys.Date(), ".png")
}, content = function(file) {
my_plots <- all_plots()
ggsave(file,
plot = marrangeGrob(lapply(my_plots, function(handle) handle$graph()),
ncol = 1, nrow = length(my_plots)))
}
)
}
shinyApp(ui, server)
Explanation
(The linked document describes in depth what modules are doing so I focus on I used them, rather on how they work in general.)
renderPlot function to render the plot, and once as a return parameter of the module.all_plots), through which we can communicate with the model and in particular to retrieve the plot.checkboxGroup and whenever there is a change we dynamically remove all plots, and add them afresh and update all_plots through which we can in the last step retrieve the plots for the downloadHandler.downloadHandler we loop through all plots and use gridExtra::marrange to put all of the ggplots into one file via ggsave.[*] Note that I still use the old callModule syntax as I have noi yet upgraded shiny.