带有相互依赖的小部件的闪亮renderUI

Question

我正在尝试使用renderUI渲染多个小部件。另外，我希望我渲染的某些小部件依赖于我渲染的另一个小部件。

这是我所需功能的一个小示例，可复制。

for i in {1..100}; do
    dialog --timeout 1 --ok-label Abort --msgbox "$[100-i] seconds to time out" 0 0 && break
    poll_event && break
done

运行此命令时，我观察到以下行为。当我尝试在输入library(shiny) library(purrr) ui <- fluidPage( sidebarLayout( sidebarPanel( numericInput( 'num_inputs' , label = 'How many inputs' , value = 1, min = 1, max = 100, step = 1 ) , uiOutput('widgets') ) , mainPanel( h2('Output goes here') ) ) ) server <- function(input, output, session) { output$widgets <- renderUI({ tags <- purrr::map(1:input$num_inputs, function(i) { list( h3(paste('Input', i)) , selectInput( paste0('input_1_', i) , label = paste('Choose an option', i) , choices = list('xxx', 'yyy') ) , if (is.null(input[[paste0('input_1_', i)]]) || input[[paste0('input_1_', i)]] == 'xxx') { selectInput( paste0('input_2_', i) , label = paste('Choose another option', i) , choices = c('aaa', 'bbb') ) } else { selectInput( paste0('input_2_', i) , label = paste('Choose another option', i) , choices = c('ccc', 'ddd') ) } ) }) tagList(unlist(tags, recursive = FALSE)) }) } shinyApp(ui = ui, server = server) 下选择yyy时，应用程序将input_1_1的选项从input_2_1暂时更改为c('aaa', 'bbb')。但是，它可以很快将UI重置为其原始设置。因此，我无法真正选择c('ccc', 'ddd')。

我想这是因为在renderUI中存在循环依赖关系。但是，我无法确定如何修复它们。是否有人建议采用更好的方法来实现此功能？

更新：

我在下面发布了sessionInfo（）

yyy

Answer 1

为此，通常我将observeEvent与updateSelectInput结合使用以更改可用的选择，而不是if ... else ...中的renderUI块。

类似的东西：

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput(
        'num_inputs'
        , label = 'How many inputs'
        , value = 1, min = 1, max = 100, step = 1
      )
      , uiOutput('widgets')
    )
    , mainPanel(
      h2('Output goes here')
    )
  )
)

server <- function(input, output, session) {

  tags <- eventReactive(
    eventExpr = input$num_inputs,
    valueExpr = {
      purrr::map(1:input$num_inputs, function(i) {
        list(
          h3(paste('Input', i))
          , selectInput(
            paste0('input_1_', i)
            , label = paste('Choose an option', i)
            , choices = list('xxx', 'yyy')
          )
          , 
          selectInput(
              paste0('input_2_', i)
              , label = paste('Choose another option', i)
              , choices = c('aaa', 'bbb')
          )
        )
      })
    }
  )

  output$widgets <- renderUI({ tagList(unlist(tags(), recursive = FALSE)) })

  observe({

    for (i in 1:input$num_inputs) {
      observeEvent(
        eventExpr = input[[paste0('input_1_', i)]],
        handlerExpr = {
          if (input[[paste0('input_1_', i)]] == 'xxx') {
            choices <- c('aaa', 'bbb')
          } else {
            choices <- c('ccc', 'ddd')
          }
          updateSelectInput(session, paste0('input_2_', i), choices = choices)
        }
      )
    }
  })

}

shinyApp(ui = ui, server = server)

Answer 2

以下解决方案基于@cwthom提供的解决方案。当我尝试使用它们的解决方案时，我发现有关i变量作用域的某些奇怪行为。 （有关更多信息，请参阅我对他们的回答的评论。）

这是我的解决方法。

library(shiny)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            numericInput(
                'num_inputs'
                , label = 'How many inputs'
                , value = 1, min = 1, max = 100, step = 1
            )
            , uiOutput('widgets')
        )
        , mainPanel(
            h2('Output goes here')
        )
    )
)

server <- function(input, output, session) {

    tags <- eventReactive(
        eventExpr = input$num_inputs,
        valueExpr = {
            purrr::map(1:input$num_inputs, function(i) {
                list(
                    h3(paste('Input', i))
                    , selectInput(
                        paste0('input_1_', i)
                        , label = paste('Choose an option', i)
                        , choices = list('xxx', 'yyy')
                    )
                    , 
                    selectInput(
                        paste0('input_2_', i)
                        , label = paste('Choose another option', i)
                        , choices = c('aaa', 'bbb')
                    )
                )
            })
        }
    )

    output$widgets <- renderUI({ tagList(unlist(tags(), recursive = FALSE)) })

    observe({

        purrr::walk(1:input$num_inputs, function(i) {
            print(i)
            observeEvent(
                eventExpr = input[[paste0('input_1_', i)]],
                handlerExpr = {
                    if (input[[paste0('input_1_', i)]] == 'xxx') {
                        choices <- c('aaa', 'bbb')
                    } else {
                        choices <- c('ccc', 'ddd')
                    }
                    print(paste('updating input', i))
                    updateSelectInput(session, paste0('input_2_', i), choices = choices)
                }
            )
        })
    })
}

shinyApp(ui = ui, server = server)