r - r-闪亮的服务器选择输入
问题描述
一堆点显示在地图上。有两种类型的水源。我希望能够只显示与一个来源或另一个或两者相关的点。
当水资源被选择为两者时，不会显示所有点。这是为什么？它有什么问题？
这就是所有的问题和解释，然而，stackoverflow 要求我解释更多，这主要是代码。所以，我只是在这里输入内容，以便 stackoverflow 让我发布问题。
# global.R:
library(scales)
library(lattice)
library(jsonlite)
library(raster)
library(data.table)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(maps)
library(rgdal) # for readOGR and others
library(sp) # for spatial objects
library(leaflet) # for interactive maps (NOT leafletR here)
library(dplyr) # for working with data frames
library(ggplot2) # for plotting
library(reshape2)
library(RColorBrewer)
RD <- c("1916-06-30", "1884-10-30",
"1905-05-10", "1905-05-10",
"1905-05-10", "1974-08-02",
"1933-08-25", "1902-06-30",
"2009-07-30", "2009-07-30")
lat <- c(47.10483, 47.10483, 47.10483,
47.10483, 47.10483, 47.10483,
47.33486, 47.33486, 47.33486, 47.33486)
long <- c(-121.1577, -121.2309, -121.0622,
-121.3069, -121.2470, -121.2208,
-121.2534, -121.0608, -121.2736,
-120.9735)
WRS <- c("surfaceWater", "surfaceWater", "surfaceWater",
"surfaceWater", "surfaceWater", "surfaceWater",
"groundwater", "groundwater", "groundwater",
"groundwater")
spatial_wtr_right = data.table(right_date = RD,
lat = lat,
long = long,
WaRecRCWCl = WRS
)
spatial_wtr_right$popup <- 1
spatial_wtr_right$color <- "#ffff00"
######## Server.R
shinyServer(function(input, output, session) {
observe({
water_resource <- input$WaRecRCWCl
if (water_resource == "surfaceWater") {
curr_spatial <- spatial_wtr_right %>%
filter(WaRecRCWCl == "surfaceWater")
curr_spatial <- data.table(curr_spatial)
} else if (water_resource == "groundwater"){
curr_spatial <- spatial_wtr_right %>%
filter(WaRecRCWCl == "groundwater")
curr_spatial <- data.table(curr_spatial)
} else if (water_resource == "both_water_resource") {
curr_spatial <- spatial_wtr_right %>%
filter(WaRecRCWCl %in% c("surfaceWater",
"groundwater")
)
curr_spatial <- data.table(curr_spatial)
}
target_date <- as.Date(input$cut_date)
curr_spatial[, color := ifelse(right_date < target_date,
"#FF3333", "#0080FF")]
# curr_spatial[right_date < target_date, color := "#FF3333"]
# curr_spatial[right_date >= target_date, color := "#0080FF"]
leafletProxy("a_map", data = curr_spatial) %>%
clearShapes() %>%
addCircleMarkers(data = curr_spatial,
lng = ~long, lat = ~lat,
label = ~ popup,
layerId = ~ location,
radius = 3,
color = ~ color,
stroke = FALSE,
fillOpacity = .95
)
})
output$a_map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}",
attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>',
layerId = "Satellite",
options= providerTileOptions(opacity = 0.9)) %>%
setView(lat = 47, lng = -120, zoom = 7)
})
})
########## ui.R
navbarPage(title = div(""),
id="nav",
windowTitle = "Q",
#
tabPanel(tags$b("Q"),
div(class="outer",
tags$head(includeCSS("styles.css")),
leafletOutput("a_map", width="100%", height="100%"),
absolutePanel(id = "controls",
class = "panel panel-default",
fixed = TRUE,
draggable = TRUE,
top = 60, right = 20,
left = "auto", bottom = "auto",
width = 330, height = "auto",
h4("Earlier in red, later in blue"),
sliderInput(inputId = "cut_date",
label = "Dates:",
min = as.Date("1800-01-01","%Y-%m-%d"),
max = as.Date("2015-12-30","%Y-%m-%d"),
value=as.Date("1800-01-01"),
timeFormat="%Y-%m-%d"),
selectInput(inputId = "WaRecRCWCl",
label = "Water Resource",
choices = c("Surface Water" = "surfaceWater",
"Ground Water" = "groundwater",
"Both" = "both_water_resource"),
selected = "both_water_resource")
)
)
)
)
input[type="number"] {
max-width: 80%;
}
div.outer {
//margin-top: 60px;
margin-top: 10px;
position: fixed;
top: 41px;
left: 0;
right: 0;
bottom: 0;
overflow: hidden;
padding: 0;
}
/* Customize fonts */
body, label, input, button, select {
font-family: Helvetica; //'Helvetica Neue', Helvetica;
font-weight: 200;
font-size: 15px;
}
h1, h2, h3, h4 { font-weight: 400; }
#controls {
/* Appearance */
background-color: white;
padding: 0 20px 20px 20px;
cursor: move;
/* Fade out while not hovering */
opacity: 0.75;
zoom: 0.9;
transition: opacity 500ms 1s;
}
#controls:hover {
/* Fade in while hovering */
opacity: 0.95;
transition-delay: 0;
}
/* Position and style citation */
#cite {
position: absolute;
bottom: 10px;
left: 10px;
font-size: 12px;
}
/* If not using map tiles, show a white background */
.leaflet-container {
background-color: white !important;
}
.leaflet-control-layers-expanded .leaflet-control-layers-list {
font-size: 20px;
padding: 12px 20px 12px 12px;
}
#map-css {
margin-top: 60px; // adding this new css attribute to the updated map view
}
//.leaflet-control-layers .leaflet-control-layers-expanded .leaflet-control {
//.leaflet-top .leaflet-control {
// top: 20px;
// margin-top: 20px;
//}
另一个没有观察/反应的代码版本：
# Water Rights
library(scales)
library(lattice)
library(jsonlite)
library(raster)
library(data.table)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(maps)
library(rgdal) # for readOGR and others
library(sp) # for spatial objects
library(leaflet) # for interactive maps (NOT leafletR here)
library(dplyr) # for working with data frames
library(ggplot2) # for plotting
library(reshape2)
library(RColorBrewer)
######################################################
RD <- c("1916-06-30", "1884-10-30",
"1905-05-10", "1903-05-10",
"1902-05-10", "1974-08-02",
"1933-08-25", "1901-06-30",
"2010-07-30", "2009-07-30")
lat <- c(47.10483, 47.10483, 47.10483,
47.10483, 47.10483, 47.10483,
47.33486, 47.33486, 47.33486,
47.33486)
long <- c(-120.8522, -121.0577,
-121.1509,-121.2570, -121.3508,
-121.4569,
-120.8522, -121.0577,
-121.1509,-121.2570)
WRS <- c("surfaceWater", "surfaceWater", "surfaceWater",
"surfaceWater", "surfaceWater", "surfaceWater",
"groundwater", "groundwater", "groundwater",
"groundwater")
spatial_wtr_right = data.table(right_date = RD,
lat = lat,
long = long,
WaRecRCWCl = WRS
)
spatial_wtr_right$popup <- 1
spatial_wtr_right$colorr <- "#ffff00"
spatial_wtr_right_surface <- spatial_wtr_right %>%
filter(WaRecRCWCl == "surfaceWater") %>%
data.table()
spatial_wtr_right_ground <- spatial_wtr_right %>%
filter(WaRecRCWCl == "groundwater") %>%
data.table()
spatial_wtr_right_both <- spatial_wtr_right %>% data.table()
shinyServer(function(input, output, session) {
output$water_right_map <- renderLeaflet({
target_date <- as.Date(input$cut_date)
water_resource <- input$water_source_type
if (water_resource == "surfaceWater") {
curr_spatial <- spatial_wtr_right_surface
print ("surface")
} else if (water_resource == "groundwater"){
curr_spatial <- spatial_wtr_right_ground
print ("ground")
} else if (water_resource == "both_water_resource") {
curr_spatial <- spatial_wtr_right_both
print ("both")
}
curr_spatial[, colorr := ifelse(right_date < target_date, "#FF3333", "#0080FF")]
print(curr_spatial)
leaflet() %>%
addTiles(urlTemplate = "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}",
attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>',
layerId = "Satellite",
options= providerTileOptions(opacity = 0.9)) %>%
setView(lat = 47, lng = -120, zoom = 7) %>%
addCircleMarkers(data = curr_spatial,
lng = ~long, lat = ~lat,
label = ~ popup,
layerId = ~ location,
radius = 3,
color = ~ colorr,
stroke = FALSE,
fillOpacity = .95
)
})
})
# Water Rights
# library(leaflet)
# library(shinyBS)
# library(shiny)
# library(plotly)
# library(shinydashboard)
navbarPage(title = div(""),
id="nav",
windowTitle = "Q",
#
tabPanel(tags$b("Q"),
div(class="outer",
tags$head(includeCSS("styles.css")),
leafletOutput("water_right_map", width="100%", height="100%"),
absolutePanel(id = "controls",
class = "panel panel-default",
fixed = TRUE,
draggable = TRUE,
top = 60, right = 20,
left = "auto", bottom = "auto",
width = 330, height = "auto",
h4("Earlier in red, later in blue"),
sliderInput(inputId = "cut_date",
label = "Dates:",
min = as.Date("1800-01-01","%Y-%m-%d"),
max = as.Date("2015-12-30","%Y-%m-%d"),
value=as.Date("1800-01-01"),
timeFormat="%Y-%m-%d"),
selectInput(inputId = "water_source_type",
label = "Water Resource",
choices = c("Surface Water" = "surfaceWater",
"Ground Water" = "groundwater",
"Both" = "both_water_resource"),
selected = "both_water_resource")
)
)
)
)
解决方案
location 不是空间数据表的列，addCircleMarkers 中的 layerId = ~ location 搞砸了！！！！
推荐阅读
- android - Nearby Connections 使用应用程序上下文做广告
- java - 合并社区并找到最大的社区
- android - Android fire-base OTP 未验证
- java - ResultSet 实现 - 它是在调用 next() 时获取的，还是结果已经在内存中？
- python - IndexError：在 numpy 矩阵广播期间，索引 10 超出轴 1 的范围，大小为 10
- python - tensorflow-gpu 运行了一段时间有一个关于数组的 MemoryError
- postgresql - PSQL 强制唯一性，但在表的子集内，而不是通过整个事物
- python - 脚本挂在 time.sleep()
- java - 从对象初始化数组会产生 NullPointerException
- javascript - 如何持久化 Cognito 用户会话