我有一个模块化的闪亮应用程序,它允许用户过滤一些数据,然后绘制结果。我正在尝试创建一个模块,该模块允许用户随后下载图,但始终出现错误。我认为该错误与情节反应有关,但无法弄清楚该如何解决。
玩具应用程序:
library(shiny)
library(tidyverse)
# generate some data
randData <- data.frame(col1 = sample(letters,100,replace = T), col2 = runif(100))
# shiny modules
col1Filter <-function(input, output, session, data){
output$chooser <- renderUI({
ns <- session$ns
selectInput(inputId = ns("chosen"),
label = 'Col 1',
choices = sort(unique(data$col1)),
multiple = TRUE)
})
return(reactive(input$chosen))
}
col1FilterUI <- function(id){
ns <- NS(id)
uiOutput(ns('chooser'))
}
filterTable <- function(input, output, session, data, col1Fetcher){
return(reactive(data %>% filter(col1 %in% col1Fetcher())))
}
displayTable <- function(input, output, session, data){
output$displayer <- DT::renderDataTable(data())
}
displayTableUI <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('displayer'))
}
displayPlot <- function(input, output, session, data){
output$plot <- renderPlot({
ggplot(data(), aes(col1,col2))+
geom_boxplot()+
theme_light()
})
}
displayPlotUI <- function(id){
ns <- NS(id)
tagList(
plotOutput(ns("plot")))
}
plotDownload <- function(input, output, session, plot) {
output$downloadPlot <- downloadHandler(
filename = function() {
paste('plot_', Sys.Date(), '.png', sep='')
},
content = function(file) {
png(file)
plot()
dev.off()
}
)
}
plotDownloadUI <- function(id) {
ns <- NS(id)
downloadButton(ns("downloadPlot"), label = 'Download plot')
}
# app
server <- function(input,output,session){
chosenCol1 <- callModule(col1Filter,
id = 'col1Filter',
data = randData)
filterTable <- callModule(filterTable,
id = 'filterTable',
data = randData,
col1Fetcher = chosenCol1)
callModule(displayTable,
id = 'displayTable',
data = filterTable)
plot <- callModule(displayPlot,
id = 'dispPlot',
data = filterTable)
plotDownload <- callModule(plotDownload,
id = 'downPlot',
plot = plot)
}
ui <- fluidPage(
sidebarPanel(col1FilterUI('col1Filter')),
mainPanel(
tabsetPanel(
tabPanel('data', value = 1,
displayTableUI('displayTable')),
tabPanel('plot', value = 1,
displayPlotUI('dispPlot'),
plotDownloadUI('downPlot')))
)
)
shinyApp(ui = ui, server = server)