The googleway package allows shiny creators to use Google Maps layers and tools. Most users are familiar with the way Google Maps looks and works. To use, creators must sign up for an API key.
When creating any of these applications you will need both the shiny
package and the googleway
package libraries.
library(shiny)
library(googleway)
First create a simple application that shows a map.
ui <- fluidPage(
google_mapOutput(outputId = "map")
)
server <- function(input, output){
map_key <- "google_maps_api_key"
output$map <- renderGoogle_map({
google_map(key = map_key)
})
}
shinyApp(ui, server)
There are many options when setting up the base map.
location
zoom
zoom_control
search_box
?google_map
Update the maps with options.
ui <- fluidPage(
google_mapOutput(outputId = "map")
)
server <- function(input, output){
map_key <- "google_maps_api_key"
output$map <- renderGoogle_map({
google_map(key = map_key,
location = c(38.533867, -121.771598), # center the map in Davis, CA
zoom = 8, # set the zoom level
zoom_control = TRUE, # give the user zoom control
search_box = FALSE, # remove the search box
street_view_control = FALSE, # remove street view
width = '100%',
height = '100%')
})
}
shinyApp(ui, server)
First add a polygon data to the map and set the coloring of the polygon. This polygon has two type of region
. There is a region ag
where agricultural production has been recorded as having taken place in California and the area outside of that region that has NA
values for its region
.
library(dplyr)
shapefile <- sf::st_read("data/ca_ag_regions.shp")
shapefile <- sf::st_as_sf(shapefile) %>%
mutate(fill_color = if_else(!is.na(region), "#1C00ff00", "#A9A9A9"))
ui <- fluidPage(
google_mapOutput(outputId = "map")
)
server <- function(input, output){
map_key <- "google_maps_api_key"
output$map <- renderGoogle_map({
google_map(key = map_key,
location = c(38.533867, -121.771598), # center the map in Davis, CA
zoom = 8, # set the zoom level
zoom_control = TRUE, # give the user zoom control
search_box = FALSE, # remove the search box
street_view_control = FALSE, # remove street view
width = '100%',
height = '100%') %>%
add_polygons(data = shapefile,
fill_colour = "fill_color",
stroke_colour = "#030303",
update_map_view = FALSE)
})
In addition, add point data onto the map.
library(dplyr)
shapefile <- sf::st_read("data/ca_ag_regions.shp")
shapefile <- sf::st_as_sf(shapefile) %>%
mutate(fill_color = if_else(!is.na(region), "#1C00ff00", "#A9A9A9"))
ui <- fluidPage(
google_mapOutput(outputId = "map")
)
server <- function(input, output){
map_key <- "google_maps_api_key"
output$map <- renderGoogle_map({
google_map(key = map_key,
location = c(38.533867, -121.771598), # center the map in Davis, CA
zoom = 8, # set the zoom level
zoom_control = TRUE, # give the user zoom control
search_box = FALSE, # remove the search box
street_view_control = FALSE, # remove street view
width = '100%',
height = '100%') %>%
add_polygons(data = shapefile,
fill_colour = "fill_color",
stroke_colour = "#030303",
update_map_view = FALSE) %>%
add_markers(data = data.frame(lat = 38.533867, lon = -121.771598),
draggable = TRUE, # can the user move the point
update_map_view = FALSE)
})
To make a map fully interactive user inputs should be collected and users given feedback on their inputs.
Interactive map creators should think about a typical user’s behavior and the instructions that might be needed to facilitate user inputs. What actions will the user be allowed to do?
In more complicated applications,
Using the googleway package, observing the inputs of the map (dragging markers, clicking on map) can give the creator a lot of information.
observeEvent(input$map_marker_drag, {
print(input$map_marker_drag)
})
observeEvent(input$map_polygon_click, {
print(input$map_polygon_click$lat)
print(input$map_polygon_click$lon)
})
In order to give feedback to the user, a place in the ui function must be created to place the outputs.
ui <- fluidPage(
google_mapOutput(outputId = "map"),
textOutput("text")
)
What piece of information is going to output is defined in the server function.
output$text <- renderText({input$map_polygon_click$lat})
An interactive application and/or map should be as intuitive as possible.
With an interactive map, a few things should be added:
To allow several inputs to change the same outputs and to be used in more complex processes to access information outside of the map (such as soil and weather data from a database) values should be assigned to a reactive value.
current_markers <- reactiveValues(
lat=38.533867, lon=-121.771598)
The same observeEvent
functions can be used to update a reactive value.
observeEvent(input$map_marker_drag, {
current_markers$lat <- input$map_marker_drag$lat
current_markers$lon <- input$map_marker_drag$lon
})
observeEvent(input$map_polygon_click, {
google_map_update(map_id = "map") %>%
clear_markers() %>%
add_markers(data = data.frame(lat = input$map_polygon_click$lat, lon = input$map_polygon_click$lon),
draggable = TRUE,
update_map_view = FALSE)
current_markers$lat <- input$map_polygon_click$lat
current_markers$lon <- input$map_polygon_click$lon
})
Limit the user to dragging the marker to locations in California.
For this, it is easiest to define a function since we will want to use it multiple times throughout the application.
region_data <- function(shapefile, markers) {
removeNotification(id = "region_error", session = getDefaultReactiveDomain())
dat <- data.frame(Longitude = markers$lon,
Latitude = markers$lat,
names = c("Point"))
dat <- sf::st_as_sf(dat,
coords = c("Longitude",
"Latitude"))
sf::st_crs(dat) <- sf::st_crs(shapefile)
return(as.data.frame(shapefile)[which(sapply(sf::st_intersects(shapefile,dat), function(z) if (length(z)==0) NA_integer_ else z[1]) == 1), ])
}
The function returns the information from the shape data. It can be used to determine if the marker is within the defined area. Then an error can be shown and the map updated accordingly using google_map_update
.
observeEvent(input$map_marker_drag, {
rd <- region_data(shapefile = shapefile,
markers = data.frame(lat = input$map_marker_drag$lat, lon = input$map_marker_drag$lon))
if(nrow(rd) == 0){
showNotification("Error: no data for this location - moving point to previous location!", id = "region_error")
} else {
current_markers$lat <- input$map_marker_drag$lat
current_markers$lon <- input$map_marker_drag$lon
}
# update map after check that the mark is within the defined area
google_map_update(map_id = "map") %>%
clear_markers() %>%
add_markers(data = data.frame(lat = current_markers$lat, lon = current_markers$lon),
draggable = TRUE,
update_map_view = FALSE)
})
To update the marker location on user click as well as drag, use google_map_update
when observing a map_polygon_click.
observeEvent(input$map_polygon_click, {
google_map_update(map_id = "map") %>%
clear_markers() %>%
add_markers(data = data.frame(lat = input$map_polygon_click$lat, lon = input$map_polygon_click$lon),
draggable = TRUE,
update_map_view = FALSE)
})
Note that a destination in the ui function will have to be made as well (see below).
output$text <- renderText({
paste0("Current marker latitide: ", current_markers$lat, " <br> ",
"Current marker longitude: ", current_markers$lon, " <br> ",
if_else(!is.na(region_data(shapefile = shapefile, markers = current_markers)$region), "The marker is in an agricultural region of California.", "The marker is NOT in an agricultural region of California."))
})
Using a something like shinydashboard
can help with layout.
Add an explanation/instructions for the user, a title to show up in the browser tab, and a place for the outputs in the ui function.
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(
box(width = 6,
p("Click or drag the marker wihtin the state of California to see the marker coordinates (lat/long) and if it is in an agricultural region."),
google_mapOutput(outputId = "map")
),
box(width = 6,
htmlOutput("text")
)
),
title = "Interactive Maps"
)
https://cran.r-project.org/web/packages/googleway/vignettes/googleway-vignette.html
Now you are ready to move on to Create interactive shiny maps with leaflet