r - 在ui中从Shiny服务器到反应性selectInput（选择=）的输出(r - Output from Shiny server to reactive selectInput(choices = ) in ui)

 另请参阅此帖子底部的更新 
 
 我有一个闪亮的应用程序，从API中提取数据并绘制数据。 拉取请求取决于两个用户输入：一个位置（地区代码）和几天前。 该API返回eBird.org最近发现的鸟类 
 
 在输入通过应用程序后，用户可以输入一个物种名称，过滤数据只显示最近的物种。 
 
 目前，通过ui中的textInput()完成该物种输入，并且如果用户的输入不匹配从API提取的数据帧中的物种，则小叶映射默认不显示物种选择。 
 
 相反，我希望ui中的物种输入是一个selectInput() ，其中choices =是服务器中的反应结果，仅显示从用户指定的API请求中提取的物种名称。 这些物种名称可以从{{data}}$comName 
 
 继本网站和其他网站上发布的一些帖子之后，我试着用几种不同的方式做到这一点。 这些在“ 我的代码”中注释掉。 此代码还使用SOURCE SCRIPT来实现功能。 感兴趣的领域由： ### --- ### --- ### --- ###等 
 
 首先，我尝试在服务器上使用类似这样的组合： 
 
output$spChoices <- renderUI({
  tagList(
    sliderInput(selectInput("species_in", "Species", choices = 'tester', 
                            selected = "Test", multiple = F, width  = 170)))
})
 
 这在ui中： 
 
uiOutput("spChoices")
 
 这是我的代码，以防万一在这里查看比在链接更容易： 
 
    ### GLOBAL SPACE ### ---------------------------------------------------------------------
library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(leaflet.extras)
library(jsonlite)

# Opening connection to pull functions from external file
source('./Functions.R')

# Pulling region code choices from external file
choices = as.character(read.csv("./data/choices.csv")$x)

# Fetching custom map tiles and adding citation

# Making my location icon
uloc = makeIcon(iconUrl = "./uloc.png", iconHeight = 25, iconWidth = 25)


### USER INTERFACE ### -------------------------------------------------------------------
ui <- bootstrapPage(

  # TODO: build a smaller title with these:
  # h3('test test test test'),

  # Adding dynamically updating USER LOC
  tags$script(geoloc()),

  # Add Google Analytics data
  tags$head(HTML(gtag())),

  # Setting THEME
  theme = shinytheme("superhero"),

  # Setting map to FULL-SCREEN
  tags$style(type="text/css", "html, body {width:100%;height:100%}"),

  # Initializing LEAFLET output
  leafletOutput("myMap", width="100%", height="100%"),

  # Adding TITLE overlayed on leaflet map
  absolutePanel(top = 1, left = 50, draggable = F, 
                titlePanel("eBird Rarity Viewer")),

  # Adding SLIDER input overlayed on leaflet map
  absolutePanel(bottom = 1, left = 45, draggable = F, 
                sliderInput("slider_in", "Days Back", 
                            min = 1, max = 30, value = 3, round = T)),

  # Adding REGION INPUT overlayed on leaflet map
  absolutePanel(top = 1, right = 45, draggable = F,
                selectInput("region_in", "Region Code", choices = choices, 
                            selected = "US-MA", multiple = F, width  = 130)),

  # Adding SELECT SPECIES INPUT overlayed on leaflet map
  absolutePanel(bottom = 105, left = 45, width = 170, draggable = T,
                selectInput("species_in", "Species", choices = "", 
                            selected = "", multiple = F, width  = 170))

)


### SERVER ### ---------------------------------------------------------------------------
server <- function(input, output, session) {

  ## -------------------------------------------------------------------------------------
  # Rendering data frame from API with slider input 
  APIdata <- reactive({

    # Initial fetch of data from eBird API, with conditionals to reject errant input
    a <- try(api2(regionCode = as.character(input$region_in), 
                  back = as.numeric(input$slider_in)))
    if(class(a) == "try-error" ||length(a) == 0){return(NULL)}
    return(a)
  })

  ## -------------------------------------------------------------------------------------
  # Doing more to the data frame
  APIdata2 <- reactive({

    a <- APIdata()

    # Jittering lat/lon points to fix point overlap
    a$lat = jitter(a$lat, factor = 3) 

    # Changing review status from logical to numeric
    cols <- sapply(a, is.logical)
    a[,cols] <- lapply(a[,cols], as.numeric)

    # Initializing new date column
    a["date"] <- format(strptime(a$obsDt, format = "%Y-%m-%d"), "%b %d")

    # Initializing new color grouping column
    a["group"] <- NA

    # Assigning colors by review status
    idx<-  (a$obsReviewed == 0) # Not reviewed
    a$group[idx] <- "white"
    idx<- (a$obsReviewed == 1) & (a$obsValid == 1) # Reviewed and accepted
    a$group[idx] <- "green"

    # Adding url for list popups
    a["url"] <- NA
    a$url = sapply(a$subId, subIDurl)

    # Species search filtering
    if(input$species_in %in% a$comName){
      #a = subset(a, a$comName == as.character(input$species_in))
      a = a[a$comName == as.character(input$species_in),]
      return(a)
    }else{return(a)}

    return(a)
  })

  ## -------------------------------------------------------------------------------------
  # Updating species input selection


  observeEvent({APIdata()},{
      updateSelectInput(session, "species_in", choices = unique(APIdata()[["comName"]], selected = ""))
    })


  ## -------------------------------------------------------------------------------------
  # Dynamically updating user location
  observe({
    if(!is.null(input$lat)){

      ulat <- input$lat
      ulng <- input$long
      acc <- input$accuracy
      time <- input$time

      proxy <- leafletProxy("myMap")

      proxy  %>% 
        clearGroup(group="pos") %>% 
        addMarkers(icon = uloc,lng=ulng, lat=ulat, label = "My Location", 
                   popup=paste("My location is:","<br>", 
                               ulng,"Longitude","<br>", ulat,"Latitude", 
                               "<br>", "My accuracy is:",  "<br>", acc, "meters"), 
                   group="pos") %>%
        addCircles(lng=ulng, lat=ulat, radius=acc, group="pos") %>%
        addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
                                 onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
    }
  })

  ## -------------------------------------------------------------------------------------
  # Leaflet map
  output$myMap = renderLeaflet({
    if(is.null(APIdata()))
    {
      # Rendering leaflet map
      return(leaflet() %>% addTiles()) %>%
        addSearchOSM(options = searchOSMOptions(zoom = 8)) %>%
        setView(-19.451108, 30.479968, 2)
    }
    else
    {
      # Splitting up by review status in order to show reviewed on top
      notReviewed = APIdata2()[APIdata2()$group == "white",]
      accepted = APIdata2()[APIdata2()$group == "green",]

      # Rendering leaflet map
      leaflet() %>% addTiles() %>%
        addCircleMarkers(group = "Not reviewed", data = notReviewed, 
                         color = "#f5f5dc", opacity = 0.7, popup = notReviewed$url,
                         label = paste(notReviewed$comName,", ",notReviewed$date, ", ",
                                       notReviewed$locName,sep = "")) %>%
        addCircleMarkers(group = "Accepted", data = accepted, 
                         color = "#00FF33", opacity = 0.7, popup = accepted$url, 
                         label = paste(accepted$comName,", ",accepted$date, ", ", 
                                       accepted$locName, sep = "")) %>%
        addLegend(position = "bottomright", 
                  colors = c("#f5f5dc", "#00FF33"), 
                  labels = c("Not reviewed", "Accepted"),
                  title = "Legend: review status", opacity = 1) %>%
        addLayersControl(overlayGroups = c("Not reviewed", "Accepted"), position = "bottomright") %>%
        addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
                                 onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
    }
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
 
 我也愿意对我的代码进行任何修改建议！ 
 
 更新： 
 
 我在第119行添加了这行代码（在渲染APIdata() ），它几乎可以工作，但它只显示列表中的第一个物种。 我试图通过选择一个随机行来玩这个游戏，它似乎把它扔进了一个无限循环。 我关门了吗？ 
 
  observe({
    updateSelectInput(session, "species_in",
                      choices = unique(APIdata()$comName)
    )})
 
 然而，在进一步的思考中，我并不认为这种确切的方法是可行的，因为一旦用户选择了一个输入，就不可能返回到所有的物种。 
 
 更新2： 
 
 我已经将updateSelectInput()调用移动到了代码行82中，这看起来更有希望。 现在的问题是，它会自动选择该列表中的第一个物种，而我希望它默认所有物种（不选）。 我通过在函数中加入selected = ""做了一个初始的解决方法，这个函数起初看起来不错，但是一旦你做出选择，它会在一瞬间工作，然后快速离开它并返回到所有物种（ = "" ） 。 我正在尝试解决if语句，任何想法？ 
 
  observe({
    updateSelectInput(session, "species_in",
                      choices = unique(a$comName), selected = ""
)})
 
 更新3： 
 
 感谢Bertil Baron的建议，这更接近我想要的。 但是，此时，映射会自动跳转到selectInput()中的某个物种。 正如我在评论中提到的那样，它不需要使用selectInput(...selected = ""...) ，因为我玩过它并没有改变任何东西。 我认为这可能与这部分有关： 
 
    # Species search filtering
    if(input$species_in %in% a$comName){
      #a = subset(a, a$comName == as.character(input$species_in))
      a = a[a$comName == as.character(input$species_in),]
      return(a)
    }else{return(a)}
 
 任何想法，我应该把这个为了让应用程序如上所述工作？ 

Also see update at bottom of this post
 
I have a shiny app that pulls data from an API and plots the data. The pull request is dependent on two user inputs: a location (region code) and days back. The API returns recent bird sightings from eBird.org
 
After the inputs are passed through the app, the user can then type in a species name, which filters the data to only show recent sightings of those species.
 
Currently, this species input is done through textInput() in the ui, and the leaflet map defaults to show no species select if the user's input does not match a species in the data frame pulled from the API.
 
I would like, instead, for the species input in the ui to be a selectInput(), where the choices = is a result of a reactive in the server, showing only those species names that are pulled from the user-specified API request. These species names can be created from {{data}}$comName
 
Following along to some threads posted on this site and others, I tried to do this a few different ways. These are commented out in MY CODE. This code also uses a SOURCE SCRIPT for functions. The areas of interest are headed by: ### --- ### --- ### --- ### etc.
 
Primarily, I tried to use a combination of something like this on the server:
 
output$spChoices <- renderUI({
  tagList(
    sliderInput(selectInput("species_in", "Species", choices = 'tester', 
                            selected = "Test", multiple = F, width  = 170)))
})
 
And this in the ui:
 
uiOutput("spChoices")
 
Here is my code, in case it's easier to view here than at the link:
 
    ### GLOBAL SPACE ### ---------------------------------------------------------------------
library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(leaflet.extras)
library(jsonlite)

# Opening connection to pull functions from external file
source('./Functions.R')

# Pulling region code choices from external file
choices = as.character(read.csv("./data/choices.csv")$x)

# Fetching custom map tiles and adding citation

# Making my location icon
uloc = makeIcon(iconUrl = "./uloc.png", iconHeight = 25, iconWidth = 25)


### USER INTERFACE ### -------------------------------------------------------------------
ui <- bootstrapPage(

  # TODO: build a smaller title with these:
  # h3('test test test test'),

  # Adding dynamically updating USER LOC
  tags$script(geoloc()),

  # Add Google Analytics data
  tags$head(HTML(gtag())),

  # Setting THEME
  theme = shinytheme("superhero"),

  # Setting map to FULL-SCREEN
  tags$style(type="text/css", "html, body {width:100%;height:100%}"),

  # Initializing LEAFLET output
  leafletOutput("myMap", width="100%", height="100%"),

  # Adding TITLE overlayed on leaflet map
  absolutePanel(top = 1, left = 50, draggable = F, 
                titlePanel("eBird Rarity Viewer")),

  # Adding SLIDER input overlayed on leaflet map
  absolutePanel(bottom = 1, left = 45, draggable = F, 
                sliderInput("slider_in", "Days Back", 
                            min = 1, max = 30, value = 3, round = T)),

  # Adding REGION INPUT overlayed on leaflet map
  absolutePanel(top = 1, right = 45, draggable = F,
                selectInput("region_in", "Region Code", choices = choices, 
                            selected = "US-MA", multiple = F, width  = 130)),

  # Adding SELECT SPECIES INPUT overlayed on leaflet map
  absolutePanel(bottom = 105, left = 45, width = 170, draggable = T,
                selectInput("species_in", "Species", choices = "", 
                            selected = "", multiple = F, width  = 170))

)


### SERVER ### ---------------------------------------------------------------------------
server <- function(input, output, session) {

  ## -------------------------------------------------------------------------------------
  # Rendering data frame from API with slider input 
  APIdata <- reactive({

    # Initial fetch of data from eBird API, with conditionals to reject errant input
    a <- try(api2(regionCode = as.character(input$region_in), 
                  back = as.numeric(input$slider_in)))
    if(class(a) == "try-error" ||length(a) == 0){return(NULL)}
    return(a)
  })

  ## -------------------------------------------------------------------------------------
  # Doing more to the data frame
  APIdata2 <- reactive({

    a <- APIdata()

    # Jittering lat/lon points to fix point overlap
    a$lat = jitter(a$lat, factor = 3) 

    # Changing review status from logical to numeric
    cols <- sapply(a, is.logical)
    a[,cols] <- lapply(a[,cols], as.numeric)

    # Initializing new date column
    a["date"] <- format(strptime(a$obsDt, format = "%Y-%m-%d"), "%b %d")

    # Initializing new color grouping column
    a["group"] <- NA

    # Assigning colors by review status
    idx<-  (a$obsReviewed == 0) # Not reviewed
    a$group[idx] <- "white"
    idx<- (a$obsReviewed == 1) & (a$obsValid == 1) # Reviewed and accepted
    a$group[idx] <- "green"

    # Adding url for list popups
    a["url"] <- NA
    a$url = sapply(a$subId, subIDurl)

    # Species search filtering
    if(input$species_in %in% a$comName){
      #a = subset(a, a$comName == as.character(input$species_in))
      a = a[a$comName == as.character(input$species_in),]
      return(a)
    }else{return(a)}

    return(a)
  })

  ## -------------------------------------------------------------------------------------
  # Updating species input selection


  observeEvent({APIdata()},{
      updateSelectInput(session, "species_in", choices = unique(APIdata()[["comName"]], selected = ""))
    })


  ## -------------------------------------------------------------------------------------
  # Dynamically updating user location
  observe({
    if(!is.null(input$lat)){

      ulat <- input$lat
      ulng <- input$long
      acc <- input$accuracy
      time <- input$time

      proxy <- leafletProxy("myMap")

      proxy  %>% 
        clearGroup(group="pos") %>% 
        addMarkers(icon = uloc,lng=ulng, lat=ulat, label = "My Location", 
                   popup=paste("My location is:","<br>", 
                               ulng,"Longitude","<br>", ulat,"Latitude", 
                               "<br>", "My accuracy is:",  "<br>", acc, "meters"), 
                   group="pos") %>%
        addCircles(lng=ulng, lat=ulat, radius=acc, group="pos") %>%
        addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
                                 onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
    }
  })

  ## -------------------------------------------------------------------------------------
  # Leaflet map
  output$myMap = renderLeaflet({
    if(is.null(APIdata()))
    {
      # Rendering leaflet map
      return(leaflet() %>% addTiles()) %>%
        addSearchOSM(options = searchOSMOptions(zoom = 8)) %>%
        setView(-19.451108, 30.479968, 2)
    }
    else
    {
      # Splitting up by review status in order to show reviewed on top
      notReviewed = APIdata2()[APIdata2()$group == "white",]
      accepted = APIdata2()[APIdata2()$group == "green",]

      # Rendering leaflet map
      leaflet() %>% addTiles() %>%
        addCircleMarkers(group = "Not reviewed", data = notReviewed, 
                         color = "#f5f5dc", opacity = 0.7, popup = notReviewed$url,
                         label = paste(notReviewed$comName,", ",notReviewed$date, ", ",
                                       notReviewed$locName,sep = "")) %>%
        addCircleMarkers(group = "Accepted", data = accepted, 
                         color = "#00FF33", opacity = 0.7, popup = accepted$url, 
                         label = paste(accepted$comName,", ",accepted$date, ", ", 
                                       accepted$locName, sep = "")) %>%
        addLegend(position = "bottomright", 
                  colors = c("#f5f5dc", "#00FF33"), 
                  labels = c("Not reviewed", "Accepted"),
                  title = "Legend: review status", opacity = 1) %>%
        addLayersControl(overlayGroups = c("Not reviewed", "Accepted"), position = "bottomright") %>%
        addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
                                 onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
    }
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
 
I'm also open to any suggested edits to my code for improvement!
 
UPDATE:
 
I added this line to my code at line 119 (just after rendering APIdata()) and it almost works, but it only shows the first species from the list. I tried to play with this by selecting a random row and it seemed to throw it into an infinite loop. Am I close?
 
  observe({
    updateSelectInput(session, "species_in",
                      choices = unique(APIdata()$comName)
    )})
 
On further thought, though, I don't think this exact method will work, because once a user selects an input it would be impossible to go back to all species.
 
UPDATE 2: 
 
I have moved the updateSelectInput() call to further up in the code, line 82, and that looks more promising. The issue now is that it automatically selects the first species on that list, whereas I want it to default to all species (no selection). I made an initial workaround by adding selected = "" to the function, which looks great at first, but once you make a selection it works for a split second and then snaps away from it and goes back to all species (= ""). I'm trying resolve with if statements, any idea?
 
  observe({
    updateSelectInput(session, "species_in",
                      choices = unique(a$comName), selected = ""
)})
 
UPDATE 3:
 
Thanks to Bertil Baron for his suggestion, it's much closer to what I want. At this point, though, the map automatically jumps to one of the species in the selectInput(). As I mentioned in the comment, it doesn't have to do with selectInput(...selected = ""...), because I played around with that and it didn't change anything. I think it might have to do with this part:
 
    # Species search filtering
    if(input$species_in %in% a$comName){
      #a = subset(a, a$comName == as.character(input$species_in))
      a = a[a$comName == as.character(input$species_in),]
      return(a)
    }else{return(a)}
 
Any idea where I should be putting this in order for the app to work as described above?

原文：https://stackoverflow.com/questions/48068406