Shiny：没有数据时如何禁用下载按钮？

Posted 2023-03-24

【中文标题】Shiny：没有数据时如何禁用下载按钮？

【英文标题】：Shiny: How to disable download button when there no data?

【发布时间】：2021-09-12 04:55:24

【问题描述】：

我在一个模块中工作，该模块查询一些数据，然后将其显示在 DT::datatable 上，我添加了一个下载按钮，这样我就可以下载应用了过滤器的数据。 我已经在应用的主 ui 文件中调用了useShinyjs()。

但如果没有数据，我想禁用下载按钮。

我尝试了以下方法。

observeEvent(data(), 
if (!nrow(data()) > 0) 
shinyjs::disable("download")
 else 
shinyjs::enable("download")
)

但是出现下一条错误消息，并且应用程序在我运行后立即崩溃。

Expecting a single string value: [type=character; extent=0]

用户界面代码：

module_ui <- function(id) 
  ns <- NS(id)
  
  tagList(
    fluidRow(
      tabBox(
        title = tagList(
          downloadButton(ns("download"), label = "Download data")
        ),
        width = 12,
        tabPanel(
          title = html("Documentation"),
          div(style = 'overflow-x: scroll;font-size:90%', DTOutput(ns("table")))
        )
      )
    )
  )

服务器代码：

module_server <- function(id, 
                          connection,
                          update_button,
                          update_button_name) 



 moduleServer(
    id = id,
    module = function(input, output, session) 
  
  ns <- session$ns

  # 1 . Data -----
  
  data <- eventReactive(list(update_button()), 
    data <- dbGetQuery(
      connection, 
      glue::glue("SELECT * FROM Process;)
              
      return(data)
      
  , ignoreNULL = FALSE, ignoreInit = FALSE)
  
  # 2 . Table -----
  
  output$table<- renderDT(
    
    shiny::validate(
      shiny::need(!is_null(data()) && nrow(data()) > 0, 'No data...')
    )
    
    datatable(
      data = data(),
      selection = "single",
      style = "bootstrap",
      rownames = FALSE,
      filter = 'top',
      options = list(
        searchHighlight = TRUE,
        dom = 'tipr',
        pageLength = 20,
        columnDefs = list(
          list(visible = F, targets = c(0)),
          list(width = "200px", targets = "_all")
        )
      )
    )
  , server = TRUE)
  
  # 3 . Download -----
  
   observeEvent(data(), 
     if (nrow(data()) > 0) 
       shinyjs::enable("download")
      else 
       shinyjs::disable("download")
     
   )

  output$download <- downloadHandler(
    filename = "Documentation.xlsx",
    content = function(file) 
        
        openxlsx::write.xlsx(
          x = data() %>% slice(input$tabla_rows_all),
          file = file,
          asTable = FALSE,
          row.names = FALSE
        )
        
       
    
  )   

非常感谢任何可以提供帮助的人！

【问题讨论】：

您在上次下载时缺少双引号。这将清除您的错误。

我在写这篇文章时犯了这个错误。我在应用程序中正确输入了它

添加了 ui 和服务器代码，希望能指出问题所在。

现在您在这里缺少报价：glue::glue("SELECT * FROM Process;)。请验证您的可重现示例在语法上实际上是有效的。

还有一些左括号和右括号不匹配。您可以通过从帖子中删除不必要的细节来进一步简化问题。由于我们没有连接到您的数据库，dbGetQuery 命令不起作用。将其更改为 mtcars 或任何其他默认数据集。您还可以删除模块的使用，因为这里不需要。

【参考方案1】：

请改用shinyjs::toggleState()。这是一个可重现的示例：

library(shiny)
library(shinyjs)

ui <- fluidPage(
  shinyjs::useShinyjs(), 
  fileInput(
    inputId = "file1", label = "Choose a file to upload:", accept = ".csv"
  ), 
  
  tableOutput(
    outputId = "table1"
  ), 
  
  downloadButton(
    outputId = "download_data", class = "btn-success"
  )
)

server <- function(input, output, session) 
  the_data <- reactive(
    req(input$file1)
    read.csv(input$file1$datapath)
  )
  
  output$table1 <- renderTable(
    the_data() |> head()
  )
  
  # <-- observe if there's any input file -->
  observe(
    # mandatory condition: there should be an input file
    mand_condition <- \() 
      !is.null(input$file1)
    
    
    shinyjs::toggleState(
      id = "download_data", condition = mand_condition()
    )
  )
  
  output$download_data <- downloadHandler(
    filename = \() 
      input$file1$name
    , 
    content = function(file) 
      write.csv(the_data(), file)
    
  )


shinyApp(ui, server)