The coordinates of the Eiffel Tower are (Longitude: 48.8584° N, Latitude: 2.2945° E). I am interested in randomly generating 100 points that are located within a 12 KM radius of the Eiffel Tower. In other words, I would like to randomly generate 100 pairs of (Longitude, Latitude) that are located within a 12 KM radius of the Eiffel Tower.
According to this question here (Simple calculations for working with lat/lon and km distance?), the following formulas can be used to convert Longitude and Latitude to KM:
Latitude: 1 deg = 110.574 km
Longitude: 1 deg = 111.320*cos(latitude) km
Thus, if I want to find out a 12 KM radius, the corresponding maximum ranges should be:
Max Latitude Range: 12 * (1/110.574) = 0.1085246
Max Longitude Range: 111.320*cos(0.1085246) = 110.6651 -> 1/110.6651 = 0.009036273
Using this information, I tried to simulate points and plot them:
# for some reason, you have to call "long" as "lat" and vice versa - otherwise the points appear in the wrong locations all together
id = 1:100
long = 2.2945 + rnorm( 100, 0.1085246 , 1)
lat = 48.8584 + rnorm( 100, 0.009036273 , 1)
my_data = data.frame(id, lat, long)
library(leaflet)
my_data %>%
leaflet() %>%
addTiles() %>%
addMarkers(clusterOption=markerClusterOptions())
But these points do not appear near the Eiffel Tower - some of them are even in Belgium! :
I reduced the variance and now the points appear closer:
# reduce variance
id = 1:100
long = 2.2945 + rnorm( 100, 0.1085246 , 0.01)
lat = 48.8584 + rnorm( 100, 0.009036273 , 0.01)
my_data = data.frame(id, lat, long)
library(leaflet)
my_data %>%
leaflet() %>%
addTiles() %>%
addMarkers(clusterOption=markerClusterOptions())
But this of course required some guess work and playing around - ideally, I would like a more "mathematical approach".
Is there some standard formula I can use to make sure that no matter what initial coordinate I choose (e.g. Eiffel Tower, Statue of Liberty, etc.), the randomly generated points will always fall in a certain radius?
Thank you!
One option is to use the sf package. The function st_buffer will allow you to create a 12 km circle around your starting point, and st_sample will allow you to take 100 random points within that circle.
Create the data
library(sf)
library(dplyr)
pt_sf <- data.frame(long = 2.2945, lat = 48.8584) %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
buff <- pt_sf %>%
st_buffer(dist = units::as_units(12, 'km'))
buff_sample <- st_sample(buff, 100)
Plot it
library(leaflet)
leaflet(pt_sf) %>%
addTiles() %>%
addCircleMarkers(color = 'red') %>%
addPolygons(data = buff) %>%
addMarkers(data = buff_sample, clusterOption=markerClusterOptions())
Related
I have a dataset in polar coordinates.
The dataset contains the coordinates of points that I cast in lines.
Then I want to intersect these lines with a circle. From the polar coordinates, you can see that the Boundary of the line is always 18 (which is also the limit of the circle).
In order to do the intersect I convert Polar coordinates to cartesian.
In the end, only some of the lines correctly intersect the circle, and I do not know why.
What works for me is a Not So Elegant Solution: I reduce the circle radius from 18 to 17.999. This works and I suppose that it is because the conversion from polar to cartesian is not 100%. For my purpose, the solution I found is enough, but I want to report it here (I do not know if this is a bug or I made some mistake),
Here is the reproducible example (with plots):
#My Dataset
Boundaries<- data.frame(UE = c(127,127,128,128,128,129,129,129,129,129),
ID_Line = c(1,1,1,1,1,1,1,1,2,2),
ID_Point = c(1,2,1,2,3,1,2,3,1,2),
Azimut = c(10,120,120,90,230,120,90,230,90,270),
Distance = c(18,18,18,5,18,18,5,18,5,18)
)
library(tidyverse)
library(useful)
#Polar to Cartesian coordinates conversion
Boundariesxy<-as_tibble(Boundaries) %>%
mutate(Theta = 2*pi*Azimut/360,
x = pol2cart(Distance, Theta, degrees=F)[["y"]],
y = pol2cart(Distance, Theta, degrees=F)[["x"]])
library(sf)
#Conversion to sf object
Boundaries_sf <- st_as_sf(Boundariesxy,
coords = c('x', 'y')) %>%
st_set_crs("102010") %>%
group_by(UE, ID_Line) %>%
summarise() %>%
ungroup()
#Cast as Linestring
Bound_lines <- st_cast(Boundaries_sf, "LINESTRING")
#Preparing a circle polygon
Point<- data.frame(
Plot = c("A"),
x = c(0),
y = c(0))
#We convert the center of the circle in a spatial object using a CRS in meters
Point_sf <- st_as_sf(Point,
coords = c('x', 'y')) %>%
st_set_crs("102010") %>%
st_convex_hull()
#Buffer
Circle_st_18<-st_buffer(Point_sf,18)
Circle_st_17999<-st_buffer(Point_sf,17.999)
library(lwgeom)
#For each UE I do an intersect Line->Circle
B127<-Bound_lines[which(Bound_lines$UE==127),]
plot(B127)
Split_127<-st_split(Circle_st_18,B127)
plot(Split_127)
Split_127_2<-st_split(Circle_st_17999,B127)
plot(Split_127_2)
Poly_127 <- (Split_127 %>% st_collection_extract(c("POLYGON")))
st_area(Poly_127)
B128<-Bound_lines[which(Bound_lines$UE==128),]
plot(B128)
Split_128<-st_split(Circle_st_18,B128)
plot(Split_128)
Split_128_2<-st_split(Circle_st_17999,B128)
plot(Split_128_2)
Poly_128 <- (Split_128 %>% st_collection_extract(c("POLYGON")))
st_area(Poly_128)
B129<-Bound_lines[which(Bound_lines$UE==129),]
plot(B129)
Split_129<-st_split(Circle_st_18,B129)
plot(Split_129)
Poly_129 <- (Split_129 %>% st_collection_extract(c("POLYGON")))
st_area(Poly_129)
Split_129_2<-st_split(Circle_st_17999,B129)
plot(Split_129_2)
There are some other posts out there related to this one, such as these: Post 1, Post 2, Post 3. However, none of them deliver what I am hoping for. What I want is to be able to draw a line segment from a specific point (a sampling location) to the edge of a polygon fully surrounding that point (a lake border) in a specific direction ("due south" aka downward). I then want to measure the length of that line segment in between the sampling point and the polygon edge (really, it's only the distance I want, so if we can get the distance without drawing the line segment, so much the better!). Unfortunately, it doesn't seem like functionality to do this already exists within the sf package: See closed issue here.
I suspect, though, that this is possible through a modification of the solution offered here: See copy-pasted code below, modified by me. However, I am pretty lousy with the tools in sf--I got as far as making line segments that just go from the points themselves to the southern extent of the polygon, intersecting the polygon at some point:
library(sf)
library(dplyr)
df = data.frame(
lon = c(119.4, 119.4, 119.4, 119.5, 119.5),
lat = c(-5.192,-5.192,-5.167,-5.167,-5.191)
)
polygon <- df %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
summarise(geometry = st_combine(geometry)) %>%
st_cast("POLYGON")
plot(polygon)
df2 <- data.frame(lon = c(119.45, 119.49, 119.47),
lat = c(-5.172,-5.190,-5.183))
points <- df2 %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
summarise(geometry = st_combine(geometry)) %>%
st_cast("MULTIPOINT")
plot(points, add = TRUE, col = "red")
# Solution via a loop
xmin <- min(df$lat)
m = list()
# Iterate and create lines
for (i in 1:3) {
m[[i]] = st_linestring(matrix(
c(df2[i, "lon"],
df2[i, "lat"],
df2[i, "lon"],
xmin),
nrow = 2,
byrow = TRUE
))
}
test = st_multilinestring(m)
# Result is line MULTILINESTRING object
plot(test, col = "green", add = TRUE)
But now I can't figure out how to use st_intersection or any such function to figure out where the intersection points are. Most of the trouble lies, I think, in the fact that what I'm creating is not an sf object, and I can't figure out how to get it to be one. I assume that, if I could figure out where the segments intersect the polygon (or the most-northern time they do so, ideally), I could somehow measure from the intersection points to the sampling points using a function like st_distance. Since lake polygons are often really complex, though, it's possible a segment will intersect the polygon multiple times (such as if there is a peninsula south of a given point), in which case I figure I can find the "furthest north" intersection point for each sampling point and use that or else take the minimum such distance for each sampling point.
Anyhow, if someone can show me the couple of steps I'm missing, that'd be great! I feel like I'm so close and yet so far...
Consider this approach, loosely inspired by my earlier post about lines from points
To make it more reproducible I am using the well known & much loved North Carolina shapefile that ships with {sf} and a data frame of three semi-random NC cities.
What the code does is:
iterates via for cycle over the dataframe of cities
creates a line starting in each city ("observation") and ending on South Pole
intersects the line with dissolved North Carolina
blasts the intersection to individual linestrings
selects the linestring that passes within 1 meter of origin
calculates the lenght via sf::st_lenghth()
saves the the result as a {sf} data frame called res (short for result :)
I have included the actual line in the final object to make the result more clear, but you can choose to omit it.
library(sf)
library(dplyr)
library(ggplot2)
shape <- st_read(system.file("shape/nc.shp", package="sf")) %>% # included with sf package
summarise() %>%
st_transform(4326) # to align CRS with cities
cities <- data.frame(name = c("Raleigh", "Greensboro", "Plymouth"),
x = c(-78.633333, -79.819444, -76.747778),
y = c(35.766667, 36.08, 35.859722)) %>%
st_as_sf(coords = c("x", "y"), crs = 4326)
# a quick overview
ggplot() +
geom_sf(data = shape) + # polygon of North Carolina
geom_sf(data = cities, color = "red") # 3 cities
# now here's the action!!!
for (i in seq_along(cities$name)) {
# create a working linestring object
wrk_line <- st_coordinates(cities[i, ]) %>%
rbind(c(0, -90)) %>%
st_linestring() %>%
st_sfc(crs = 4326) %>%
st_intersection(shape) %>%
st_cast("LINESTRING") # separate individual segments of multilines
first_segment <- unlist(st_is_within_distance(cities[i, ], wrk_line, dist = 1))
# a single observation
line_data <- data.frame(
name = cities$name[i],
length = st_length(wrk_line[first_segment]),
geometry = wrk_line[first_segment]
)
# bind results rows to a single object
if (i == 1) {
res <- line_data
} else {
res <- dplyr::bind_rows(res, line_data)
} # /if - saving results
} # /for
# finalize results
res <- sf::st_as_sf(res, crs = 4326)
# result object
res
# Simple feature collection with 3 features and 2 fields
# Geometry type: LINESTRING
# Dimension: XY
# Bounding box: xmin: -79.81944 ymin: 33.92945 xmax: -76.74778 ymax: 36.08
# Geodetic CRS: WGS 84
# name length geometry
# 1 Raleigh 204289.21 [m] LINESTRING (-78.63333 35.76...
# 2 Greensboro 141552.67 [m] LINESTRING (-79.81944 36.08...
# 3 Plymouth 48114.32 [m] LINESTRING (-76.74778 35.85...
# a quick overview of the lines
ggplot() +
geom_sf(data = shape) + # polygon of North Carolina
geom_sf(data = res, color = "red") # 3 lines
I try to create a new coordinates point away from 250NM from a known point. I want to keep the trajectory from my starting point and a known point. How could I use this information in order to create a new point, with a known distance :
# starting point
lat_0 = 4.842816
lon_0 = 7.017196
#known point
lat_1 = 4.108957
lon_1 = 8.099835
# this point is 78NM away from the starting point
I'm using R but I could translate a mathematical formula without any problems :).
Thus, I want to create a new point 250NM away, keeping this trajectory
library(sf)
library(mapview)
library(dplyr)
library(geosphere)
# test: what are we working with here?
test_df <- data.frame(point = 0:1, lon = c(lon_0, lon_1), lat = c(lat_0, lat_1))
test_df %>% sf::st_as_sf(coords = c("lon", "lat"), crs = 4326) %>% mapview::mapview()
# initialise points
point0 <- c(lon_0, lat_0)
point1 <- c(lon_1, lat_1)
#calculate bearing 0 >> 1
bearing0_1 <- geosphere::bearing(point0, point1)
#[1] 123.9916
# Calculate new point with calulated bearing ans distance
# 250 MN = 463000.2 metres
point2 <- as.vector(geosphere::destPoint(p = point0, b = bearing0_1, d = 463000.2))
# test output
rbind(point0, point1, point2) %>% as.data.frame(col.names = c("lon", "lat")) %>%
dplyr::mutate(point = 0:2) %>%
sf::st_as_sf(coords = c(1, 2), crs = 4326) %>% mapview::mapview()
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.
I wanted to create an video for visualization.
Q. How can I create an animation of vehicle (represented by a marker) moving from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' along the route ?
Ideally, we should know the speed in each road segment. But lets assume the vehicle moves non-stop at constant speed (= distance/time) between two location.
We can simply use tmap instead of leaflet also to create animation.
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")
As an alternative to the tmap approach proposed by #mrhellman I offer an alternative built on ggplot, ggmap (for the basemap) and gganimate based workflow.
I have found the outcome of animations created via {gganimate} preferable, as {gganimate} gives me more control - such as the shadow_wake that in my opinion nicely illustrates the movement of a car along the line. If I remember correctly tmap uses gganimate under the hood.
ggmap does not support CartoDB basemaps - such as the Positron used above - but I have found the toner background adequate.
Note that ggmap does not play quite nicely with ggplot2::geom_sf() and I have found it easier to transform my workflow to old ggplot2::geom_point() approach - i.e. extract the x and y coordinates and map them via aes().
As there is only a single route to display it should be sufficient to calculate a technical variable seq that is used in the transition_reveal() to animate; this may be replaced by a time dimension if & when necessary (such as when displaying more routes with different travel time in a single animation).
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")
# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled <- st_sample(osroute, type = 'regular', size = 50) %>%
st_cast('POINT') %>%
st_as_sf()
library(ggplot2)
library(ggmap) # warning: has a naming conflict with tidygeocoder!
library(gganimate)
# ggmap does not quite like geom_sf(),
# the "old school" geom_point will be easier to work with
osroute_xy <- osroute_sampled %>%
mutate(seq = 1:nrow(.),
x = st_coordinates(.)[,"X"],
y = st_coordinates(.)[,"Y"])
# basemap / the bbox depends on yer area of interest
NYC <- get_stamenmap(bbox = c(-74.05, 40.68, -73.9, 40.8),
zoom = 13,
maptype = "toner-background")
# draw a map
animation <- ggmap(NYC) +
geom_point(data = osroute_xy,
aes(x = x, y = y),
color = "red",
size = 4) +
theme_void() +
transition_reveal(seq) +
shadow_wake(wake_length = 1/6)
# create animation
gganimate::animate(animation,
nframes = 2*(nrow(osroute_xy)+1),
height = 800,
width = 760,
fps = 10,
renderer = gifski_renderer(loop = T))
# save animation
gganimate::anim_save('animated_nyc.gif')
Here's a {mapdeck} approach, which gives you an interactive map (like leaflet), and animated trips, and it can easily handle thousands of trips at a time
library(mapdeck)
set_token( secret::get_secret("MAPBOX") )
mapdeck(
location = as.numeric( data[1, ]$geometry[[1]] ) ## for 'trips' you need to specify the location
, zoom = 12
, style = mapdeck_style("dark")
) %>%
add_trips(
data = sf
, stroke_colour = "#FFFFFF" #white
, trail_length = 12
, animation_speed = 8
, stroke_width = 50
)
the add_trips() function takes an sf linestring object with the Z and M dimensions (z = elevation, m = time). So you can have a timestamp assocaited with each coordinate
library(mpadeck)
library(sfheaders)
df_route <- sfheaders::sf_to_df(osroute, fill = TRUE)
## Assume 'duration' is constant
## we want the cumulative time along the rute
df_route$cumtime <- cumsum(df_route$duration)
## and we also need a Z component.
## since we don't know the elevation, I'm setting it to '0'
df_route$elevation <- 0
## Build the 'sf' object wtih the Z and M dimensions
sf <- sfheaders::sf_linestring(
obj = df_route
, x = "x"
, y = "y"
, z = "elevation"
, m = "cumtime"
)
The website has more details.
Sample the route (a LINESTRING) with the number of points you would like to have, then use an lapply function to make the map objects, and use tmap_animate to animate them.
Adding to your code above:
library(tmap)
library(gifski)
# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled <- st_sample(osroute, type = 'regular', size = 50) %>%
st_cast('POINT') %>%
st_as_sf()
# use lapply to crate animation maps. taken from reference page:
# https://mtennekes.github.io/tmap/reference/tmap_animation.html
m0 <- lapply(seq_along(1:nrow(osroute_sampled)), function(point){
x <- osroute_sampled[point,] ## bracketted subsetting to get only 1 point
tm_shape(osroute) + ## full route
tm_sf() +
tm_shape(data) + ## markers for start/end points
tm_markers() +
tm_shape(x) + ## single point
tm_sf(col = 'red', size = 3)
})
# Render the animation
tmap_animation(m0, width = 300, height = 600, delay = 10)
It's been a while since I've used tmap, so I'm not up to date on adding provider tiles. Shouldn't be too hard for you to add those into the lapply function.
I have added an animation to see spatio-temporal distribution of crashes for a day in region of London.
How can I see the time of crash to better appreciate the animation? A simpler method is to plot crash number and time as text on heading or inside the plot. But thats not desired.
Can someone please help me to create a time axis at the bottom which has points representing each crash and corresponding datetime. Here is an example of desired timeline link. The point corresponding to the crash changes color in sync with animation below.
install.package("stats19")
library(stat19)
library(sf)
library(tidyverse)
library(stats19)
library(tmap)
library(tmaptools)
library(spData)
library(lubridate)
# crash date of UK
crashes_2019 <- get_stats19(year = 2019, type ="accidents")
# crash data for a day
crashes <- crashes_2019 %>%
drop_na() %>%
filter(date == as_date("2019-01-05")) %>%
st_as_sf(coords = c("longitude", "latitude"), crs = 4326)
# creating a polygon
my_polygon <- cycle_hire %>%
slice(1:5) %>%
st_buffer(dist = 10000) %>%
st_union()
# open street map of the region
bb <- st_bbox(my_polygon)
osm_map <- read_osm(bb)
# crash inside polygon
crashes_zone <- st_intersection(crashes,
my_polygon)
# animation
m1 <- lapply(seq_along(1:nrow(crashes_zone)), function(point){
x <- crashes_zone[point,] ## bracketted subsetting to get only 1 point
m1 <- tm_shape(my_polygon) +
tm_polygons() +
tm_shape(osm_map) +
tm_rgb(alpha = 0.6) +
tm_shape(x) + ## single point
tm_sf(col = 'red', size = 0.1)
})
# Render the animation
tmap_animation(m1, width = 300, height = 600, delay = 100)