如何在 R 闪亮中保存/下载条形图?

Question

我想在闪亮中保存/下载我的barplots。我用ggplot做到了，用ggsave做到了，这是可能的，但我怎么能为barplot()做到这一点呢？我在ui.R的代码是：

library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(
title = "", 
status = "danger", 
solidHeader = TRUE,
plotOutput(outputId = "myPlotMdata1")
),
box(
title = "", 
status = "danger", 
solidHeader = TRUE,
plotOutput(outputId = "myPlotMdata2")
),
box(
title = "", 
status = "danger", 
solidHeader = TRUE,
plotOutput(outputId = "myPlotMdata3")
),
box(
title = "", 
status = "danger", 
solidHeader = TRUE,
plotOutput(outputId = "myPlotMdata4")
),
box(
title = "Download", 
status = "success", 
solidHeader = TRUE,
width = 12,
radioButtons("formatTopwords", "Document format", c("PNG"="png", "EPS"="eps", "PDF"="pdf"), inline = TRUE),
downloadButton("downloadReportTopwords")
)
)
) 
server <- function(input, output) {
output$myPlotMdata1 <- renderPlot({
barplot(TopWords$lassoInfPos, las = 2, names.arg = TopWords$informedPos, main = "Informed Investor Top 15 positive words", ylab = "Lasso coefficient")
})
output$myPlotMdata2 <- renderPlot({
barplot(TopWords$lassoNoisePos , las = 2, names.arg = TopWords$noisePos, main = "Noise Investor Top 15 positive words", ylab = "Lasso coefficient")
})
output$myPlotMdata3 <- renderPlot({
barplot(TopWords$lassoInfNeg, las = 2, names.arg = TopWords$informedNeg, main = "Informed Investor Top 15 negative words", ylab = "Lasso coefficient")
})
output$myPlotMdata4 <- renderPlot({
barplot(TopWords$lassoNoiseNeg, las = 2, names.arg = TopWords$noiseNeg, main = "Noise Investor Top 15 negative words", ylab = "Lasso coefficient")
})
fn <- reactive({paste("Plot",input$formatTopwords,sep = ".")})
d <- reactive({input$formatTopwords})
output$downloadReportTopwords <- downloadHandler(
filename = fn,
content = function(file) {
#ggsave I use for another function, how can I save barplots here
ggsave(file, device=d(), dpi = 600, width = 297, height = 210, units = "mm")
}
)
}  
shinyApp(ui, server)

Answer 1

我不确定 EPS，但以下示例适用于 PNG 和 PDF。您可以创建一个绘图函数，然后在renderPlot和downloadHandler中调用该函数。

library(shiny)
library(shinyjs)
library(shinydashboard)
library(ggplot2)
TopWords = data.frame(
lassoInfPos = runif(100,1,100),
lassoNoisePos = runif(100,1,50),
lassoInfNeg = runif(100,1,20),
lassoNoiseNeg = runif(100,1,10)
)
ui <- {dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(width = 6,
plotOutput("myPlotMdata1"),
plotOutput("myPlotMdata2")
),
box(width = 6,
plotOutput("myPlotMdata3"),
plotOutput("myPlotMdata4")
),
box(
title = "Download", 
status = "success", 
solidHeader = TRUE,
width = 12,
radioButtons("formatTopwords", "Document format", c("PNG"="png", "EPS"="eps", "PDF"="pdf"), inline = TRUE),
downloadButton("downloadReportTopwords")
)
)
)}

barplot_func <- function(input, main) {
barplot(input, las = 2, #names.arg = TopWords$informedPos, 
main = main, ylab = "Lasso coefficient")
}
server <- function(input, output) {
output$myPlotMdata1 <- renderPlot({
barplot_func(TopWords$lassoInfPos, "Informed Investor Top 15 positive words")
})
output$myPlotMdata2 <- renderPlot({
barplot_func(TopWords$lassoNoisePos, "Informed Investor Top 15 positive words")
})
output$myPlotMdata3 <- renderPlot({
barplot_func(TopWords$lassoInfNeg, "Informed Investor Top 15 negative  words")
})
output$myPlotMdata4 <- renderPlot({
barplot_func(TopWords$lassoNoiseNeg, "Informed Investor Top 15 negative  words")
})
fn <- reactive({paste("Plot",input$formatTopwords,sep = ".")})
d <- reactive({input$formatTopwords})
output$downloadReportTopwords <- downloadHandler(
filename = fn,
content = function(file) {
if (input$formatTopwords == "png") {
png(file)
} else if(input$formatTopwords == "pdf") {
pdf(file)
}
par(mfrow=c(2,2))
barplot_func(TopWords$lassoInfPos, "Informed Investor Top 15 positive words")
barplot_func(TopWords$lassoNoisePos, "Informed Investor Top 15 positive words")
barplot_func(TopWords$lassoInfNeg, "Informed Investor Top 15 negative  words")
barplot_func(TopWords$lassoNoiseNeg, "Informed Investor Top 15 negative  words")
dev.off() 
}
)
}  
shinyApp(ui, server)