无法对下载按钮进行条件检查

Question

我想在下载按钮btnDownload上放置一个有条件的检查。如果某个特定的dataframe recData$dfData()没有数据，那么在单击download按钮时，它必须显示一个警告：“由于没有数据，无法下载报告”。

observeEvent(input$btnDownload, {

  if (nrow(recData$dfData()) != 0) {
    output$btnDownload <- downloadHandler(
      "rpa foundary.docx",
      content = function(file) {
        trycatch(
          expr = {

            if (file.exists("rpa foundary.docx")) {
              file.remove("rpa foundary.docx")
            }

            mydoc <- CreateReportDoc(recData$dfData(), recData$dfProjectWeeklyDtls())

            print(mydoc, file)
            print(mydoc, file, target = "rpa foundary.docx")
            shinyalert(
              type = "success",
              title = "download complete!", 
              text = paste0("report downloaded successfully")
            )
          }, error = function(e) {
            logerror(e, fxname = "btnDownload", app = "server.r")
          }, warning = function(w){
            logwarning(w, fxname = "btnDownload", app = "server.r")
          }
        )}## downloader   
      )} else {
        shinyalert(
          type = "error", title = "report cannot be downloaded!",
          text = paste0("no data available to display")
        )
      }
    })

我认为只有当recData$dfData()没有数据时才会发出警报。但我正在下载![c:Libraries\Pictures\dwnld.png] html文档。

Answer 1

正如@DSGym所建议的，当数据不可用时，我宁愿禁用该按钮。我们还可以添加一个工具提示来为用户提供信息。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  br(),br(),
  div(id="dwnbutton", 
    downloadButton("downloadData", "Download", disabled = "disabled")
  ),
  br(), br(),
  actionButton("go", "Go")
)

server <- function(input, output) {
  # Our dataset - empty at initialisation
  data <- reactiveVal(data.frame())

  observeEvent(input[["go"]], {
    data(mtcars)
  })

  observeEvent(data(), {
    if(nrow(data()) > 0){
      enable("downloadData")
      runjs("$('#dwnbutton').removeAttr('title');")
    }else{
      disable("downloadData")
      runjs("$('#dwnbutton').attr('title', 'Data not available');")
    }
  })

  output$downloadData <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(data(), file)
    }
  )
}

shinyApp(ui, server)

​

​

如果你真的想要一个提醒，这里有一个方法。

library(shiny)
library(shinyjs)
library(shinyWidgets)

ui <- fluidPage(
  useShinyjs(),
  br(),br(),
  div(id="dwnbutton", 
      downloadButton("downloadData", "Download", 
                     onclick = "Shiny.setInputValue('dwnClicked', true, {priority:'event'});")
  ),
  br(), br(),
  actionButton("go", "Go")
)

server <- function(input, output, session) {
  # Our dataset - empty at initialisation
  data <- reactiveVal(data.frame())

  observeEvent(input[["go"]], {
    data(mtcars)
  })

  observeEvent(data(), {
    if(nrow(data()) > 0){
      runjs("$('#dwnbutton').off('click.x');")
    }else{
      runjs("$('#dwnbutton').on('click.x', function(e){e.preventDefault();});")
    }
  })

  observeEvent(input[["dwnClicked"]], {
    if(nrow(data()) == 0){
      sendSweetAlert(
        session = session,
        title = "No data !",
        text = "No data available",
        type = "error"
      )
    }
  })

  output$downloadData <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(data(), file)
    }
  )
}

shinyApp(ui, server)

​

​

但至少我会给按钮添加一个样式，以显示数据不可用：

  observeEvent(data(), {
    if(nrow(data()) > 0){
      runjs("$('#dwnbutton').off('click.x');")
      runjs("$('#downloadData').removeClass('btn-danger');")
    }else{
      runjs("$('#dwnbutton').on('click.x', function(e){e.preventDefault();});")
      runjs("$('#downloadData').addClass('btn-danger');")
    }
  })

​

​