我正在尝试使用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
答案 0 :(得分:0)
为此,通常我将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)
答案 1 :(得分:0)
以下解决方案基于@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)