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)
Related
My ultimate goal is to use gdistance::shortestPath() to calculate the shortest path distance from a point on one side of an island to a point on the other side of the same island, while not travelling over land (i.e. travel by sea), while accounting for ocean current speed and current direction.
An intermediate of the above is to generate a transition layer, which is subsequently passed to shortestPath(). I am having trouble understanding how to pass multiple rasters to gdistance::transition().
I have the following raster layers:
ocean current speed
ocean current bearing
map of ocean with an island
A small example:
library(dplyr)
library(sf)
library(terra)
library(gdistance)
library(raster)
# Ocean current speed raster
ocean_spd <- terra::rast(nrow = 100,
ncol = 100,
xmin = 0,
xmax = 1,
ymin = 0,
ymax = 1,
crs = NA)
# set all ocean values to 0.5 (m/s)
ocean_spd <- terra::setValues(ocean_spd, 0.5)
# Ocean current bearing raster
# set all current bearing to 90 (left to right)
ocean_dir <- terra::setValues(ocean_spd, 90)
# Create island raster
# island corners
poly_df <- data.frame(x = c(0.5, 0.5, 0.8, 0.8),
y = c(0.5,0.8, 0.8, 0.5))
# island as a polygon
poly_sf <- poly_df %>%
sf::st_as_sf(coords = c("x","y")) %>%
summarise(geometry = sf::st_combine(geometry)) %>%
sf::st_cast("POLYGON") %>%
sf::st_make_valid()
# convert polygon to raster
island_mask <- terra::rasterize(poly_sf, ocean_spd)
plot(island_mask)
# island cells = 999 and ocean cell = 1
island_mask[island_mask == 1] <- 999
island_mask[is.nan(island_mask)] <- 1
# remove island from current and bearing rasters
ocean_spd[island_mask == 999] <- NA
ocean_dir[island_mask == 999] <- NA
# convert rast objects to raster - needed by transition()
island_mask <- raster(island_mask)
ocean_spd <- raster(ocean_spd)
ocean_dir <- raster(ocean_dir)
# have a look at the layers
plot(island_mask)
text(island_mask, digits=1)
plot(ocean_spd)
text(ocean_spd, digits=1)
plot(ocean_dir)
text(ocean_dir, digits=1)
Calculate transition layer - this is where I am stuck, it is not clear to me how I integrate the island raster, the ocean speed raster and the ocean current bearing raster to get the transition object.
trans_obj <- transition(island_mask, transitionFunction = ?, 16, symm = FALSE)
From here I would then use the transition object (trans_obj) to calculate shortest path between two points on the edge of the island (e.g. ports) - via the ocean
pt_dist <- gdistance::shortestPath(trans_obj,
poly_df[1,],
poly_df[2,],
output = "SpatialLines")
# get the distance
sf::st_as_sf(pt_dist) %>%
sf::st_length()
My question:
how can I pass the island raster, the ocean speed raster and the ocean current bearing raster to transition() to generate the transition object? Or is there some other middle step that I need to do to combine my three rasters before passing them to transition()?
Any advice would be much appreciated.
One approach is to
build a transition matrix for the speed vector's horizontal and vertical components each
build transition matrices for horizontal and vertical position
geoCorrect above
reconstruct resultant conductance from horizontal and vertical components
Example:
I used some mapping (with {purrr}), but that could be achieved with .apply variants or other if you don't want to keep the number of packages low
library(dplyr)
library(sf)
library(terra)
library(gdistance)
library(raster)
library(purrr) ## for convenient list mapping
set some global variables (for the sake of demonstration only)
const_ocean_dir = 60 ## remove when passing this as a function argument
const_ocean_spd = .5 ## remove when passing this as a function argument
raster_template <- rast(nrow = 100, ncol = 100, xmin = 0, xmax = 1, ymin = 0, ymax = 1, crs = NA)
nr = nrow(raster_template); nc = ncol(raster_template)
dir_count = 16 ## number of transition directions
create island mask (code from your question)
poly_df <- data.frame(x = c(0.5, 0.5, 0.8, 0.8),
y = c(0.5,0.8, 0.8, 0.5))
poly_sf <- poly_df %>%
sf::st_as_sf(coords = c("x","y")) %>%
summarise(geometry = sf::st_combine(geometry)) %>%
sf::st_cast("POLYGON") %>%
sf::st_make_valid()
island_mask <- terra::rasterize(poly_sf, raster_template)
island_mask[island_mask == 1] <- 999
island_mask[is.nan(island_mask)] <- 1
create a list "rasters" and start populating it:
rasters <- list()
rasters$ocean_spd <- raster_template |> setValues(const_ocean_spd)
rasters$ocean_dir <- raster_template |> setValues(const_ocean_dir)
create rasters with horizontal and vertical speed components, depending on current direction:
## a helper to convert bearing (degrees clockwise from North)
## to radiant (clockwise from East):
bearing_to_rad <- function(bearing) (bearing - 90) * pi/180
## raster ocean speed into longitudinal and latitudinal component:
rasters$ocean_spd_x <- with(rasters, ocean_spd * cos(bearing_to_rad(ocean_dir)))
rasters$ocean_spd_y <- with(rasters, ocean_spd * sin(bearing_to_rad(ocean_dir)))
Create rasters of longitudinal and latitudinal position (values increasing from West to East and North to South). We need these to multiply position shift with speed components further down:
rasters$pos_x <- raster_template |> setValues(matrix(1:nr, nr, nc, byrow = TRUE))
rasters$pos_y <- raster_template |> setValues(matrix(1:nr, nr, nc))
Create rasters with speed at position (these are the basis for the transition matrices):
rasters$spd_at_pos_x <- rasters$ocean_spd_x * rasters$pos_x
rasters$spd_at_pos_y <- rasters$ocean_spd_y * rasters$pos_y
mask all rasters with island mask:
## mask rasters with island raster:
rasters <- rasters |> map(~ {.x[island_mask == 999] = NA; .x})
Create transition matrix. Transition is asymmetric (depends on direction of movement relative to speed components), thus symm = FALSE. Add a slight offset (.001) to avoid zero matrix for x- or y-speed component at angles of 90°, 180° etc. (Note: when transitionFunction is called with the argument x, x[1] is the "from" cell's value and x[2]that of the "to" cell.)
tr_layers <-
rasters[c('spd_at_pos_x', 'spd_at_pos_y')] |>
map(~ transition(.x |> raster(),
transitionFunction = \(from_to) .001 + from_to[2] - from_to[1],
directions = dir_count,
symm = FALSE
)
)
geoCorrect transition layers (as diagonal neighbour cells are farther off than orthogonal ones):
tr_layers <- tr_layers |> map(~ .x |> geoCorrection(type = 'c'))
calculate a conductance proxy (to be maximised) from longi- and latitudinal components:
tr_layers$ocean_spd_resultant <- with(tr_layers, spd_at_pos_x + spd_at_pos_y)
create a helper function to shift values of a transition matrix to entirely positive (negative values not allowed for some gdistance conditions):
shift_to_positive <- function(tr_matrix){
adj <- adjacencyFromTransition(tr_matrix)
tmp <- tr_matrix[adj]
tmp[is.na(tmp)] = 0
tmp <- tmp - min(tmp, na.rm = TRUE)
tr_matrix[adj] <- tmp
tr_matrix[!adj] <- 0
tr_matrix
}
shift transition matrix and return shortest path and cost distance in a list:
tr_layers$ocean_spd_resultant <- tr_layers$ocean_spd_resultant |> shift_to_positive()
list(shortest_path = shortestPath(tr_layers$ocean_spd_resultant, A, B, output="SpatialLines"),
cost_distance = costDistance(tr_layers$ocean_spd_resultant, A, B)
)
output
after wrapping the code into a function get_shortest_path:
get_shortest_path <- function(const_ocean_spd, const_ocean_dir, A = c(0, 0), B = c(1, 1){
## above code here
}
... and calculating shortest paths and cost distances for bearings 30, 60 ... 360°:
blue arrows indicate direction of the current
cost: relative cost of moving from A to B
I'm trying to create and visualize buffers around point locations with the sf package in R. An initial attempt looked like this:
library(sf)
library(dplyr)
library(mapview)
sf_use_s2(TRUE)
coord <- c(178.4, -80.1)
point <- st_sfc(st_point(coord), crs = 4326)
buffer <- st_buffer(point, 2000000, max_cells = 10000)
buffer %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>%
mapview() + mapview(point)
I was able to fix this using st_shift_longitude() (sort of, latitude doesn't stretch to -90):
buffer %>%
st_shift_longitude() %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>%
mapview() + mapview(point)
However, this approach fails for other points:
coord <- c(78.4, -80.1)
point <- st_sfc(st_point(coord), crs = 4326)
buffer <- st_buffer(point, 2000000, max_cells = 10000)
buffer %>%
st_shift_longitude() %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>%
mapview() + mapview(point)
Is there a surefire way to produce buffers like this?
If your coordinates and polygons are near the poles as above, mapview's default projections (4326 I think 3857 web mercator) probably won't work well. You can use other projections (with the native.crs = T argument), but you'll have to supply polygon data for the landmass as well. The default 'background' of Earth's landmasses won't automatically appear.
Below I've used the crs and antarctic polygon from a github issue thread found here: https://github.com/r-spatial/mapview/issues/298. You might be able to find some other tips in the thread as well.
library(mapview)
library(sf)
library(leaflet)
library(dplyr)
#Loading data
# steal the crs & antarctic polygon (SFPoly2) for the points
load(url("https://github.com/elgabbas/Misc/blob/master/Data.RData?raw=true"))
# Your data
coord <- c(178.4, -80.1)
point <- st_sfc(st_point(coord), crs = 4326)
# Transform to use the polar crs
point <- st_transform(point, st_crs(SFPoint))
buffer <- st_buffer(point, 2000000, max_cells = 10000)
# Use mapview with the 'native.crs = T' argument
# There will be many warnings about old-style crs & not using long-lat data
mapview(SFPoly2, native.crs = T) + # Antarctic landmass
mapview(point, fill = 'red', native.crs = T) +
mapview(buffer, native.crs = T)
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())
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()