Hi, I can successfully render two shiny pie plots after creating reactive plot objects, p1() and p2(). I bring these into the download handler function and set up a png file extension in the output. When I open my saved png file, only the plot title is saved and no plot image appears? Why is it that p1() and p2() render but their images aren't saved when I open the png file? I would be very grateful if someone could assist me with that. My reproduceable code is below....
library(shiny)
ui <- shinyUI(navbarPage("Example",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
"Nothing here at the moment"),
mainPanel("Select Dashboard Panel for results.Click on Select/All to make
the plots
render"))
),
tabPanel("Dashboard",
sidebarLayout(
sidebarPanel(
checkboxInput('all', 'Select All/None', value = TRUE),
uiOutput("year_month"),
tags$head(tags$style("#year_month{color:red; font-size:12px; font-style:italic;
overflow-y:scroll; max-height: 100px; background: ghostwhite;}")),
#uiOutput("year")
#tags$head(tags$style("#year{color:red; font-size:12px; font-style:italic;
#overflow-y:scroll; max-height: 100px; background: ghostwhite;}"))
checkboxInput('all1', 'Select All/None', value = TRUE),
uiOutput("year"),
tags$head(tags$style("#year{color:red; font-size:12px; font-style:italic;
overflow-y:scroll; max-height: 100px; background: ghostwhite;}")),
radioButtons("var3", "Select the file type", choices=c("png", "pdf")),
downloadButton("down", "Download the plot")
),
mainPanel(
uiOutput("tb")))
)
))
library(shiny)
library(ggplot2)
library(dplyr)
#use the below if you want to increase the file size being inputed to 9MB
#options(shiny.maxRequestSize = 9.1024^2)
complaint_id <-
c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,
31,32,33)
age_group <- c("Over a year", "06 Months", "01 Months", "Over a year", "06
Months", "09 Months",
"01 Months", "03 Months", "06 Months", "03 Months", "12 Months", "09 Months",
"01 Months", "06 Months", "01 Months", "12 Months", "01 Months", "09 Months",
"06 Months", "09 Months", "Over a year", "Over a year", "01 Months", "12 Months",
"06 Months", "01 Months", "09 Months", "12 Months", "03 Months", "01 Months",
"Over a year", "01 Months", "01 Months")
closed_fy_ending <- c("2019", "2019", "2019", "2019", "2019", "2019", "2019",
"2019", "2019", "2019",
"2019", "2019", "2019", "2019", "2019", "2019", "2019", "2019", "2019", "2019",
"2019", "2019", "2019", "2019", "2019", "2019", "2019", "2019","2019", "2019",
"2019", "2019", "2019")
closed_date_ym <- c("2019-08", "2019-09", "2019-08", "2019-08", "2019-08",
"2019-08", "2019-09",
"2018-08", "2019-08", "2019-09", "2019-09", "2019-09", "2019-08", "2019-08",
"2019-09", "2019-09", "2019-08", "2019-09", "2019-09", "2019-09", "2019-09",
"2019-09", "2019-09", "2019-09", "2019-08", "2019-08", "2019-09", "2019-08",
"2019-08", "2019-08", "2019-08", "2019-09", "2019-09")
officer <- c("E", "D", "B", "A", "A", "D", "C", "C", "C", "D", "C", "B", "C", "D", "A",
"A", "D", "A", "E", "C", "B", "C", "E", "E", "E", "A", "A", "A", "B", "E", "C", "D", "B")
Outcome <- c("Excellent", "Poor", "OK", "Excellent", "Poor", "Good", "Poor", "Good",
"Poor", "Excellent",
"Poor", "Good", "Excellent", "Good", "Poor", "Poor", "Excellent", "Poor", "Poor",
"Good","OK", "OK", "Excellent", "Poor", "Good", "OK", "Good", "OK", "Good",
"Excellent", "Excellent", "Excellent", "Excellent")
sample_data <- data.frame(complaint_id, age_group, closed_fy_ending,
closed_date_ym, officer, Outcome)
server <- shinyServer(function(session, input, output){
#This reactive function takes the inputs from ui.r and use them for read.table()
#file$datapath -> gives the path of the file
data <- reactive({
sample_data
})
# Have to modify the reactive data object to add a column of 1s(Ones) inorder
# that the Pie chart %s are calculated correctly within the segments. We apply
# this modification to a new reactive object, data_mod()
data_mod <- reactive({
if(is.null(data()))return()
req(data())
data_mod <-
data() %>% select(complaint_id, age_group, closed_fy_ending, closed_date_ym, officer,
Outcome)
data_mod$Ones <- rep(1, nrow(data()))
data_mod
})
# creates a selectInput widget with unique YYYY-MM variables ordered from most
# recent to oldest time period
output$year_month <- renderUI({
if(is.null(data()))return()
req(data_mod())
data_ordered <-
order(data_mod()$closed_date_ym, decreasing = TRUE)
data_ordered <- data_mod()[data_ordered,]
checkboxGroupInput("variable_month",
"Select Month",
choices = unique(data_ordered$closed_date_ym))
})
# creates a selectInput widget with unique YYYY variables ordered from most
# recent to oldest time period
output$year <- renderUI({
if(is.null(data()))return()
req(data_mod())
data_ordered <-
order(data_mod()$closed_fy_ending, decreasing = TRUE)
data_ordered <- data_mod()[data_ordered,]
checkboxGroupInput("variable_year",
"Select Year",
choices = unique(data_ordered$closed_fy_ending))
})
#Observe function for the month tick box widget
observe({
if(is.null(data()))return()
req(data_mod())
data_ordered <-
order(data_mod()$closed_date_ym, decreasing = TRUE)
data_ordered <- data_mod()[data_ordered,]
updateCheckboxGroupInput(
session,
"variable_month",
choices = unique(data_ordered$closed_date_ym),
selected = if (input$all)
unique(data_ordered$closed_date_ym)
)
})
#Observe function for the year tick box widget
observe({
if(is.null(data()))return()
req(data_mod())
data_ordered <-
order(data_mod()$closed_fy_ending, decreasing = TRUE)
data_ordered <- data_mod()[data_ordered,]
updateCheckboxGroupInput(
session,
"variable_year",
choices = unique(data_ordered$closed_fy_ending),
selected = if (input$all1)
unique(data_ordered$closed_fy_ending)
)
})
# This subsets the dataset based on what "variable month" or "variable_year" above is selected (if/esle)
# and renders it into a Table
output$table <- renderTable({
if(is.null(input$variable_month)) {
req(data_mod())
dftable <- data_mod()
df_subset <- dftable[, 1:5][dftable$closed_fy_ending %in%
input$variable_year, ]
}
else
{
req(data_mod())
dftable <- data_mod()
df_subset <- dftable[, 1:5][dftable$closed_date_ym %in%
input$variable_month, ]
}
},
options = list(scrollX = TRUE))
# This takes the modified reactive data object data_mod(), assigns it to a
# dataframe df. The dataset in df is subsetted based on the selected variable
# month above and assigned into a new data frame, dfnew. The Pie chart is
# built on the variables within dfnew
plot_func <- function(dfnew, grp_vars, title, scale) {
plotdf <- group_by(dfnew, dfnew[[grp_vars]]) %>%
summarize(volume = sum(Ones)) %>%
mutate(share = volume / sum(volume) * 100.0) %>%
arrange(desc(volume))
plotdf %>%
ggplot(aes("", share, fill = `dfnew[[grp_vars]]`)) +
geom_bar(
width = 1,
size = 1,
color = "white",
stat = "identity"
) +
coord_polar("y") +
geom_text(aes(label = paste0(round(share, digits = 2), "%")),
position = position_stack(vjust = 0.5)) +
labs(
x = NULL,
y = NULL,
fill = NULL,
title = title
) +
guides(fill = guide_legend(reverse = TRUE)) +
scale_fill_manual(values = scale) +
theme_classic() +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5, color = "#666666")
)
}
###1st call to plot function to produce plot1. If/else depends on widget ticked, month or year
p1 <- reactive({
if(is.null(input$variable_month)) {
req(data_mod(), input$variable_year)
df <- data_mod()
plot_func(
dfnew = df[, 1:7][df$closed_fy_ending %in% input$variable_year, ],
grp_vars = "age_group",
title = "Age group segmentation",
scale = c("#ffd700","#bcbcbc","#ffa500","#254290","#f0e68c","#808000")
)
}
else
{
req(data_mod(), input$variable_month)
df <- data_mod()
plot_func(
dfnew = df[, 1:7][df$closed_date_ym %in% input$variable_month, ],
grp_vars = "age_group",
title = "Age group segmentation",
scale = c("#ffd700","#bcbcbc","#ffa500","#254290","#f0e68c","#808000")
)
}
})
###2nd call to plot function to produce plot2. If/else depends on widget ticked, month or year
p2 <- reactive({
if(is.null(input$variable_month)) {
req(data_mod(), input$variable_year)
df <- data_mod()
plot_func(
dfnew = df[, 1:7][df$closed_fy_ending %in% input$variable_year, ],
grp_vars = "Outcome",
title = "Outcome segmentation",
scale = c("#ffd700", "#bcbcbc", "#ffa500", "#254290")
)
}
else
{
req(data_mod(), input$variable_month)
df <- data_mod()
plot_func(
dfnew = df[, 1:7][df$closed_date_ym %in% input$variable_month, ],
grp_vars = "Outcome",
title = "Outcome segmentation",
scale = c("#ffd700", "#bcbcbc", "#ffa500", "#254290")
)
}
})
output$plot1 <- renderPlot({
p1()
})
output$plot2 <- renderPlot({
p2()
})
# the following renderUI is used to dynamically gnerate the tabsets when the file is loaded
output$tb <- renderUI({
req(data())
tabsetPanel(tabPanel("Plot",
plotOutput("plot1"), plotOutput("plot2")),
tabPanel("Data", tableOutput("table")))
})
#####DOWNLOAD
output$down <- downloadHandler(
filename = function(){
paste("Pie Segmentation", input$var3, sep=".")
},
content = function(file){
#open the device
#create the plot
#close the device
#png()
#pdf()
if(input$var3 == "png")
png(file)
else
pdf(file)
p1()
p2()
dev.off()
}
)
})