I'm completely new to Shiny, so please forgive any mistakes or misunderstandings. I'm creating a Shiny application with Leaflet in R based off of this example. The example works from point data whereas my app works with polygons, which appears to be what is causing me problems.
Here is the shapefile I'm working with and here is my full code:
library(shiny)
library(leaflet)
library(sp)
library(rgeos)
library(rgdal)
library(RColorBrewer)
library(raster)
#pull in full rock country shapefile, set WGS84 CRS
countries <- readOGR("D:/NaturalEarth/HIF", layer = "ctry_hif",
stringsAsFactors = F, encoding = "UTF-8")
countries <- spTransform(countries, CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))
#define color palettes for mapping
darkpal <- brewer.pal(5, "Set3")
#country level
pal <- colorFactor(darkpal, countries@data$colors)
shinyApp(
ui = fluidPage(leafletOutput('myMap', width = "80%", height = 500),
br(),
leafletOutput('myMap2', width = "80%", height = 500),
absolutePanel(width = "20%", top = 10, right = 5,
selectInput(inputId = "location",
label = "Country",
choices = c("", countries@data$sovereignt),
selected = "")
)
),
#country-level Rock map
server <- function(input, output, session) {
output$myMap <- renderLeaflet({
leaflet(countries) %>%
addTiles() %>%
addPolygons(fillColor = ~pal(countries@data$colors),
fillOpacity = 1,
weight = 1,
stroke = T,
color = "#000000",
label = ~as.character(sovereignt),
group = "Countries",
layerId = ~sovereignt)
})
#change polygon style upon click event
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
#subset countries by click point
selected <- countries[countries@data$sovereignt == click$id,]
#define leaflet proxy for dynamic updating of map
proxy <- leafletProxy("myMap")
#change style upon click event
if(click$id == "Selected"){
proxy %>% removeShape(layerId = "Selected")
} else {
proxy %>%
setView(lng = click$lng, lat = click$lat, zoom = input$myMap_zoom) %>%
addPolygons(data = selected,
fillColor = "yellow",
fillOpacity = .95,
color = "orange",
opacity = 1,
weight = 1,
stroke = T,
layerId = "Selected")}
}) #end observe event for highlighting polygons on click event
#update location bar when polygon is clicked
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(!is.null(click$id)){
if(is.null(input$location) || input$location!=click$id) updateSelectInput(session, "location", selected=click$id)
}
}) #end observe event for updating dropdown upon click event
#update the map markers and view on location selectInput changes
observeEvent(input$location, {
#set leaflet proxy for redrawing of map
proxy <- leafletProxy("myMap")
#define click point
click <- input$myMap_shape_click
#subset countries spdf by input location
ctrysub <- subset(countries, sovereignt == input$location)
#define click point as corresponding polygon
selected <- countries[countries@data$sovereignt == click$id,]
if(nrow(ctrysub) == 0){
proxy %>% removeShape(layerId = "Selected")
} else if(length(click$id) && input$location != click$id){
proxy %>% addPolygons(data = selected,
fillColor = "yellow",
fillOpacity = .95,
color = "orange",
opacity = 1,
weight = 1,
stroke = T,
layerId = "Selected")
} else if(!length(click$id)){
proxy %>% addPolygons(data = selected,
fillColor = "yellow",
fillOpacity = .95,
color = "orange",
opacity = 1,
weight = 1,
stroke = T,
layerId = "Selected")}
}) #end observe event for drop down selection
}) #end server
I want my app to react to both shape clicks AND selections from the dropdown menu. With the above code, clicking on polygons changes the polygon style to show that it has been selected. It also updates the dropdown menu with the appropriate country name once it has been clicked. When I try to select a country from the dropdown menu, however, nothing happens on the map. I want for dropdown selections to result in the appropriate country polygon being highlighted in the same style as when the polygon is clicked on.
Admittedly, I don't fully understand the third observeEvent
that is supposed to accomplish this goal. I have attempted to match my polygon data to the linked marker data with no luck. To try to pinpoint my issue, I printed all relevant outputs/objects from the example and did the same for my code. As it is now, they match up perfectly, but my Shiny app still doesn't react the way that the example does. SO, from the linked example:
observeEvent(input$location, { # update the map markers and view on location selectInput changes
p <- input$Map_marker_click
p2 <- subset(locs, loc==input$location)
proxy <- leafletProxy("Map")
if(nrow(p2)==0){
proxy %>% removeMarker(layerId="Selected")
} else if(length(p$id) && input$location!=p$id){
proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat)
} else if(!length(p$id)){
proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat)
}
})
nrow(p2)
: prints 1
upon click event AND dropdown selectionlength(p$id)
: prints 1
upon click event, prints 0
on dropdown selection input$location
: prints location name string upon click event AND
dropdown selectionp$id
: prints location name string upon click event, prints NULL
from dropdown selection!length(p$id)
:prints FALSE
upon click event, prints TRUE
from
dropdown selectionAnd from my code:
observeEvent(input$location, {
#set leaflet proxy for redrawing of map
proxy <- leafletProxy("myMap")
#define click point
click <- input$myMap_shape_click
#subset countries spdf by input location
ctrysub <- subset(countries, sovereignt == input$location)
#define click point as corresponding polygon
selected <- countries[countries@data$sovereignt == click$id,]
if(nrow(ctrysub) == 0){
proxy %>% removeShape(layerId = "Selected")
} else if(length(click$id) && input$location != click$id){
proxy %>% addPolygons(data = selected,
fillColor = "yellow",
fillOpacity = .95,
color = "orange",
opacity = 1,
weight = 1,
stroke = T,
layerId = "Selected")
} else if(!length(click$id)){
proxy %>% addPolygons(data = selected,
fillColor = "yellow",
fillOpacity = .95,
color = "orange",
opacity = 1,
weight = 1,
stroke = T,
layerId = "Selected")}
}) #end observe event for drop down selection
nrow(ctrysub)
: prints 1
upon click event AND dropdown selectionlength(click$id)
: prints 1
upon click event, prints 0
on dropdown selection input$location
: prints country name string upon click event AND
dropdown selectionclick$id
: prints country name string upon click event, prints NULL
from dropdown selection!length(click$id)
:prints FALSE
upon click event, prints TRUE
from
dropdown selectionI suspect that the issue is with the format of a marker versus a polygon, but again, all of the relevant objects have the same output for both sets of code, so I'm not sure where to go from here. So, how can I code this so that my dropdown selection results in the polygon being highlighted in the same way as when it is clicked on?
Figured it out! In my observeEvent
, I defined my selected polygon by the click$id
rather than the input$location
, which is why it didn't react to my drop-down menu selection. So instead of:
#define click point as corresponding polygon
selected <- countries[countries@data$sovereignt == click$id,]
I needed to use:
#define dropdown selection as corresponding polygon
selected <- countries[countries@data$sovereignt == input$location,]