另见本帖底部的更新
我有一个闪亮的应用程序，它从API中提取数据并绘制数据。拉取请求取决于两个用户输入：位置（区域代码）和返回日期。 API会从eBird.org
返回最近的鸟类观察结果输入通过应用程序后，用户可以输入物种名称，过滤数据只显示最近发现的物种。
目前，该物种输入是通过ui中的textInput()完成的，如果用户的输入与从API中提取的数据帧中的物种不匹配，则传单地图默认显示没有物种选择。
相反，我希望ui中的物种输入为selectInput()，其中choices =是服务器中反应的结果，仅显示拉出的物种名称来自用户指定的API请求。可以从{{data}}$comName
继本网站和其他网站发布的一些帖子之后，我尝试了几种不同的方式。这些在MY CODE中被注释掉了。此代码还使用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 = ""做了一个初步的解决方法，起初它看起来很棒，但是一旦你做出选择它就会瞬间工作，然后从它中删除然后回到所有物种（{{1 }}）。我正在努力解决if语句，任何想法？
= ""更新3：
感谢Bertil Baron的建议，它更接近我想要的东西。但是，此时，地图会自动跳转到 observe({
updateSelectInput(session, "species_in",
choices = unique(a$comName), selected = ""
)})
中的一个物种。正如我在评论中提到的，它与selectInput()没有关系，因为我玩弄了它并且它没有改变任何东西。我认为这可能与这部分有关：
selectInput(...selected = ""...)我知道应该把它放在哪里，以便应用程序按上述方式工作？
答案 0 :(得分：1)
您好我认为您的第一个解决方案更接近但您应该将OrderItem分成两个函数，至少是这样的
APIData目前，每当某些输入发生变化时，您都会从api收集数据并且这是非常多余的。
之后你可以用这样的东西来设置selectInput
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)}
a
})
filteredData <- reactive({
a <- APIdata()
## resrt of your code here
})
希望这有帮助！