Shiny R:需要相互更新的两个 selectizeInput 菜单(互斥选择)
Shiny R: two selectizeInput menus that need to update each other (mutually exclusive selections)
这里是 Shiny 的新手,我有一个像下面这样的模块,我只想要 2 个 SelectizeInput
菜单,每个菜单都有相同的选项。
诀窍是它们必须相互排斥,所以我知道我必须使用 updateSelectizeInput
更新一个菜单中的 selected 选项基于 selected另一个选项。
如果我 select 一个菜单中的一个选项,则必须将其从另一个菜单中的 selected 选项中删除,反之亦然。
=13=]
我理解这里的动人部分,但我不确定将它们放在哪里以及如何最终完成它。
这是我目前拥有的:
mod_saving_side_ui <- function(id){
ns <- NS(id)
tagList(
shinyjs::useShinyjs(),
shinyalert::useShinyalert(),
uiOutput(outputId = ns("positive_markers")),
uiOutput(outputId = ns("negative_markers"))
)
}
mod_saving_side_server <- function(id, r){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$positive_markers <- renderUI({
selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
choices = LETTERS
selected = LETTERS[1],
multiple = TRUE)
})
output$negative_markers <- renderUI({
selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
choices = LETTERS,
selected = LETTERS[2],
multiple = TRUE)
})
# add selected markers to the reactive values
observeEvent(input$pos_markers, {
r$pos_markers <- input$pos_markers
#selected_markers <- ALL EXCEPT pos_markers
#updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
})
observeEvent(input$neg_markers , {
r$neg_markers <- input$neg_markers
#selected_markers <- ALL EXCEPT neg_markers
#updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
})
})
}
不确定这是否是一个独立的 MWE...附带的问题是如何使用上述内容制作一个...非常感谢!
这应该可以满足您的要求。
我删除了对 shinyjs
和 shinyalert
的额外调用并添加了对 library(shiny)
的调用以使其成为 MWE。我删除了服务器调用的参数 r
。
我还将输入移到了 UI,删除了 uiOutput
和 renderUI
,因为在这种情况下不需要(我不确定代码的其他部分需要)。然后使用 setdiff
选项为您提供新的设置来更新 selectizeInput
与。
我还在底部添加了代码 运行 并测试了应用程序。
library(shiny)
mod_saving_side_ui <- function(id){
ns <- NS(id)
tagList(
selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
choices = LETTERS,
selected = LETTERS[1],
multiple = TRUE),
selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
choices = LETTERS,
selected = LETTERS[2],
multiple = TRUE)
)
}
mod_saving_side_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
# add selected markers to the reactive values
observeEvent(input$neg_markers, {
selected_pos_markers <- input$pos_markers
selected_markers <- setdiff(selected_pos_markers, input$neg_markers)
updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
})
observeEvent(input$pos_markers , {
selected_neg_markers <- input$neg_markers
selected_markers <- setdiff(selected_neg_markers, input$pos_markers)
updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
})
})
}
demoApp <- function() {
ui <- fluidPage(
mod_saving_side_ui("demo")
)
server <- function(input, output, session) {
mod_saving_side_server("demo")
}
shinyApp(ui, server)
}
demoApp()
这里是 Shiny 的新手,我有一个像下面这样的模块,我只想要 2 个 SelectizeInput
菜单,每个菜单都有相同的选项。
诀窍是它们必须相互排斥,所以我知道我必须使用 updateSelectizeInput
更新一个菜单中的 selected 选项基于 selected另一个选项。
如果我 select 一个菜单中的一个选项,则必须将其从另一个菜单中的 selected 选项中删除,反之亦然。
=13=]
我理解这里的动人部分,但我不确定将它们放在哪里以及如何最终完成它。
这是我目前拥有的:
mod_saving_side_ui <- function(id){
ns <- NS(id)
tagList(
shinyjs::useShinyjs(),
shinyalert::useShinyalert(),
uiOutput(outputId = ns("positive_markers")),
uiOutput(outputId = ns("negative_markers"))
)
}
mod_saving_side_server <- function(id, r){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$positive_markers <- renderUI({
selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
choices = LETTERS
selected = LETTERS[1],
multiple = TRUE)
})
output$negative_markers <- renderUI({
selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
choices = LETTERS,
selected = LETTERS[2],
multiple = TRUE)
})
# add selected markers to the reactive values
observeEvent(input$pos_markers, {
r$pos_markers <- input$pos_markers
#selected_markers <- ALL EXCEPT pos_markers
#updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
})
observeEvent(input$neg_markers , {
r$neg_markers <- input$neg_markers
#selected_markers <- ALL EXCEPT neg_markers
#updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
})
})
}
不确定这是否是一个独立的 MWE...附带的问题是如何使用上述内容制作一个...非常感谢!
这应该可以满足您的要求。
我删除了对 shinyjs
和 shinyalert
的额外调用并添加了对 library(shiny)
的调用以使其成为 MWE。我删除了服务器调用的参数 r
。
我还将输入移到了 UI,删除了 uiOutput
和 renderUI
,因为在这种情况下不需要(我不确定代码的其他部分需要)。然后使用 setdiff
选项为您提供新的设置来更新 selectizeInput
与。
我还在底部添加了代码 运行 并测试了应用程序。
library(shiny)
mod_saving_side_ui <- function(id){
ns <- NS(id)
tagList(
selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
choices = LETTERS,
selected = LETTERS[1],
multiple = TRUE),
selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
choices = LETTERS,
selected = LETTERS[2],
multiple = TRUE)
)
}
mod_saving_side_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
# add selected markers to the reactive values
observeEvent(input$neg_markers, {
selected_pos_markers <- input$pos_markers
selected_markers <- setdiff(selected_pos_markers, input$neg_markers)
updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
})
observeEvent(input$pos_markers , {
selected_neg_markers <- input$neg_markers
selected_markers <- setdiff(selected_neg_markers, input$pos_markers)
updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
})
})
}
demoApp <- function() {
ui <- fluidPage(
mod_saving_side_ui("demo")
)
server <- function(input, output, session) {
mod_saving_side_server("demo")
}
shinyApp(ui, server)
}
demoApp()