r-闪亮的服务器选择输入
Posted
技术标签:
【中文标题】r-闪亮的服务器选择输入【英文标题】：r-shiny server selectInput 【发布时间】：2020-03-19 03:49:05 【问题描述】：地图上显示了一堆点。有两种类型的水源。我希望能够只显示与一个来源或另一个或两者相关的点。
当水资源被选为两者时， 并非所有点都显示出来。这是为什么？它有什么问题？
这就是所有的问题和解释，然而，*** 要求我解释更多，这主要是代码。所以，我只是在这里输入一些东西，这样 *** 就可以让我发布问题了。
# 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", , ),
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", , ),
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")
)
)
)
)
【问题讨论】：
如果您可以在不使用styles.css的情况下提供样式表或修改代码，那就太好了
是的，如果你把它注释掉，它就可以正常工作
@Dhiraj 我在我的网站中使用此代码来处理大量数据（8000 点）。当id = "controls", 在absolutePanel 中时，代码会崩溃。速度几乎为零。但如果我把它改成id = "WHATEVER", 它就可以了，speed-wsie。但是，据我所知， id = "controls" 是唯一的选择。而且，当我做id = "WHATEVER", 时，绝对面板会变得丑陋。文本将离开面板。知道发生了什么吗？
真的不知道为什么通过更改 id 代码会“崩溃”。您将不得不查看您是如何在css 文件中定义controls 的。对我来说似乎没问题。你确定是因为absolutePanel？
嗯，这是我唯一改变并影响速度的东西。我无意中意识到了这一点。我不知道controls 是我必须在absolutePanel id 中使用的唯一选项。我使用了一个有意义的名称，absolutePanel 的文本在外面，然后我注意到 controls 到处都在使用，然后我意识到这是唯一的选择......再次，我使用代码和 CSS 就像你看到的一样更多。附言如果controls 是“唯一”选项，我首先不明白它为什么存在！
【参考方案1】：
location 不是空间数据表的一列，addCircleMarkers 中的 layerId = ~ location 搞砸了！！！！
【讨论】：
以上是关于r-闪亮的服务器选择输入的主要内容，如果未能解决你的问题，请参考以下文章