отключить actionButton, пока новый набор параметров не будет выбран блестяще - PullRequest
Новая
       83

отключить actionButton, пока новый набор параметров не будет выбран блестяще

0 голосов
/ 03 мая 2020

У меня есть блестящее приложение, которое имеет несколько 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)

Спасибо

1 Ответ

0 голосов
/ 04 мая 2020

observeEvent со строкой toggleState никогда не срабатывает, что странно.

Похоже, существует проблема с использованием observeEvent с несколькими входами, которые генерируются renderUI.

Есть обходной путь, попробуйте использовать: 

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

Вот ваш полный код. Я использовал shinyjs, чтобы включить / отключить кнопку. В общем, я бы рекомендовал избегать renderUI, если вы не можете обойтись без него. Вы уже используете updateSelectInput et c, который может обрабатывать большинство вещей. 

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)
...