禁用actionButton，直到选择了一组新的选项为止

问题描述 投票：0回答：1

我有一个闪亮的应用程序，它具有多个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)

谢谢

r shiny shinyjs
1个回答
0
投票

observeEvent行的toggleState从未触发，这很奇怪。

observeEvent与由renderUI生成的多个输入一起使用似乎有问题。

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

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

这是您的完整代码。我使用shinyjs启用/禁用按钮。通常，我建议避免使用renderUI，除非您不能没有它。您已经在使用updateSelectInput等，可以处理大多数事情。

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)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.