RShiny中的许多选择性输入相互连接

时间:2017-12-04 13:22:35

标签: r shiny selectize.js

我是R Shiny的初学者,我想创建许多相互连接的多个选择输入。换句话说:如果在其中一个选择输入中选择了一个项目,我希望它从其他选择输入的选项中消失。

以下是我想要的(不起作用)

的示例
 modalities <- LETTERS[1:10]

 library(shiny)

 app <- shinyApp(
   ui = tabPanel("Change modalities",
            selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices=NULL, multiple = TRUE),
            selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
            selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
   ),

 server = function(input, output, session) {
   observe({
updateSelectizeInput(session,"ui_mod_choose1",choices=  modalities)
updateSelectizeInput(session,"ui_mod_choose2",choices=  modalities)
updateSelectizeInput(session,"ui_mod_choose3",choices=  modalities)
   })
 }

      )
 runApp(app)

编辑:这是基于Bertil Nestorius回答的解决方案

 modalities <- LETTERS[1:10]

 library(shiny)

 app <- shinyApp(
   ui = tabPanel("Change modalities",
            numericInput("ui_number", label="Number of modalities",min = 1, max = 4, value=3),
            uiOutput("renderui")
   ),


   server = function(input, output, session) {


     output$renderui <- renderUI({
       output = tagList()
       for(i in 1:input$ui_number){
         output[[i]] = tagList()
         output[[i]][[1]] = selectizeInput(paste0("ui_mod_choose",i), label=paste0("Modality ",i),choices=modalities, multiple = TRUE)
  }
  return(output)
})


 lapply(
  X = 1:100, ####### QUESTION HERE
  FUN = function(j){
    observeEvent({
      input[[paste0("ui_mod_choose",j)]]
    },
    {
      sapply(1:input$ui_number,function(i){
        vecteur <- do.call(c,lapply((1:input$ui_number)[-i],function(i){input[[paste0("ui_mod_choose",i)]]}))
        updateSelectizeInput(session,paste0("ui_mod_choose",i),choices=  modalities[!modalities %in% vecteur],selected = input[[paste0("ui_mod_choose",i)]])
      })
    },
    ignoreNULL = FALSE)

  }
)


observeEvent({
  input$ui_num
},
{
  sapply(1:nput$ui_num,function(i){ 
    updateSelectizeInput(session,paste0("ui_mod_choose",i),choice= modalities,selected=NULL)
       })
     }
     )

   }

 )
 runApp(app)

我留下的唯一问题是在以下一行:

  X = 1:100, ####### QUESTION HERE

有关详细信息,请参阅此问题:lapply function using a numericInput parameter around an observeEvent in RShiny

2 个答案:

答案 0 :(得分:1)

要让它们全部互连,我会做这样的事情

modalities <- LETTERS[1:10]

library(shiny)

app <- shinyApp(
  ui = tabPanel("Change modalities",
                selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices=NULL, multiple = TRUE),
                selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
                selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
  ),

  server = function(input, output, session) {
    observe({
      updateSelectizeInput(session,"ui_mod_choose1",choices=  modalities)
      updateSelectizeInput(session,"ui_mod_choose2",choices=  modalities)
      updateSelectizeInput(session,"ui_mod_choose3",choices=  modalities)
    })
    observeEvent({
      input$ui_mod_choose2
      input$ui_mod_choose3
    },
    {
      updateSelectizeInput(session,"ui_mod_choose1",choices=  modalities[!modalities %in% c(input$ui_mod_choose2,input$ui_mod_choose3)],selected = input$ui_mod_choose1)
    },
    ignoreNULL = FALSE)
    observeEvent({
      input$ui_mod_choose1
      input$ui_mod_choose3
    },
    {
      updateSelectizeInput(session,"ui_mod_choose2",choices=  modalities[!modalities %in% c(input$ui_mod_choose1,input$ui_mod_choose3)],selected = input$ui_mod_choose2)
    },
    ignoreNULL = FALSE)
    observeEvent({
      input$ui_mod_choose2
      input$ui_mod_choose1
    },
    {
      updateSelectizeInput(session,"ui_mod_choose3",choices=  modalities[!modalities %in% c(input$ui_mod_choose2,input$ui_mod_choose1)],selected = input$ui_mod_choose3)
    },
    ignoreNULL = FALSE)
  }

)
runApp(app)

答案 1 :(得分:0)

这样的东西?

rm(list = ls())
library(shiny)
modalities <- LETTERS[1:10]

app <- shinyApp(
  ui = tabPanel("Change modalities",
                selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices= modalities, multiple = TRUE),
                selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
                selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
  ),

  server = function(input, output, session) {

    observe({
      updateSelectizeInput(session,"ui_mod_choose2",choices =  modalities[!modalities%in% input$ui_mod_choose1])
    })
    observe({
      updateSelectizeInput(session,"ui_mod_choose3",choices =  modalities[!modalities %in% c(input$ui_mod_choose1,input$ui_mod_choose2)])
    })
  }
)
runApp(app)