Скрыть и очистить selectInput

Question

Мне нужно показать \ скрыть ввод и будет здорово получить NULL или пустую строку, если ввод не существует, вот воспроизводимый пример:

ui <- 
  dashboardPage(
    dashboardHeader(
      title = 'Test'),
    dashboardSidebar(),
    dashboardBody(
      selectInput(
        inputId = 'mainInput',
        label = 'Main input',
        selected = 'Show',
        choices = c('Show', 'Hide')
      ),
      uiOutput(
        outputId = 'secondInputUI'
      ),
      actionButton(
        inputId = 'thirdInput',
        label = 'Check value'
      )
    )
)
server <- function(input, output, session){
  observeEvent(input$mainInput, ignoreNULL = TRUE, {
    if (input$mainInput == 'Show')
      output$secondInputUI <- 
        renderUI(
          selectInput(
            inputId = 'secondInput',
            label = 'Second input',
            selected = 0,
            multiple = FALSE,
            choices = c(1, 0)
          )
        )
    else {
      output$secondInputUI <- 
        renderUI(
          selectInput(
            inputId = 'secondInput',
            label = 'Second input',
            selected = '',
            multiple = TRUE,
            choices = c(1, 0)
          )
        )
      # If uncommit - input value don't update and will return latest available before delete input
      # output$secondInputUI <- 
      #   NULL
    }
  })

  observeEvent(input$thirdInput, {
    showNotification(
      session = session, 
      ui = paste(input$secondInput, collapse = ', '))
  })
}

shinyApp(
  ui = ui,
  server = server)

Вы можете увидеть закомментированную часть с установкой NULL в uioutput, если он активен - блестящий возврат последнего доступного значения до сброса этого пользовательского интерфейса, так как с этим бороться?

Answer 1

Итак, я нашел другое решение, основная идея которого заключается в следующем: обновить значение ввода в обозревателе для первого ввода, скрыть второй ввод от наблюдателя для второго ввода. Будет лучше, если я покажу:

ui <- 
  dashboardPage(
    dashboardHeader(
      title = 'Test'),
    dashboardSidebar(),
    dashboardBody(
      selectInput(
        inputId = 'mainInput',
        label = 'Main input',
        selected = 'Show',
        choices = c('Show', 'Hide')
      ),
      uiOutput(
        outputId = 'secondInputUI'
      ),
      actionButton(
        inputId = 'thirdInput',
        label = 'Check value'
      )
    )
)
server <- function(input, output, session){
  observeEvent(input$mainInput, {
    if (input$mainInput == 'Show')
      output$secondInputUI <- 
        renderUI(
          selectInput(
            inputId = 'secondInput',
            label = 'Second input',
            selected = 0,
            multiple = FALSE,
            choices = c(1, 0)
          )
        )
    else {
      output$secondInputUI <- 
        renderUI(
          selectInput(
            inputId = 'secondInput',
            label = 'Second input',
            selected = '',
            multiple = TRUE,
            choices = c(1, 0)
          )
        )
    }
  })

  # THE TRICK HERE ####
  observeEvent(input$secondInput, ignoreNULL = FALSE, {
    if (input$mainInput != 'Show'){
      output$secondInputUI <-
        renderUI(NULL)
    }
  })

  observeEvent(input$thirdInput, {
    showNotification(
      session = session, 
      ui = paste(input$secondInput, collapse = ', '))
  })
}

shinyApp(
  ui = ui,
  server = server)

Answer 2

Я думаю, что понял. Вы можете создать реактивную переменную, которая не зависит от пользовательского интерфейса, поскольку входные данные не обновляются при удалении элемента пользовательского интерфейса.

library(shiny)
library(shinydashboard)

ui <- 
  dashboardPage(
    dashboardHeader(
      title = 'Test'),
    dashboardSidebar(),
    dashboardBody(
      selectInput(
        inputId = 'mainInput',
        label = 'Main input',
        selected = 'Show',
        choices = c('Show', 'Hide')
      ),
      uiOutput(
        outputId = 'secondInputUI'
      ),
      actionButton(
        inputId = 'thirdInput',
        label = 'Check value'
      )
    )
  )
server <- function(input, output, session){

  secondInputVar <- reactive({
    if(input$mainInput == 'Show'){
      input$secondInput
    } else {

    }
  })

  observeEvent(input$mainInput, ignoreNULL = TRUE, {
    if (input$mainInput == 'Show')
      output$secondInputUI <- 
        renderUI(
          selectInput(
            inputId = 'secondInput',
            label = 'Second input',
            selected = 0,
            multiple = FALSE,
            choices = c(1, 0)
          )
        )
    else {
      output$secondInputUI <- renderUI({
        NULL
      })
    }
  })

  observeEvent(input$thirdInput, {
    showNotification(
      session = session, 
      ui = paste(secondInputVar(), collapse = ', '))
  })
}

shinyApp(
  ui = ui,
  server = server)