代码之家  ›  专栏  ›  技术社区  ›  Jake

在Shiny中响应式更新两个相关的selectizeInput小部件

  •  0
  • Jake  · 技术社区  · 6 年前

    我有一个链接科学物种名称(即。 红橡树 )和常见名称(即北方红橡树)。在我尝试创建的闪亮应用程序中,我希望有两个selectizeInput小部件,用户可以从我的数据库中选择任意数量的科学名称或常用名称。

    我希望这两个输入窗口小部件能够相互反应,因此如果用户从科学列表中选择多个物种,那么该物种的通用名称将填充通用名称输入字段,反之亦然。我已经为此做了两次尝试,但在这两种情况下都没有完全正确的功能,因此我希望得到建议。

    尝试1:

    comm <- c("northern red oak", "white pine", "balsam fir", "box elder")
    sci <- c("Quercus rubra", "Pinus strobus", "Abies balsamea", "Acer negundo")
    db <- as.data.frame(cbind(comm, sci))
    colnames(db) <- c("common", "scientific_name")
    
    ui <- fluidPage(
    
    # Application title
    titlePanel("Mapping Tree Distributions"),
    
    
    sidebarLayout(
      sidebarPanel(
        uiOutput("scientific"),
    
        uiOutput("common")
      ),
    
      mainPanel()
     )
    )
    
    
    server <- function(input, output, session) {
    
    output$scientific <- renderUI({
         common.value <- input$common.name
         default.scientific <- if (is.null(common.value)) {
           "Quercus rubra"
         } else {
           as.character(db$scientific_name[db$common == common.value])
         }
         selectInput("scientific.name",
                     "Scientific Name of Organism",
                     choices = db$scientific_name,
                     multiple = TRUE,
                     selectize = TRUE,
                     selected = default.scientific)
     })
    
    output$common <- renderUI({
           scientific.value <- input$scientific.name
           default.common <- if (is.null(scientific.value)) {
                "northern red oak"
                } else {
                 as.character(db$common[db$scientific_name == scientific.value])
                  }
          selectInput("common.name",
                     "Common Name of Organism",
                     choices = db$common,
                     multiple = TRUE,
                     selectize = TRUE,
                     selected = default.common)
    
        })
        }
    
    # Run the application
    shinyApp(ui = ui, server = server)
    

    这基本上是可行的,但当我在任一列表中选择第二项时,它要么立即删除我之前选择的内容,要么恢复为默认选项(红色橡树/ 红橡树 )。

    这是我的第二次尝试:

    comm <- c("northern red oak", "white pine", "balsam fir", "box elder")
    sci <- c("Quercus rubra", "Pinus strobus", "Abies balsamea", "Acer negundo")
    db <- as.data.frame(cbind(comm, sci))
    colnames(db) <- c("common", "scientific_name")
    
    ui <- fluidPage(
    
      # Application title
      titlePanel("Mapping Tree Distributions"),
    
      sidebarLayout(
        sidebarPanel(
          selectizeInput("scientific.name",
                      "Scientific Name of Organism",
                      choices = db$scientific_name,
                      multiple = TRUE,
                      selected = NULL),
    
    
          selectizeInput("common.name",
                      "Common Name of Organism",
                      choices = db$common,
                      multiple = TRUE,
                      selected = NULL)
        ),
    
        mainPanel()
    
    
      )
    )
    
    
    server <- function(input, output, session) {
    
      observeEvent(input$scientific.name, {
        updateSelectizeInput(session,
                             "common.name",
                             selected = db$common[db$scientific_name == 
                                        input$scientific.name])
      })
    
      observeEvent(input$common.name, {
        updateSelectizeInput(session,
                             "scientific.name",
                             selected = db$scientific_name[db$common == 
                                         input$common.name])
      })
    }
    
    # Run the application 
    shinyApp(ui = ui, server = server)
    

    第二次尝试允许我一次选择多个名称,但一旦选择了2个或3个名称,就会删除以前的选择。此外,如果我从科学列表中选择,它并不总是更新通用名称列表,反之亦然。

    1 回复  |  直到 6 年前
        1
  •  1
  •   Ricardo Fernandes Campos    6 年前

    正在更改 == %in% 在您的观察者内部解决问题:

      observeEvent(input$scientific.name, {
        updateSelectizeInput(session,
                                 "common.name",
                                 selected = db$common[db$scientific_name %in% 
    
    
    input$scientific.name])
      })
    
      observeEvent(input$common.name, {
        updateSelectizeInput(session,
                             "scientific.name",
                             selected = db$scientific_name[db$common %in% 
                                                             input$common.name])
      })