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")
)
)
)
)
styles.css- Dhirajid = "controls",is in theabsolutePanel, the code collapses. speed is almost zero. but if I change it toid = "WHATEVER",it works, speed-wsie. However, id = "controls" is the only option as far as I know. AND, when I doid = "WHATEVER",then the absolute panel kind of becomes ugly. the text will get out of the panel. Any idea what is going on? - OverFlow Policeid. You will have to look at how you have definedcontrolsin thecssfile. Seems ok to me. Are you sure it is because of theabsolutePanel? - Dhirajcontrolsis the only option I have to use inabsolutePanel id. I had used a meaningful name, the text ofabsolutePanelwas outside, then I noticedcontrolsis used everywhere, then I realized that is the only option ... Again, I use the code and CSS exactly as you see it above. P.S. Ifcontrolsis the "only" option, I do not understand why it is there, in the first place! - OverFlow Police