I have been trying to do some dynamic Google Map plots from R using the PlotGoogleMaps package. I have no problem in plotting the Spatial Points on google maps using this package.
I want to connect some pairs of the spatial points plotted with lines. I could not find any way to do that in R with the package. It seems that Google Maps has a function for that in the API: google.maps.Polyline.
Could anyone help with how this can be done in R? I referred to links like How to get image iconMarker working for plotGoogleMaps R? to make sure that my basic plot is working fine. How can I join them to show a path?
I ran the code below
library(plotGoogleMaps)
vessels = data.frame(id = c(1:10)
, lat = c(22.0959, 22.5684, 21.9189, 21.8409, 22.4663, 22.7434, 22.1658, 24.5691, 22.4787, 22.3039)
, lon = c(114.021, 114.252, 113.210, 113.128, 113.894, 114.613, 113.803, 119.730, 113.910, 114.147))
group1 = vessels[1:5,]
group2 = vessels[6:10,]
coordinates(group1) = ~ lon + lat
proj4string(group1) = CRS("+proj=longlat +datum=WGS84")
group1 <- SpatialPointsDataFrame( group1 , data = data.frame( ID = row.names( group1 ) ))
coordinates(group2) = ~ lon + lat
proj4string(group2) = CRS("+proj=longlat +datum=WGS84")
group2 <- SpatialPointsDataFrame( group2 , data = data.frame( ID = row.names( group1 ) ))
m <- plotGoogleMaps(group1, legend = FALSE, layerName = "Vessels 1"
, add =T,
iconMarker=rep('http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png',nrow(group1) ),
mapTypeId='ROADMAP', filename = "out.htm")
m <- plotGoogleMaps(group2,legend = FALSE, layerName = "Vessels 2"
, previousMap = m , add = F
, iconMarker = rep('http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png',nrow(group2) )
, filename = "out.htm")
It works fine. But I do not know how to connect the plotted points to make a path between a selected pair of points on the map.
This doesn't directly answer your question, but I'm posting it as a potential alternative.
I've built the googleway package, which includes a Google Maps widget.
To use Google Maps you need a Google Maps API key
library(googleway)
vessels = data.frame(id = c(1:10)
, lat = c(22.0959, 22.5684, 21.9189, 21.8409, 22.4663, 22.7434, 22.1658, 24.5691, 22.4787, 22.3039)
, lon = c(114.021, 114.252, 113.210, 113.128, 113.894, 114.613, 113.803, 119.730, 113.910, 114.147))
vessels$group <- c(rep(1, 5), rep(2, 5))
## a google maps api key
map_key <- "your_api_key"
google_map(key = map_key, data = vessels) %>%
add_circles(radius = 1000) %>%
add_polylines(lat = 'lat', lon = 'lon', id = 'group',
mouse_over_group = 'group')
Related
I am trying to get rid of the spatial geometry that falls outside of the shapefile boundary I read. Is it possible to do this without manual software like Photoshop? Or me manually removing the tracts which span outside of the city's boundries. For example, I took out 14 tracts, this is there result:
I have provided all of the subset of the data and the key to test it yourself. Code script is below, and the dataset is https://github.com/THsTestingGround/SO_geoSpatial_crop_Quest.
I have done st_intersection(gainsville_df$Geomtry$x, gnv_poly$geometry) after I converted Geomtry to the sf, but I don't know what to do next to get rid of those portions.
library(sf)
library(tigris)
library(tidyverse)
library(tidycensus)
library(readr)
library(data.table)
#reading the shapefile
gnv_poly <- sf::st_read("PATH\\GIS_cgbound\\cgbound.shp") %>%
sf::st_transform(crs = 4326) %>%
sf::st_polygonize() %>%
sf::st_union()
#I have taken the "geometry" of latitude and longitude because it was corrupting my csv, but we can rebuild like so
gnv_latlon <- readr::read_csv("new_dataframe_data.csv") %>%
dplyr::select(ID,
Latitude,
Longitude,
Location) %>%
dplyr::mutate(Location = gsub(x= Location, pattern = "POINT \\(|\\)", replacement = "")) %>%
tidyr::separate(col = "Location", into = c("lon", "lat"), sep = " ") %>%
sf::st_as_sf(coords = c(4,5)) %>%
sf::st_set_crs(4326)
#then you can match the ID from gnv_latlon to
gainsville_df <- fread("new_dataframe_data.csv", drop = c("Latitude","Longitude", "Census Code"))
gainsville_df <- merge(gnv_latlon, gainsville_df, by = "ID")
#remove latitude and longitude points that fall outside of the polygon
dplyr::mutate(gainsville_df, check = as.vector(sf::st_intersects(x = gnv_latlon, y = gnv_poly, sparse = FALSE))) -> outliers_before
sf::st_filter(x= outliers_before, y= gnv_poly, predicate= st_intersects) -> gainsville_df
#Took out my census api key because of a feed back from a SO member. Please add a comment
#if you would like my census key.
#I use this function from tidycensus to retrieve the country shapfiles.
alachua <- tidycensus::get_acs(state = "FL", county = "Alachua", geography = "tract", geometry = T, variables = "B01003_001")
gainsville_df$Geomtry <- NULL
gainsville_df$Geomtry <- alachua$geometry[match(as.character(gainsville_df$`Geo ID`), alachua$GEOID)]
#gets us the first graph with bounry
ggplot() +
geom_sf(data = gainsville_df,aes(geometry= Geomtry, fill= Population), alpha= 0.2) +
coord_sf(crs = "+init=epsg:4326")+
geom_sf(data= gnv_poly) #with alpha added, we get the transparent boundary
Now I would like to get the second image without doing any future manual manipulation.
From this.....
to this, possible ?
Found this Compare spatial polygons and keep or delete common boundaries in R but the person here wanted to remove just the boundaries from one shapefile. And i tried to manipulate it to nothing.
EDIT Here is what I've tried after SymbolixAU direction, but my idx variable is number from 1:7
fl <- sf::st_read("PATH\\GIS_cgbound\\cgbound.shp") %>% sf::st_transform(crs = 4326)
gainsville_df$Geomtry <- sf::st_as_sf(gainsville_df$Geomtry) %>% sf::st_transform(crs= 4326)
#normal boundry plot
plot( fl[, "geometry"] )
# And we can make a boundary by selecting some of the goemetries and union-ing them
boundary <- fl[ gnv_poly$geometry %in% gainsville_df$Geomtry, ]
boundary <- sf::st_union( fl ) %>% sf::st_as_sf()
## So now 'boundary' represents the area you want to cut out of your total shapes
## So you can find the intersection by an appropriate method
## st_contains will tell you all the shapes from 'fl' contained within the boundary
idx <- sf::st_contains(x = boundary, y = fl)
#doesn't work, thus no way of knowing the overlaps
#plot( fl[ idx[[1]], "geometry" ] )
#several more plots which i can't make sense of
plot( fl[ st_intersection(gainsville_df$Geomtry, gnv_poly$geometry), ])
plot(gainsville_df$Geomtry) #this just plots tracts
I'm going to use library(mapdeck) to plot everything, mainly because it's a library I've developed so I'm very familiar with it. It uses Mapbox maps, so you'll need a Mapbox Token to use it.
First, get the data
library(sf)
library(data.table)
fl <- sf::st_read("~/Documents/github/SO_geoSpatial_crop_Quest/GIS_cgbound/cgbound.shp") %>% sf::st_transform(crs = 4326)
gainsville_df <- fread("~/Documents/github/SO_geoSpatial_crop_Quest/new_dataframe_data.csv")
sf_gainsville <- sf::st_as_sf(gainsville_df, wkt = "Location")
## no need to transform, because it's already in Lon / Lat (?)
sf::st_crs( sf_gainsville ) <- 4326
#install.packages("tidycensus")
library(tidycensus)
tidycensus::census_api_key("21adc0b3d6e900378af9b7910d04110cdd38cd75", install = T, overwrite = T)
alachua <- tidycensus::get_acs(state = "FL", county = "Alachua", geography = "tract", geometry = T, variables = "B01003_001")
alachua <- sf::st_transform( alachua, crs = 4326 )
This is what we're working with. I'm plotting the polygons and the boundary path
library(mapdeck)
set_token( secret::get_secret("MAPBOX") )
## this is what the polygons and the Alachua boundary looks like
mapdeck() %>%
add_polygon(
data = alachua
, fill_colour = "NAME"
) %>%
add_path(
data = fl
, stroke_width = 50
)
To start with I'm going to make a polygon of the boundary
boundary_poly <- sf::st_cast(fl, "POLYGON")
Then we can get those polygons completely within the boundary
idx <- sf::st_contains(
x = boundary_poly
, y = alachua
)
idx <- unlist( sapply( idx, `[`) )
sf_contain <- alachua[ idx, ]
mapdeck() %>%
add_polygon(
data = sf_contain
, fill_colour = "NAME"
) %>%
add_path(
data = fl
)
And those which 'touch' the boundary
idx <- sf::st_crosses(
x = fl
, y = alachua
)
idx <- unlist( idx )
sf_crosses <- alachua[ idx, ]
mapdeck() %>%
add_polygon(
data = sf_crosses
, fill_colour = "NAME"
) %>%
add_path(
data = fl
)
Those which are completely on the outside are the polygons that neither touch the boundary, nor are inside it
sf_outside <- sf::st_difference(
x = alachua
, y = sf::st_union( sf_crosses )
)
sf_outside <- sf::st_difference(
x = sf_outside
, y= sf::st_union( sf_contain )
)
mapdeck() %>%
add_polygon(
data = sf_outside
, fill_colour = "NAME"
) %>%
add_path(
data = fl
)
what we need is a way to 'cut' those which touch the boundary ( sf_crosses) so we have a 'inside' and an 'outside' section for each polygon
We need to operate on each polygon at a time and 'split' it by the lines which intersect it.
There may be a way to do this with lwgeom::st_split, but I kept getting errors
To help with this I'm using a development version of my sfheaders library
# devtools::install_github("dcooley/sfheaders")
res <- lapply( 1:nrow( sf_crosses ), function(x) {
## get the intersection of the polygon and the boundary
sf_int <- sf::st_intersection(
x = sf_crosses[x, ]
, y = fl
)
## we only need lines, not MULTILINES
sf_lines <- sfheaders::sf_cast(
sf_int, "LINESTRING"
)
## put a small buffer around the lines to make them polygons
sf_polys <- sf::st_buffer( sf_lines, dist = 0.0005 )
## Find the difference of these buffers and the polygon
sf_diff <- sf::st_difference(
sf_crosses[x, ]
, sf::st_union( sf_polys )
)
## this result is a MULTIPOLYGON, which is the original polygon from
## sf_crosses[x, ], split by the lines which cross it
sf_diff
})
## The result of this is all the polygons which touch the boundary path have been split
sf_res <- do.call(rbind, res)
so sf_res should now be all the polygons which 'touch' the path, but split where the path crosses them
mapdeck() %>%
add_polygon(
data = sf_res
, stroke_colour = "#FFFFFF"
, stroke_width = 100
) %>%
add_path(
data = fl
, stroke_colour = "#FF00FF"
)
And we can see this by zooming in
Now we can find which ones are inside and outside the path
sf_in <- sf::st_join(
x = sf_res
, y = boundary_poly
, left = FALSE
)
sf_out <- sf::st_difference(
x = sf_res
, y = sf::st_union( boundary_poly )
)
mapdeck() %>%
add_path(
data = fl
, stroke_width = 50
, stroke_colour = "#000000"
) %>%
add_polygon(
data = sf_in
, fill_colour = "NAME"
, palette = "viridis"
, layer_id = "in"
) %>%
add_polygon(
data = sf_out
, fill_colour = "NAME"
, palette = "plasma"
, layer_id = "out"
)
Now have all the objects we care about
sf_contain - all the polygons completely within the bondary
sf_in - all the polygons touching the boundary on the inside
sf_out - all the polygons touching the boundary on the outside
sf_outside - all the other polygons
mapdeck() %>%
add_path(
data = fl
, stroke_width = 50
, stroke_colour = "#000000"
) %>%
add_polygon(
data = sf_contain
, fill_colour = "NAME"
, palette = "viridis"
, layer_id = "contained_within_boundary"
) %>%
add_polygon(
data = sf_in
, fill_colour = "NAME"
, palette = "cividis"
, layer_id = "touching_boundary_inside"
) %>%
add_polygon(
data = sf_out
, fill_colour = "NAME"
, palette = "plasma"
, layer_id = "touching_boundary_outside"
) %>%
add_polygon(
data = sf_outside
, fill_colour = "NAME"
, palette = "viridis"
, layer_id = "outside_boundary"
)
I am drawing a highcharts map using the highcharter package in R. I added already some points (cities) and want to link them by drawing an additionnal beeline using the world map-coordinates.
I already managed to draw the beelines by first drawing the map, then hovering over the cities which shows me the plot-coordinates, and then redrawing the plot using the aforementioned plot-coordinates. (Watch out: I used the PLOT-coordinates and my goal is to use directly the WORLD MAP-coordinates.)
If you only have 1 or two cities, it's not a big deal. But if you have like 100 cities/points, it's annoying. I guess the answer will be something like here: Is it possible to include maplines in highcharter maps?.
Thank you!
Here my code:
library(highcharter)
library(tidyverse)
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972), # world-map-coordinates
lon = c(-117.161087, -118.243683, -122.431297) # world-map-coordinates
)
# path which I create AFTER the first drawing of the map as I get the
# plot-coordinates when I hover over the cities.
path <- "M669.63,-4963.70,4577.18,-709.5,5664.42,791.88"
# The goal: the path variable above should be defined using the WORLD-
# coordinates in ca_cities and not using the PLOT-coordinates.
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE) %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map
See picture here
After several hours, I found an answer to my problem. There are maybe easier ways, but I'm going to post my version using the rgdal-package.
The idea is to convert first the world map-coordinates to the specific map's coordinate system (ESRI) and then back-transform all adjustments from highcharts:
library(highcharter)
library(tidyverse)
library(rgdal) # you also need rgdal
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972),
lon = c(-117.161087, -118.243683, -122.431297)
)
# pre-construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE)
# extract the transformation-info
trafo <- map$x$hc_opts$series[[1]]$mapData$`hc-transform`$default
# convert to coordinates
ca_cities2 <- ca_cities %>% select("lat", "lon")
coordinates(ca_cities2) <- c("lon", "lat")
# convert world geosystem WGS 84 into transformed crs
proj4string(ca_cities2) <- CRS("+init=epsg:4326") # WGS 84
ca_cities3 <- spTransform(ca_cities2, CRS(trafo$crs)) #
# re-transform coordinates according to the additionnal highcharts-parameters
image_coords_x <- (ca_cities3$lon - trafo$xoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginX
image_coords_y <- -((ca_cities3$lat - trafo$yoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginY)
# construct the path
path <- paste("M",
paste0(paste(image_coords_x, ",", sep = ""),
image_coords_y, collapse = ","),
sep = "")
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# add series
map <- map %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map
This question already has answers here:
Plotting routes that cross the international dateline using leaflet library in R
(3 answers)
Closed 4 years ago.
I'm creating a map of Australian airports and their international destinations using R-Leaflet.
Here is my sample data:
df<-data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
)
I thought it would be cool to use curved flight paths using gcIntermediate, so I created a SpatialLines object:
library(rgeos)
library(geosphere)
p1<-as.matrix(df[,c(3,4)])
p2<-as.matrix(df[,c(5,6)])
df2 <-gcIntermediate(p1, p2, breakAtDateLine=F,
n=100,
addStartEnd=TRUE,
sp=T)
And then I plotted it using leaflet and Shiny:
server <-function(input, output) {
airportmap<- leaflet() %>% addTiles() %>%
addCircleMarkers(df, lng = df$Australian_lon, lat = df$Australian_lat,
radius = 2, label = paste(df$Australian_Airport, "Airport"))%>%
addPolylines(data = df2, weight = 1)
output$mymap <- renderLeaflet({airportmap}) # render the base map
}
ui<- navbarPage("International flight path statistics - top routes",
tabPanel("Interactive map",
leafletOutput('mymap', width="100%", height=900)
)
)
# Run the application
shinyApp(ui = ui, server = server)
It looks like this:
So the paths are incorrect if they cross the date line. Changing breakAtDateLine to FALSE doesn't fix it (the line disappears but the path is still broken). At this stage, I suspect I may need to use a different mapping system or something but I'd be very grateful if anyone has some advice.
Thanks in advance.
Overview
I set the max bounds and minimum zoom level to only display the world map once. It looks okay in the RStudio viewer but fails when I display it in browser. I'm hoping this helps spark other answers.
Code
# load necessary packages
library( leaflet )
library( geosphere )
# create data
df <-
data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
, stringsAsFactors = FALSE
)
# create curved lines
curved.lines <-
gcIntermediate(
p1 = as.matrix( x = df[ , 3:4 ] )
, p2 = as.matrix( x = df[ , 5:6 ] )
, breakAtDateLine = TRUE
, n = 1000
, addStartEnd = TRUE
, sp = TRUE
)
# create leaflet
airport <-
leaflet( options = leafletOptions( minZoom = 1) ) %>%
setMaxBounds( lng1 = -180
, lat1 = -89.98155760646617
, lng2 = 180
, lat2 = 89.99346179538875 ) %>%
addTiles() %>%
addCircleMarkers( data = df
, lng = ~Australian_lon
, lat = ~Australian_lat
, radius = 2
, color = "red"
, label = paste( ~Australian_Airport
, "Airport" )
) %>%
addCircleMarkers( data = df
, lng = ~International_lon
, lat = ~International_lat
, radius = 2
, color = "blue"
, label = paste( ~International
, "Airport" )
) %>%
addPolylines( data = curved.lines
, weight = 1
)
# display map
airport
# end of script #
If you are interested in another mapping library, then googleway uses Google Maps, which in my experience is better at handling lines that cross the date line.
Notes
To use Google Maps you need an API key
Currently only sf objects are supported, not sp
This will also work in shiny; I'm just showing you the basic map here
I authored googleway
library(sf)
library(googleway)
## convert the sp object to sf
sf <- sf::st_as_sf(df2)
set_key("your_api_key")
google_map() %>%
add_polylines(data = sf)
So I have this dataset of bike thefts (link: https://www.opendataphilly.org/dataset/bicycle-thefts/resource/f9809381-76f6-4fca-8279-621e088ddaa0).
I tried this code to plot location variable in R. the code runs, and i am taken to a new window but it is blank. Nothing appears.
What am I doing wrong?
Here's what I tried:
I renamed the dataset as bt
install.packages("ggmap")
library(ggmap)
install.packages("googleVis")
library(googleVis)
bt$LOCATION_B <- as.character(bt$LOCATION_B)
bt$geom <- gsub(",", ":", bt$geom)
placeNames <- as.character(bt$LOCATION_B)
plotData <- data.frame(name = placeNames, latLong = unlist(bt$geom))
sites <- gvisMap(plotData, locationvar = "latLong", tipvar = "name",
options = list(displayMode = "Markers", mapType = "terrain",
colorAxis = "{colors:['red', 'blue']}", height = 600,
useMapTypeControl=TRUE, enableScrollWheel='TRUE'))
plot(sites)
What am I trying to do:
I am trying to plot 2 groups of points (vessels) with different icons on a nice interactive map. (The vessels have longitude and latitude) The interactivity is important!
The code will actually go inside an iframe in a shiny application.
I set up an example vessel data set (two groups of 5), and plot them onto 2 separate layers. I have been doing a bit of research and plotGoogleMaps seemed like a good package to go to.
library(plotGoogleMaps)
vessels = data.frame(id = c(1:10)
, lat = c(22.0959, 22.5684, 21.9189, 21.8409, 22.4663, 22.7434, 22.1658, 24.5691, 22.4787, 22.3039)
, lon = c(114.021, 114.252, 113.210, 113.128, 113.894, 114.613, 113.803, 119.730, 113.910, 114.147))
group1 = vessels[1:5,]
group2 = vessels[6:10,]
coordinates(group1) = ~ lon + lat
proj4string(group1) = CRS("+proj=longlat +datum=WGS84")
group1 <- SpatialPointsDataFrame( group1 , data = data.frame( ID = row.names( group1 ) ))
coordinates(group2) = ~ lon + lat
proj4string(group2) = CRS("+proj=longlat +datum=WGS84")
group2 <- SpatialPointsDataFrame( group2 , data = data.frame( ID = row.names( group1 ) ))
m <- plotGoogleMaps(group1, legend = FALSE, layerName = "Vessels 1"
, add = T, iconMarker='http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png', mapTypeId='ROADMAP')
m <- plotGoogleMaps(group2,legend = FALSE, layerName = "Vessels 2"
, previousMap = m , add = F
, iconMarker = 'http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png'
, filename = "out.htm")
Could anyone please tell me where the code is going wrong? Any constructive ideas are appreciated as well!
Result:
The icon marker has not actually been picked up as you can see it on the result. I would like to use a custom image. Thank you for your help
You need a little modification on the last 2 lines of code, and than you will get what you want.
m <- plotGoogleMaps(group1, legend = FALSE, layerName = "Vessels 1"
, add =T,
iconMarker=rep('http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png',nrow(group1) ),
mapTypeId='ROADMAP', filename = "out.htm")
m <- plotGoogleMaps(group2,legend = FALSE, layerName = "Vessels 2"
, previousMap = m , add = F
, iconMarker = rep('http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png',nrow(group2) )
, filename = "out.htm")