I started working with a shapefile in R. In this shapefile, each "boundary" is uniquely defined by a value in "col1" (e.g. ABC111, ABC112 , ABC113, etc.):
library(sf)
library(igraph)
sf <- sf::st_read("C:/Users/me/OneDrive/Documents/shape5/myshp.shp", options = "ENCODING=WINDOWS-1252")
head(sf)
Simple feature collection with 6 features and 3 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 7201955 ymin: 927899.4 xmax: 7484015 ymax: 1191414
Projected CRS: PCS_Lambert_Conformal_Conic
col1 col2 col3 geometry
620 ABC111 99 Region1 MULTIPOLYGON (((7473971 119...
621 ABC112 99 Region1 MULTIPOLYGON (((7480277 118...
622 ABC113 99 Region1 MULTIPOLYGON (((7477124 118...
627 ABC114 99 Region1 MULTIPOLYGON (((7471697 118...
638 ABC115 99 Region1 MULTIPOLYGON (((7209908 928...
639 ABC116 99 Region1 MULTIPOLYGON (((7206683 937...
> dim(sf)
[1] 500 4
sf_trans = st_transform(sf, 4326)
I then plotted this data using the leaflet library:
library(leaflet)
map = leaflet(sf_trans) %>% addPolygons( stroke = FALSE) %>% addTiles(group = "OSM") %>% addProviderTiles("CartoDB.DarkMatter", group = "Carto") %>% addPolygons(data = st_trans, weight=5, col = 'blue')
What I want to do is to try and make a "searchable" map. For example, imagine that "ABC111" is like an American ZIP Code. I want to make a map in which you can search for "ABC111" and the geographical outline of "ABC111" will be highlighted.
As an example, the ZIP Code of the Space Needle Tower in Seattle, Washington (USA) is "98109". If I search for this ZIP Code on Google Maps, the outline of this ZIP code is highlighted in red:
I was able to find a question on stackoverflow that explains how to add a search bar on a leaflet map for individual points (R leaflet search marker NOT work):
libary(dplyr)
library(leaflet)
library(leaflet.extras)
# using the same reproducible data from the question/example
cities <- read.csv(
textConnection("City,Lat,Long,Pop
Boston,42.3601,-71.0589,645966
Hartford,41.7627,-72.6743,125017
New York City,40.7127,-74.0059,8406000
Philadelphia,39.9500,-75.1667,1553000
Pittsburgh,40.4397,-79.9764,305841
Providence,41.8236,-71.4222,177994
"))
leaflet(cities) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addResetMapButton() %>%
# these markers will be "invisible" on the map:
addMarkers(
data = cities, lng = ~Long, lat = ~Lat, label = cities$City,
group = 'cities', # this is the group to use in addSearchFeatures()
# make custom icon that is so small you can't see it:
icon = makeIcon(
iconUrl = "http://leafletjs.com/examples/custom-icons/leaf-green.png",
iconWidth = 1, iconHeight = 1
)
) %>%
addSearchFeatures(
targetGroups = 'cities', # group should match addMarkers() group
options = searchFeaturesOptions(
zoom=12, openPopup = TRUE, firstTipSubmit = TRUE,
autoCollapse = TRUE, hideMarkerOnCollapse = TRUE
)
)
But is there a way that the above code can be modified such that when you enter a term in the search bar (e.g. ABC111, ABC112), the entire boundaries of this region are highlighted in red?
Thank you!
Related
How can i connect two linestrings?
It is possible to lay a very slim buffer around the lines and then connect them like so:
one_line <- lines %>%
st_buffer(0.05) %>%
st_intersection() %>%
st_union() %>%
st_cast('LINESTRING')
There are 2 problems with this:
a) below is a very small subset of my data containing one such disconnected line segment - if i use the above method on the small part it forms a complete polygon which, when converted to a linestring just makes a very narrow loop
b) if i use the whole data set it kind of works but creates lines at the approximate distance of the buffer around my original line. See picture below:
Blue & red are the edge lines while black would be the original.
I thought to simply average them out but when i convert the 2 lines to coordinates (st_coordinates()), the resulting tables have different lengths and are not in order.
I looked around but did not really find any useful answers.
Here is a dput of the geometry data:
lines <- structure(list(structure(list(structure(c(2880, 2880.92, 2881.72,
2882.47, 2883.17, 2883.84, 2884.5, 2894.05, 2894.69, 2895.29393034826,
340255.362641509, 340257.22, 340259.03, 340260.85, 340262.69,
340264.55, 340266.4, 340293.7, 340295.61, 340297.500995024), .Dim = c(10L,
2L)), structure(c(2907.22402724177, 2914.21353757771, 340330.886392736,
340350.2), .Dim = c(2L, 2L))), class = c("XY", "MULTILINESTRING",
"sfg")), structure(c(2895.3, 2896.82, 2897.26, 2897.72, 2907.2,
340297.52, 340302.26, 340303.58, 340304.89, 340330.82), .Dim = c(5L,
2L), class = c("XY", "LINESTRING", "sfg"))), n_empty = 0L, crs = structure(list(
input = "EPSG:31256", wkt = "PROJCRS[\"MGI / Austria GK East\",\n BASEGEOGCRS[\"MGI\",\n DATUM[\"Militar-Geographische Institut\",\n ELLIPSOID[\"Bessel 1841\",6377397.155,299.1528128,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4312]],\n CONVERSION[\"Austria Gauss-Kruger East\",\n METHOD[\"Transverse Mercator\",\n ID[\"EPSG\",9807]],\n PARAMETER[\"Latitude of natural origin\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433],\n ID[\"EPSG\",8801]],\n PARAMETER[\"Longitude of natural origin\",16.3333333333333,\n ANGLEUNIT[\"degree\",0.0174532925199433],\n ID[\"EPSG\",8802]],\n PARAMETER[\"Scale factor at natural origin\",1,\n SCALEUNIT[\"unity\",1],\n ID[\"EPSG\",8805]],\n PARAMETER[\"False easting\",0,\n LENGTHUNIT[\"metre\",1],\n ID[\"EPSG\",8806]],\n PARAMETER[\"False northing\",-5000000,\n LENGTHUNIT[\"metre\",1],\n ID[\"EPSG\",8807]]],\n CS[Cartesian,2],\n AXIS[\"northing (X)\",north,\n ORDER[1],\n LENGTHUNIT[\"metre\",1]],\n AXIS[\"easting (Y)\",east,\n ORDER[2],\n LENGTHUNIT[\"metre\",1]],\n USAGE[\n SCOPE[\"Engineering survey, topographic mapping.\"],\n AREA[\"Austria east of 14°50'E of Greenwich (32°30'E of Ferro).\"],\n BBOX[46.56,14.83,49.02,17.17]],\n ID[\"EPSG\",31256]]"), class = "crs"), idx = structure(c(1,
2, 1, 1), .Dim = c(2L, 2L)), class = c("sfc_GEOMETRY", "sfc"), precision = 0, bbox = structure(c(xmin = 2880,
ymin = 340255.362641509, xmax = 2914.21353757771, ymax = 340350.2
), class = "bbox"), classes = c("MULTILINESTRING", "LINESTRING"
))
For the above example, you could cast to MULTIPOINT, then union, and cast to LINESTRING.
``` r
library(tidyverse) #overkill, but easier
library(sf)
library(patchwork) #to plot side-by-side
# load data from above
# lines <-
single_line <- lines %>%
st_as_sf() %>%
st_cast('MULTIPOINT') %>%
st_union() %>%
st_cast('LINESTRING')
head(single_line)
#> Geometry set for 1 feature
#> Geometry type: LINESTRING
#> Dimension: XY
#> Bounding box: xmin: 2880 ymin: 340255.4 xmax: 2914.214 ymax: 340350.2
#> Projected CRS: MGI / Austria GK East
#> LINESTRING (2880 340255.4, 2880.92 340257.2, 28...
p1 <- ggplot() +
geom_sf(data = st_as_sf(lines), col = c('red', 'blue')) + ggtitle('lines')
p2 <- ggplot() + geom_sf(data = single_line, col = 'black') + ggtitle('lines cast & unioned')
p3 <- p1 + p2
p3
Created on 2022-03-08 by the reprex package (v0.3.0)
This is an incomplete answer because it still requires some manual input but it can be generalized by implementing a few rules.
The idea is to find the places where the line is broken and then go to the start/endpoints of the closest line. Then make a line segment bridging the break and combining all the line segments.
library(lwgeom)
library(tidyverse)
library(sf)
line1 <- lines %>%
st_sf() %>%
st_combine() %>%
st_sf() %>%
st_line_merge() %>%
st_cast("LINESTRING")
### this is still some manual work which needs to be improved
newline1 <- c(st_startpoint(line1[3,]), st_endpoint(line1[2,])) %>%
st_combine() %>%
st_cast("MULTIPOINT") %>%
st_union() %>%
st_cast("LINESTRING") %>%
st_sf()
newline2 <- c(st_startpoint(line1[2,]), st_endpoint(line1[1,])) %>%
st_combine() %>%
st_cast("MULTIPOINT") %>%
st_union() %>%
st_cast("LINESTRING") %>%
st_sf()
line1[nrow(line1)+1,]<-newline1
line1[nrow(line1)+1,]<-newline2
###
line1_uni <- line1 %>%
st_sf() %>%
st_combine() %>%
st_sf() %>%
st_line_merge() %>%
st_cast("LINESTRING") %>%
st_sf()
line1_uni
Simple feature collection with 1 feature and 0 fields
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: 2880 ymin: 340255.4 xmax: 2914.214 ymax: 340350.2
Projected CRS: MGI / Austria GK East
geometry
1 LINESTRING (2880 340255.4, ...
My data set has 4 columns which are station_name, station_lat, station_lng, and count. This is the example of my data set.
start_stations <-
data.frame(
station = c("StreeterDr", "MichiganAve", "WellsSt"),
lat = c(41.89228, 41.90096, 41.91213),
lng = c(-87.61204,-87.62378,-87.63466),
n = c(23000, 56780, 34520)
)
I need to plot a map using these coordinates and color variations to stations (locations) according to its count and label each location using name and count. I tried this code, and an error occurred.
install.packages(c("leaflet", "sp"))
library(leaflet)
library(sp)
install.packages("sf")
library(sf)
lon <- start_stations$lng
lat <- start_stations$lat
name <- start_stations$station
count <- start_stations$n
dfs <- as.data.frame(cbind(lon,lat,name,count))
dfs<- st_as_sf(dfs)
getColor <- function(dfs) {
sapply(dfs$count, function(count) {
if(count <= 20000) {
"green"
} else if(count <= 30000) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(top100_start_station_cordinates)
)
leaflet(dfs) %>% addTiles() %>%
addAwesomeMarkers(~lon, ~lat, icon=icons, popup = ~as.character(name), label=~as.character(count))
You need to define the coords when using st_as_sf.
dfs <- sf::st_as_sf(dfs, coords = c("lon","lat"))
# But you might also want to go ahead and define the projection here too.
# If so, then add in the crs argument.
# dfs <- sf::st_as_sf(dfs, coords = c("lon", "lat"), crs = 4326)
Output
Simple feature collection with 3 features and 2 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: -87.63466 ymin: 41.89228 xmax: -87.61204 ymax: 41.91213
CRS: NA
name count geometry
1 StreeterDr 23000 POINT (-87.61204 41.89228)
2 MichiganAve 56780 POINT (-87.62378 41.90096)
3 WellsSt 34520 POINT (-87.63466 41.91213)
Then, you should be able to run your remaining code and get the leaflet output.
below is an example of finding route, travel time and travel distance from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' using osrm package in R. (I learnt it from Road Routing in R). The travel time here is 10.37 minutes.
Q. How can I interpolate and find location after 5 minutes.
library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)
# 1. One World Trade Center, NYC
# 2. Madison Square Park, NYC
adresses <- c("285 Fulton St, New York, NY 10007",
"11 Madison Ave, New York, NY 10010")
# geocode the two addresses & transform to {sf} data structure
data <- tidygeocoder::geo(adresses, method = "osm") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
osroute <- osrm::osrmRoute(loc = data,
returnclass = "sf")
summary(osroute)
library(leaflet)
leaflet(data = data) %>%
addProviderTiles("CartoDB.Positron") %>%
addMarkers(label = ~address) %>%
addPolylines(data = osroute,
label = "OSRM engine",
color = "red")
Use the osrm::osrmIsochrone() function to find the five minute travel distance polygon, and then find the point that the route intersects the polygon.
It looks like its on Clarkson Street between Hudson & Varick.
library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)
# 1. One World Trade Center, NYC
# 2. Madison Square Park, NYC
adresses <- c("285 Fulton St, New York, NY 10007",
"11 Madison Ave, New York, NY 10010")
# geocode the two addresses & transform to {sf} data structure
data <- tidygeocoder::geo(adresses, method = "osm") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
# get route from 285 fulton to 11 madison
osroute <- osrmRoute(src = data[1,], dst = data[2,], returnclass = 'sf')
# five minute isochrone from 285 fulton
five_min_isochrone <- osrmIsochrone(data[1,], breaks = 5, returnclass = 'sf')
# isochrone has to be cast to MULTILINESTRING to find intersection as a point
intersection <- five_min_isochrone %>%
st_cast('MULTILINESTRING') %>%
st_intersection(osroute)
library(leaflet)
leaflet(data = data) %>%
addProviderTiles("CartoDB.Positron") %>%
addMarkers(label = ~address) %>%
addPolylines(data = osroute,
label = "OSRM engine",
color = "red") %>%
addPolygons(data = five_min_isochrone) %>%
addMarkers(data = intersection,
label = '5 minute distance')
I plotted a dot density map of the Australian states and am now trying to plot a chloropleth map of the Australian states using the leaflet package and color each state by the count value. I have the following data frame
state count latitude longitude
Australian Capital Territory 125 ... ...
New South Wales 45
Northern Territory 75
Queensland 12
South Australia 245
Tasmania 4895
Victoria 279
The following is the code I used to plot the dot density map
leaflet(aus_state_counts) %>%
addTiles() %>%
addCircleMarkers(
layerId = ~state,
label = ~state,
radius = ~count
) %>%
fitBounds(lng1 = max(aus_state_counts$longitude) ,lat1 = max(aus_state_counts$latitude),
lng2 = min(aus_state_counts$longitude) ,lat2 = min(aus_state_counts$latitude)
)
I am unsure how to plot the states on the map? Do I need additional information for this?
For a choropleth map you will need some spatial polygon data in the form of a shape file (.shp) or GeoJSON (.geojson). Below should work.
library(sf)
library(leaflet)
library(dplyr)
# GeoJSON Data
states <- read_sf("https://raw.githubusercontent.com/rowanhogan/australian-states/master/states.geojson")
counts <- data.frame(state=c("Australian Capital Territory", "New South Wales", "Northern Territory", "Queensland",
"South Australia", "Tasmania", "Victoria"), count=c(125,45,75,12,245,4895,279))
# Join to count data
data <- states %>%
dplyr::left_join(counts, by=c("STATE_NAME" = "state"))
# Specify choropleth colors
pal <- colorQuantile("Blues", domain = data$count)
# Plot Map
leaflet(data) %>%
addTiles() %>%
addPolygons(fillColor=~pal(count), fillOpacity=0.8, color="white", weight=1)
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