简体   繁体   中英

Reactive updating of two related selectizeInput widgets in Shiny

I have a database linking scientific species name (ie Quercus rubra ) and common names (ie northern red oak). In the Shiny app I am trying to create, I want to have two selectizeInput widgets where users can select any number of either scientific or common names populated from my database.

I would like both of these input widgets to be reactive to each other, so if the user selects multiple species from the scientific list, the common name for that species populates the common name input field and vice versa. I've made two attempts at this but in both cases have not gotten the functionality quite right, so I would appreciate advice.

Attempt 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)

This mostly works but as soon as I go to select a second item in either list, it either immediately deletes what I had previously selected or it reverts to the default option (red oak/ Quercus rubra ).

Here was my second attempt:

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)

This second attempt allows me to select more than one name at a time but will delete previous selections once I've selected 2 or 3 names. Additionally, if I am selecting from the scientific list, it doesn't always update the common name list and vice versa.

Changing == to %in% inside your observers solves the problem:

  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])
  })

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM