A bunch of points are being shown on a map. There are two types of water sources. I want to be able to just show the points associated with one source, or the other or both.
When water resource is chosen to be both, not all points are shown. Why is that? what is wrong with it?
That is all the question and explanation, however, stackoverflow is asking me to explain more and this is mostly code. So, I am just typing stuff in here so that stackoverflow lets me to post the question.
# 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;
//}
Another version of the code without observe/reactive :
# 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 is not a column of spatial data table, and layerId = ~ location in addCircleMarkers was messing it up!!!!