Shiny Map - 仅显示来自 pickerInput 的用户选择的 sliderInput
Shiny Map - sliderInput that only displays user selections from pickerInput
Update2 Ben 提供的答案解决了问题-谢谢!
更新:感谢Ben在下面的建议,解决方案是结合年份和物种的数据过滤。然而这又带来了一个新的问题。现在,当一个物种被 select 编辑,并且年份滑块被放入一个没有该物种记录的范围内时,应用程序会崩溃。
所以现在我正在寻找一个条件语句,允许应用程序继续 运行ning,但在给定年份范围(滑块输入范围)内没有物种记录时不绘制任何点。
更新代码以反映 Ben 的解决方案
library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)
binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria",
"Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
palette = color,
domain = misp$binomial)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range","Year", min(misp$year),max(misp$year),
value = range(misp$year), step=1, sep = ""),
pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
multiple = T, selected = unique(sort(misp$binomial)))
)
)
server <- function(input, output, session){
filteredData <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2] & misp$binomial %in% input$select,]})
filteredDataYr <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range,{
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredDataYr()$binomial)), selected = filteredData()$binomial)
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
})
observe(
if (nrow(filteredData()) == 0) {leafletProxy("map") %>% clearMarkers()}
else
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
)
}
shinyApp(ui, server)
我正在创建一个闪亮的应用程序,它显示 lat/long 点的物种列表。一个 sliderInput 允许用户按年份缩小数据集,一个 pickerInput 允许用户 select 仅某些物种。 pickerInput 默认为 none selected - 如果你 select all 并移动年份滑块,地图将显示 sliderInput 年份范围内的所有物种。
问题: 目前,该应用程序不允许用户仅针对在 pickerInput(物种)中 select 编辑的内容滚动浏览年份。我希望能够从 pickerInput 中 select 多个物种,使用 sliderInput 按年份查看我的 selection 的记录。目前,当在 pickerInput 中创建 selection 并移动 sliderInput 时,点默认返回显示所有记录,而不是仅显示 selected 的内容。
要查看问题,运行 代码并将滑块输入设置为仅显示最早的年份。这将产生一个可用的物种以在选择器输入中选择。 Select 该物种然后移动滑块输入以显示更大的年份范围。 selected.
以外的物种将开始出现积分。
代码,包括虚拟数据集:
library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)
binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria",
"Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
palette = color,
domain = misp$binomial)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range","Year", min(misp$year),max(misp$year),
value = range(misp$year), step=1, sep = ""),
pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
multiple = T, selected = NULL)
)
)
server <- function(input, output, session){
filteredData <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})
filteredData2 <- reactive({
misp[misp$binomial %in% input$select,]})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range,{
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredData()$binomial)), selected =filteredData2()$binomial)
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
})
observe(
if (nrow(filteredData2()) == 0) {leafletProxy("map") %>% clearMarkers()}
else
leafletProxy("map", data = filteredData2()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
)
}
shinyApp(ui, server)
博士。 Sans - 让我知道这是否更接近您的想法。
我认为您希望 filteredData()
函数过滤年份范围并 input$select
提供可在地图中显示的数据子集。
此外,我认为您不需要同时使用 observeEvent
和 observe
来绘制标记。 Just observe
将通过反应式 filteredData()
.
中任一输入的变化来更新标记
server <- function(input, output, session){
filteredData <- reactive({
misp %>%
filter(year >= input$range[1] & year <= input$range[2]) %>%
filter(binomial %in% input$select)
})
filteredChoices <- reactive({
misp %>%
filter(year >= input$range[1] & year <= input$range[2])
})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range, {
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredChoices()$binomial)), selected = filteredData()$binomial)
})
observe(
if (nrow(filteredData()) == 0) {
leafletProxy("map") %>%
clearMarkers()
}
else {
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
}
)
}
Update2 Ben 提供的答案解决了问题-谢谢!
更新:感谢Ben在下面的建议,解决方案是结合年份和物种的数据过滤。然而这又带来了一个新的问题。现在,当一个物种被 select 编辑,并且年份滑块被放入一个没有该物种记录的范围内时,应用程序会崩溃。
所以现在我正在寻找一个条件语句,允许应用程序继续 运行ning,但在给定年份范围(滑块输入范围)内没有物种记录时不绘制任何点。
更新代码以反映 Ben 的解决方案
library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)
binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria",
"Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
palette = color,
domain = misp$binomial)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range","Year", min(misp$year),max(misp$year),
value = range(misp$year), step=1, sep = ""),
pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
multiple = T, selected = unique(sort(misp$binomial)))
)
)
server <- function(input, output, session){
filteredData <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2] & misp$binomial %in% input$select,]})
filteredDataYr <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range,{
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredDataYr()$binomial)), selected = filteredData()$binomial)
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
})
observe(
if (nrow(filteredData()) == 0) {leafletProxy("map") %>% clearMarkers()}
else
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
)
}
shinyApp(ui, server)
我正在创建一个闪亮的应用程序,它显示 lat/long 点的物种列表。一个 sliderInput 允许用户按年份缩小数据集,一个 pickerInput 允许用户 select 仅某些物种。 pickerInput 默认为 none selected - 如果你 select all 并移动年份滑块,地图将显示 sliderInput 年份范围内的所有物种。
问题: 目前,该应用程序不允许用户仅针对在 pickerInput(物种)中 select 编辑的内容滚动浏览年份。我希望能够从 pickerInput 中 select 多个物种,使用 sliderInput 按年份查看我的 selection 的记录。目前,当在 pickerInput 中创建 selection 并移动 sliderInput 时,点默认返回显示所有记录,而不是仅显示 selected 的内容。
要查看问题,运行 代码并将滑块输入设置为仅显示最早的年份。这将产生一个可用的物种以在选择器输入中选择。 Select 该物种然后移动滑块输入以显示更大的年份范围。 selected.
以外的物种将开始出现积分。代码,包括虚拟数据集:
library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)
binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria",
"Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
palette = color,
domain = misp$binomial)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range","Year", min(misp$year),max(misp$year),
value = range(misp$year), step=1, sep = ""),
pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
multiple = T, selected = NULL)
)
)
server <- function(input, output, session){
filteredData <- reactive({
misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})
filteredData2 <- reactive({
misp[misp$binomial %in% input$select,]})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range,{
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredData()$binomial)), selected =filteredData2()$binomial)
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
})
observe(
if (nrow(filteredData2()) == 0) {leafletProxy("map") %>% clearMarkers()}
else
leafletProxy("map", data = filteredData2()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
)
}
shinyApp(ui, server)
博士。 Sans - 让我知道这是否更接近您的想法。
我认为您希望 filteredData()
函数过滤年份范围并 input$select
提供可在地图中显示的数据子集。
此外,我认为您不需要同时使用 observeEvent
和 observe
来绘制标记。 Just observe
将通过反应式 filteredData()
.
server <- function(input, output, session){
filteredData <- reactive({
misp %>%
filter(year >= input$range[1] & year <= input$range[2]) %>%
filter(binomial %in% input$select)
})
filteredChoices <- reactive({
misp %>%
filter(year >= input$range[1] & year <= input$range[2])
})
output$map <- renderLeaflet({
leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})
observeEvent(input$range, {
updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredChoices()$binomial)), selected = filteredData()$binomial)
})
observe(
if (nrow(filteredData()) == 0) {
leafletProxy("map") %>%
clearMarkers()
}
else {
leafletProxy("map", data = filteredData()) %>%
clearMarkers() %>%
addCircleMarkers(popup = ~as.character(binomial),
label = ~as.character(binomial), radius = 5,
stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
}
)
}