r - 禁用 actionButton 直到选择了一组新的选项

Question

我有一个闪亮的应用程序，有几个selectInput和几个numericInput. 上传文件后，用户可以填写一些输入，并在单击actionButton(ID=filtrar) 后，根据用户选择的不同过滤器过滤表（上传的文件）。

但是，我想禁用actionButton（过滤器按钮），直到一些输入发生变化。

一个工作示例应该是这样的：

1. 用户上传文件
2. actionButton已启用
3. 用户选择一些过滤器并按actionButton。然后，表格被过滤
4. actionButton在某些输入发生更改之前被禁用（注意：selectedInput有多个选项，因此“启用”按钮仅应在所选值与以前的值不同时发生）

我已经尝试过observeEvent，toggleState但它在我的应用程序中的虚拟数据（下面发布）中都不起作用

这是我与iris数据一起使用的代码（我的真实应用程序有更多输入）

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                          "Filtros",
                                          tabName = "filtros",
                                          icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                         column(12,
                                                DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                         )
                                       ))))

ui <-
  dashboardPagePlus(
    enable_preloader = FALSE,
    sidebar_fullCollapse = TRUE,
    header,
    sidebar,
    body
  )

server = function(input, output, session) {

  # Create the choices for sample input
  vals <- reactiveValues(data = iris, filtered_data = iris)

  output$filtros <- renderUI({
    datos <- isolate(vals$data)
    conditionalPanel(
      "input.tabs == 'filtros'",
      tagList(
        div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalLength",
            label = "Sepal.Length",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
    div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalWidth",
            label = "Sepal.Width",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
        div(
          div(
            style = "display: inline-block;vertical-align:top; width: 224px;",
            selectInput(
              inputId = "Species",
              label = "Species",
              width = "220",
              choices = unique(isolate(datos$Species)),
              selected = NULL,
              multiple = TRUE,
              selectize = TRUE,
              size = NULL
            )
          )
        )
      ),
      actionButton("filtrar", "Filter", style = "width: 100px;"),
      actionButton("reset", "Reset", style = "width: 100px;")
    )
  })


  # Filter data
  observeEvent(input$filtrar, {
    tib <- vals$data

    if (!is.na(input$SepalLength)) {
      tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
      print(head(tib))
    } else {
      tib
    }
    if (!is.na(input$SepalWidth)) {
      tib <- tib %>% dplyr::filter(Sepal.Width > input$SepalWidth)
      print(head(tib))
    } else {
      tib
    }
    # Filter
    if (!is.null(input$Species)) {
      tib <- tib %>% dplyr::filter(Species %in% input$Species)
    } else {
      tib
    }

    print(head(tib, n = 15))

    vals$filtered_data <- tib

    updateSelectInput(session, inputId = "Species", selected = input$Species, choices = unique(vals$filtered_data$Species))

  })

  observeEvent(input$reset, {
    updateNumericInput(session, inputId = "SepalLength", value = NA)
    updateNumericInput(session, inputId = "SepalWidth", value = NA)
    updateSelectInput(session, inputId = "Species", selected = "")
  })



  observeEvent({
    input$SepalLength
    input$SepalWidth
    input$Species
  },{
  toggleState("filtrar")
  })

  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({
    DT::datatable(vals$filtered_data)
  }, server = FALSE)

}

shinyApp(ui, server)

谢谢

标签： rshinyshinyjs

Answer 1

与observeEvent线toggleState永远不会触发，这很奇怪。

使用observeEvent由renderUI.

有一个解决方法，尝试使用：

observeEvent({
        input$SepalLength != NULL |
        input$SepalWidth != NULL |
        input$Species != NULL
    },{
       showNotification("triggered")
})

这是您的完整代码。我曾经shinyjs启用/禁用按钮。一般来说，我建议避免renderUI，除非你不能没有它。您已经在使用updateSelectInputetc 可以处理大多数事情。

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)
library(shinyjs)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                            "Filtros",
                                            tabName = "filtros",
                                            icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                           column(12,
                                                  DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                           )
                                       ))))

ui <-
    dashboardPagePlus(
        enable_preloader = FALSE,
        sidebar_fullCollapse = TRUE,
        header,
        sidebar,
        body,
        useShinyjs()
    )

server = function(input, output, session) {

    # Create the choices for sample input
    vals <- reactiveValues(data = iris, filtered_data = iris)

    output$filtros <- renderUI({
        datos <- isolate(vals$data)
        conditionalPanel(
            "input.tabs == 'filtros'",
            tagList(
                div(
                    style = "display: inline-block;vertical-align:top; width: 221px;",
                    numericInput(
                        inputId = "SepalLength",
                        label = "Sepal.Length",
                        value = NA,
                        min = NA,
                        max = NA,
                        step = NA
                    )
                ),
                div(
                    style = "display: inline-block;vertical-align:top; width: 221px;",
                    numericInput(
                        inputId = "SepalWidth",
                        label = "Sepal.Width",
                        value = NA,
                        min = NA,
                        max = NA,
                        step = NA
                    )
                ),
                div(
                    div(
                        style = "display: inline-block;vertical-align:top; width: 224px;",
                        selectInput(
                            inputId = "Species",
                            label = "Species",
                            width = "220",
                            choices = unique(isolate(datos$Species)),
                            selected = NULL,
                            multiple = TRUE,
                            selectize = TRUE,
                            size = NULL
                        )
                    )
                )
            ),
            actionButton("filtrar", "Filter", style = "width: 100px;"),
            actionButton("reset", "Reset", style = "width: 100px;")
        )
    })


    # Filter data
    observeEvent(input$filtrar, {
        tib <- vals$data

        if (!is.na(input$SepalLength)) {
            tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
            print(head(tib))
        } else {
            tib
        }
        if (!is.na(input$SepalWidth)) {
            tib <- tib %>% dplyr::filter(Sepal.Width > input$SepalWidth)
            print(head(tib))
        } else {
            tib
        }
        # Filter
        if (!is.null(input$Species)) {
            tib <- tib %>% dplyr::filter(Species %in% input$Species)
        } else {
            tib
        }

        print(head(tib, n = 15))

        vals$filtered_data <- tib

        updateSelectInput(session, inputId = "Species", selected = input$Species, choices = unique(vals$filtered_data$Species))

        #Disable filter button
        shinyjs::disable("filtrar")


    })

    observeEvent(input$reset, {
        updateNumericInput(session, inputId = "SepalLength", value = NA)
        updateNumericInput(session, inputId = "SepalWidth", value = NA)
        updateSelectInput(session,  inputId = "Species", selected = "")
    })

    observeEvent({
        input$SepalLength != NULL |
        input$SepalWidth != NULL |
        input$Species!= NULL
    },{
        shinyjs::enable("filtrar")
    })

    # Reactive function creating the DT output object
    output$tabla_julio <- DT::renderDataTable({
        DT::datatable(vals$filtered_data)
    }, server = FALSE)

}

shinyApp(ui, server)