我正在学习闪亮并使用连接到许多 selectizeInputs 的 numericInput 。
如果数字输入等于 1 或 2,我想分别创建 1 和 2 selectizeInputs 并为每个 selectizeInput 选择名为“modalities”的向量的“i”模态编辑:并且选择=仅模式[i](而不是模式)
如果数字输入等于 3 或 4,我想分别创建 3 个和 4 个相互连接的 selectizeInput(选择=模式)。换句话说:如果在其中一个 selectizeinputs 中选择了一个项目,我希望它从其他 selectizeinputs 的选择中消失。
另外(这就是我遇到的麻烦)每次修改 numericInput 时,我想“重置”所有选定的 SelectizeInputs。我尝试使用下面的observeEvent,并尝试使用isolate(input$ui_number),但我没有找到任何解决我的问题的方法,因为我不明白该怎么做......!
感谢您的帮助 !
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui")
)
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
for (i in seq_len(input$ui_number)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = modalities, multiple = TRUE)
}
return(output)
})
# if input$ui_number is modified to 3 or 4 : set selected to NULL ##### NOT WORKING
observeEvent({input$ui_number},
{
n <- input$ui_number
if(n%in%c(3,4)){
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),selected=NULL)
}
}
}
)
observe({
n <- input$ui_number
if(n%in%c(1,2)){ #if n=1 or 2 => Select the "i"th modality for each selectizeInput
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = modalities[i],
selected = modalities[i]
)
}
} else{ # if n=3 or 4 => Remove selected modalities from other select lists
for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
}
})
}
runApp(shinyApp(ui, server))
此问题对应于本问题的以下问题:
lapply 函数在 R Shiny 中的observeEvent周围使用数字输入参数 https://stackoverflow.com/questions/47655487/lapply-function-using-a-numericinput-parameter-around-an-observeevent-in-rshiny/47664752#47664752
编辑2:感谢@Aurèle 的提示,新的尝试。剩下的唯一问题是 lapply 中的 1:100 可能需要一些时间来加载(没有找到在条件面板周围添加反应性内容的解决方案,例如 1:input&ui_number)
library(shiny)
modalities <- LETTERS[1:10]
make_conditional_selectizeInputs <- function() {
do.call(
div,
lapply(1:100, function(i)
conditionalPanel(
condition = sprintf("%d <= input.ui_number", i),
selectizeInput(sprintf("ui_mod_choose%d", i),
label = sprintf("Modality %d", i),
choices = character(0), multiple = TRUE, selected = NULL)
)
)
)
}
ui <- tabPanel(
"Change modalities",
uiOutput("rendernumeric"),
#numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L),
make_conditional_selectizeInputs()
)
server <- function(input, output, session) {
max <- 4
output$rendernumeric <- renderUI({
numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L)
})
n <- reactive({
n <- input$ui_number
if (is.null(n) || is.na(n) || !n >= 0) 0 else n
})
# Reset all
observeEvent(
eventExpr = n(),
handlerExpr = for (i in seq_len(max))
updateSelectizeInput(
session, sprintf("ui_mod_choose%d", i),
choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities,
selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
)
)
all_selected <- reactive({
unlist(lapply(seq_len(max), function(i)
input[[sprintf("ui_mod_choose%d", i)]]))
})
# Update available modalities
observeEvent(
eventExpr = all_selected(),
handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
x <- input[[sprintf("ui_mod_choose%d", i)]]
other_selected <- setdiff(all_selected(), x)
updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
choices = setdiff(modalities, other_selected),
selected = x)
}
)
}
runApp(shinyApp(ui, server))