For each observation in a data frame in a year I am trying to finde the nearest observation in another data frame one year prior and calculate their distance.
Following this (https://gis.stackexchange.com/questions/349955/getting-a-new-column-with-distance-to-the-nearest-feature-in-r) approach, I wrote the following code:
for(x in 2000:2020) {
R36_loc$nearest <- st_nearest_points(
R36_loc %>% ungroup() %>% filter(year == x),
mining_loc %>% ungroup() %>% filter(year == x - 1)
)
}
R36_loc$dist_near_mine = st_distance(R36_loc, mining_loc[nearest,], by_element=TRUE)
My data looks like this: mining_loc:
structure(list(year = structure(c(2009, 2007, 2008, 2009, 2007,
2007, 2009, 2008, 2010, 2008, 2011, 2002, 2012, 2012, 2009, 2010,
2012, 2006, 2014, 2013, 2008, 2010, 2006, 2011, 2004, 2006, 2011,
2012, 2014, 2005), label = "year", format.stata = "%10.0g"),
geometry = structure(list(structure(c(29.6789, -3.5736), class = c("XY",
"POINT", "sfg")), structure(c(29.146988, -26.09538), class = c("XY",
"POINT", "sfg")), structure(c(0.089167, 35.93111), class = c("XY",
"POINT", "sfg")), structure(c(29.915396, -20.535308), class = c("XY",
"POINT", "sfg")), structure(c(28.01295, -26.22712), class = c("XY",
"POINT", "sfg")), structure(c(-8.88214, 31.86011), class = c("XY",
"POINT", "sfg")), structure(c(6.475727, 30.66071), class = c("XY",
"POINT", "sfg")), structure(c(-2.04396, 5.243666), class = c("XY",
"POINT", "sfg")), structure(c(27.702666, -21.358855), class = c("XY",
"POINT", "sfg")), structure(c(48.650001, -16.176654), class = c("XY",
"POINT", "sfg")), structure(c(33.23611, 28.59167), class = c("XY",
"POINT", "sfg")), structure(c(30.945726, -22.507772), class = c("XY",
"POINT", "sfg")), structure(c(22.90999, -27.175352), class = c("XY",
"POINT", "sfg")), structure(c(10.44916725, 35.54916763), class = c("XY",
"POINT", "sfg")), structure(c(-12.136052, 7.765232), class = c("XY",
"POINT", "sfg")), structure(c(32.89942, 24.09082), class = c("XY",
"POINT", "sfg")), structure(c(28.58115, -25.256046), class = c("XY",
"POINT", "sfg")), structure(c(31.673825, -28.221349), class = c("XY",
"POINT", "sfg")), structure(c(12.916667, 18.683333), class = c("XY",
"POINT", "sfg")), structure(c(8.915834, 33.53159), class = c("XY",
"POINT", "sfg")), structure(c(17.71667, -19.21667), class = c("XY",
"POINT", "sfg")), structure(c(27.88332939, -12.46667004), class = c("XY",
"POINT", "sfg")), structure(c(33.98638, 17.70217), class = c("XY",
"POINT", "sfg")), structure(c(27.302793, -25.65206), class = c("XY",
"POINT", "sfg")), structure(c(-8.10837, 6.87479), class = c("XY",
"POINT", "sfg")), structure(c(-5.03293, 31.50764), class = c("XY",
"POINT", "sfg")), structure(c(38.66667, -3.81667), class = c("XY",
"POINT", "sfg")), structure(c(27.191434, -27.390284), class = c("XY",
"POINT", "sfg")), structure(c(31.924721, -28.841876), class = c("XY",
"POINT", "sfg")), structure(c(-10.7299, 11.32676), class = c("XY",
"POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = -12.136052,
ymin = -28.841876, xmax = 48.650001, ymax = 35.93111), class = "bbox"), crs = structure(list(
input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\",\n ENSEMBLE[\"World Geodetic System 1984 ensemble\",\n MEMBER[\"World Geodetic System 1984 (Transit)\"],\n MEMBER[\"World Geodetic System 1984 (G730)\"],\n MEMBER[\"World Geodetic System 1984 (G873)\"],\n MEMBER[\"World Geodetic System 1984 (G1150)\"],\n MEMBER[\"World Geodetic System 1984 (G1674)\"],\n MEMBER[\"World Geodetic System 1984 (G1762)\"],\n MEMBER[\"World Geodetic System 1984 (G2139)\"],\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]],\n ENSEMBLEACCURACY[2.0]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"geodetic latitude (Lat)\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"geodetic longitude (Lon)\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n USAGE[\n SCOPE[\"Horizontal component of 3D system.\"],\n AREA[\"World.\"],\n BBOX[-90,-180,90,180]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), class = c("sf",
"grouped_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA,
-30L), groups = structure(list(year = structure(c(2002, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014), label = "year", format.stata = "%10.0g"),
.rows = structure(list(12L, 25L, 30L, c(18L, 23L, 26L), c(2L,
5L, 6L), c(3L, 8L, 10L, 21L), c(1L, 4L, 7L, 15L), c(9L, 16L,
22L), c(11L, 24L, 27L), c(13L, 14L, 17L, 28L), 20L, c(19L,
29L)), ptype = integer(0), class = c("vctrs_list_of", "vctrs_vctr",
"list"))), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-12L), .drop = TRUE), sf_column = "geometry", agr = structure(c(year = NA_integer_), levels = c("constant",
"aggregate", "identity"), class = "factor"))
and R36_loc:
structure(list(year = c(2012, 2013, 2008, 2005, 2012, 2013, 2005,
2013, 2008, 2005, 2012, 2012, 2008, 2005, 2005, 2009, 2008, 2012,
2005, 2006, 2012, 2005, 2008, 2012, 2012, 2005, 2008, 2008, 2008,
2005), geometry = structure(list(structure(c(29.17557, -21.20929
), class = c("XY", "POINT", "sfg")), structure(c(-13.75231, 9.4795399
), class = c("XY", "POINT", "sfg")), structure(c(-8.5474997,
6.82056), class = c("XY", "POINT", "sfg")), structure(c(-23.522779,
14.91389), class = c("XY", "POINT", "sfg")), structure(c(-2.64236,
7.8043299), class = c("XY", "POINT", "sfg")), structure(c(40.041,
-0.17200001), class = c("XY", "POINT", "sfg")), structure(c(33.48946,
-9.1142197), class = c("XY", "POINT", "sfg")), structure(c(-7.07623,
4.6770301), class = c("XY", "POINT", "sfg")), structure(c(34.116669,
-14.15), class = c("XY", "POINT", "sfg")), structure(c(35.650669,
-15.80635), class = c("XY", "POINT", "sfg")), structure(c(-11.01406,
6.6858401), class = c("XY", "POINT", "sfg")), structure(c(34.030159,
0.84144002), class = c("XY", "POINT", "sfg")), structure(c(34.191002,
1.016), class = c("XY", "POINT", "sfg")), structure(c(37.385761,
-1.94943), class = c("XY", "POINT", "sfg")), structure(c(2.23564,
7.8688698), class = c("XY", "POINT", "sfg")), structure(c(29.5,
-18.75), class = c("XY", "POINT", "sfg")), structure(c(36.803509,
-14.32926), class = c("XY", "POINT", "sfg")), structure(c(25.883329,
-24.48333), class = c("XY", "POINT", "sfg")), structure(c(26.987329,
-16.688841), class = c("XY", "POINT", "sfg")), structure(c(25.636339,
-33.974258), class = c("XY", "POINT", "sfg")), structure(c(-11.133,
6.8152399), class = c("XY", "POINT", "sfg")), structure(c(35.416672,
-4.1500001), class = c("XY", "POINT", "sfg")), structure(c(28.75,
-30), class = c("XY", "POINT", "sfg")), structure(c(57.633331,
-20.41667), class = c("XY", "POINT", "sfg")), structure(c(33.5,
-3.6666701), class = c("XY", "POINT", "sfg")), structure(c(35.27496,
-0.56010997), class = c("XY", "POINT", "sfg")), structure(c(3.30757,
6.63937), class = c("XY", "POINT", "sfg")), structure(c(-13.647,
13.605), class = c("XY", "POINT", "sfg")), structure(c(32.209759,
-2.80952), class = c("XY", "POINT", "sfg")), structure(c(36.71236,
1.78276), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = -23.522779,
ymin = -33.974258, xmax = 57.633331, ymax = 14.91389), class = "bbox"), crs = structure(list(
input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\",\n ENSEMBLE[\"World Geodetic System 1984 ensemble\",\n MEMBER[\"World Geodetic System 1984 (Transit)\"],\n MEMBER[\"World Geodetic System 1984 (G730)\"],\n MEMBER[\"World Geodetic System 1984 (G873)\"],\n MEMBER[\"World Geodetic System 1984 (G1150)\"],\n MEMBER[\"World Geodetic System 1984 (G1674)\"],\n MEMBER[\"World Geodetic System 1984 (G1762)\"],\n MEMBER[\"World Geodetic System 1984 (G2139)\"],\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]],\n ENSEMBLEACCURACY[2.0]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"geodetic latitude (Lat)\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"geodetic longitude (Lon)\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n USAGE[\n SCOPE[\"Horizontal component of 3D system.\"],\n AREA[\"World.\"],\n BBOX[-90,-180,90,180]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), row.names = c(NA,
-30L), class = c("sf", "tbl_df", "tbl", "data.frame"), sf_column = "geometry", agr = structure(c(year = NA_integer_), levels = c("constant",
"aggregate", "identity"), class = "factor"))
Each observation from R36_loc should show the distance to the nearest observation in mining_loc on year prior in a new variable.
The first error I get, I think, is due to some years not having any observations (Error in UseMethod("st_as_sfc") : no applicable method for 'st_as_sfc' applied to an object of class "NULL").
When I only loop through existing years I get
Error:
! Assigned data `value` must be compatible with existing data.
✖ Existing data has 7207 rows.
✖ Assigned data has 352800 rows.
ℹ Only vectors of size 1 are recycled.
Backtrace:
1. base::`$<-`(`*tmp*`, nearest, value = `<GEOMETRY [°]>`)
19. tibble (local) `<fn>`(`<vctrs___>`)"
I found a way to do this using the RANN package.
I start by extracting the geometry to long and lat columns and converting my data frame to a list of data frames by year:
R36_loc2 <- R36_loc %>% ungroup() %>% mutate(long = unlist(map(.$geometry,1)),
lat = unlist(map(.$geometry,2)))
st_geometry(R36_loc2) <- NULL
AB_by_year <- split(R36_loc2, f = R36_loc$year)
Since, for the second data frame, I need the observations from a year prior, I create a new year variable merge_year and also transform the data into a list by the new variable:
mining_loc$merge_year <- mining_loc$year - 1
# make list of data by merging year
mining_by_year <- split(mining_loc, f = mining_loc$merge_year)
# make ID var
mining_by_year <- mining_by_year %>% lapply(function(x) {x %>% rowid_to_column("ID")})
I then loop through the years and look for closest mine to each observation in each year - merge_year - combination, then add two new columns [ , c(43,44)] to each year data frame in the AB-list of data frames.
The two columns will indicate the ID of closest mine to each observation in the corresponding year-dataframe in the mining_list, called nn.idx, and the distance, called nn.dists.
for(x in wave_years) {
AB_by_year[[as.character(x)]][ , c(43,44)] <- as.data.frame(RANN::nn2(mining_by_year[[as.character(x)]][,c("lat", "long")], AB_by_year[[as.character(x)]][,c("lat", "long")], k=1)
)
}
I then check if it worked, by creating maps that connect the observations to the mines.
I first create a list for the lines to nearest mine
lines_list <- vector(mode = "list", length = length(wave_years))
names(lines_list) <- wave_years
I joint the observations with each nearest mine coordinates
for(x in wave_years) {
lines_list[[as.character(x)]] <- left_join(AB_by_year[[as.character(x)]], mining_by_year[[as.character(x)]], by = c("nn.idx" = "ID"))
}
I then need to convert the list back to a data frame:
lines <- do.call(rbind.data.frame, lines_list)
and now I follow the approach of: Connecting two sets of coordinates to create lines using sf/mapview
b = lines[, c("long.x", "lat.x")]
names(b) = c("long", "lat")
e = lines[, c("long.y", "lat.y")]
names(e) = c("long", "lat")
lines$geometry = do.call(
"c",
lapply(seq(nrow(b)), function(i) {
st_sfc(
st_linestring(
as.matrix(
rbind(b[i, ], e[i, ])
)
),
crs = 4326
)
}))
Finally, I want to show graphically, that the code worked by first converting the data into sf-objects
mining_loc_geo <- st_as_sf(mining_loc, coords = c("long", "lat"), crs = 4326)
R36_loc_geo <- st_as_sf(R36_loc, coords = c("long", "lat"), crs = 4326)
and then plotting them with ggplot.
ggplot() + geom_sf(data = boundaries_africa3, aes()) + geom_sf(data = R36_loc_geo %>% filter(year == 2005), color = "blue", aes(geometry = geometry)) + geom_sf(data = mining_loc_geo %>% filter(merge_year == 2005), color = "red", aes(geometry = geometry)) + geom_sf(data = lines %>% filter(year.x == 2005), aes(geometry = geometry))
The object boundaries_africa3 is an underlying map.
I'd like to create sort of levitating objects with rayshader, but I don't know how to do so.
Here's an example:
test <- structure(list(id = c(1, 2), hauteur = c(10, 20), geometry = structure(list(
structure(list(structure(c(-1.36168948095423, -1.36169305908512,
-1.36002570022701, -1.36004117161482, -1.35912195131564,
-1.35914242955086, -1.35844923534243, -1.35839833680255,
-1.36168948095423, -5.9860092862187, -5.98515370941195, -5.98506767037104,
-5.98478743024393, -5.98471158140101, -5.98501879708984,
-5.98503042065794, -5.98583965411611, -5.9860092862187), .Dim = c(9L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(-1.36155282525813, -1.36162688579707, -1.36039531642929,
-1.36034993206991, -1.35927629531794, -1.35922529091398,
-1.35867417902484, -1.35873070423009, -1.36155282525813,
-5.98803180168874, -5.98714267345713, -5.98707450596375,
-5.98665348482721, -5.98666278591778, -5.98713469051296,
-5.9872853456686, -5.98795683043924, -5.98803180168874
), .Dim = c(9L, 2L))), class = c("XY", "POLYGON", "sfg"
))), n_empty = 0L, crs = structure(list(input = "WGS 84",
wkt = "GEOGCRS[\"WGS 84\",\n DATUM[\"World Geodetic System 1984\",\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"latitude\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"longitude\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4326]]"), class = "crs"), class = c("sfc_POLYGON",
"sfc"), precision = 0, bbox = structure(c(xmin = -1.36169305908512,
ymin = -5.98803180168874, xmax = -1.35839833680255, ymax = -5.98471158140101
), class = "bbox"))), row.names = c(NA, -2L), class = c("sf",
"data.frame"), sf_column = "geometry", agr = structure(c(id = NA_integer_,
hauteur = NA_integer_), class = "factor", .Label = c("constant",
"aggregate", "identity")))
Code:
library(ggplot2)
library(rayshader)
metro <- ggplot(test, aes(fill = hauteur)) +
geom_sf() +
theme_bw()
plot_gg(metro)
As you can see in the rayshader plot, the height dimension starts at 10 while I'd like it to strart from another level, such as 15 for example, so it give the impression one of the two object is flying, while the other is still "on the ground".
Thanks for your help!
I have a fairly simple problem where I want to create a gif which loops through departure_hour and colors the lines based on link volumes. One caveat is the number of rows between states (i.e. departure_hour) may be different.
Here is the code I am trying:
vol <- ggplot() +
geom_sf(data = test, aes(color=link_volume)) +
scale_color_distiller(palette = "OrRd", direction = 1) +
ggtitle("{frame_time}") +
transition_time(departure_hour) +
ease_aes("linear") +
enter_fade() +
exit_fade()
animate(vol, fps = 10, width = 750, height = 450)
However, when I do this I am getting the error:
Error in tween_state(as.data.frame(full_set$from), as.data.frame(full_set$to),:
identical(classes, col_classes(to)) is not TRUE
First, I do not understand if the error is referring to column classes or color classes? If it is color classes am I correct in assuming that the color scales between each plot may be different and that is the reason for this error?
Second, how do I fix this error? There seems to be just one more question on this issue and it has no solution.
Sample data:
> dput(head(test,5))
structure(list(linkid = c(12698L, 26221L, 36429L, 36430L, 47315L
), departure_hour = c(14, 19, 11, 0, 18), link_volume = c(500L,
1550L, 350L, 100L, 550L), geometry = structure(list(structure(c(1065088.71736072,
1065084.18813218, 1253892.13487564, 1253935.59094818), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1060907.62521458,
1060984.50834787, 1237578.71728528, 1237818.59111698), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1062955.36965935, 1241210.04281066, 1241498.76584417), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1063034.73081084, 1241210.04281066, 1241198.98905491), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1058112.52771678,
1058131.02887377, 1236388.96345761, 1236342.13157851), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg"))), class = c("sfc_LINESTRING",
"sfc"), precision = 0, bbox = structure(c(xmin = 1058112.52771678,
ymin = 1236342.13157851, xmax = 1065088.71736072, ymax = 1253935.59094818
), class = "bbox"), crs = structure(list(epsg = 5070L, proj4string = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(linkid = NA_integer_,
departure_hour = NA_integer_, link_volume = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), row.names = c(NA,
5L), class = c("sf", "data.table", "data.frame"))
I'm attempting to pro-grammatically add multiple vertical polylines of specific length to contiguous polygons in R. The number and length of the polylines should be specified by the user and can range from 1 to 8 polylines and 5000 to 10000 feet long per contiguous polygons. How can I achieve this in R?
I'm able to do this manually by the use of the mapedit package for a couple of polygons but I would like to automate the process for several thousand contiguous polygons.
# Load required libraries
library(mapedit)
library(mapview)
library(dplyr)
library(sp)
# Sample polygons and polylines
geometry = structure(list(structure(list(structure(c(8.769563, 8.769563,
8.770507, 8.770507, 8.769563, 50.815273, 50.815714, 50.815714,
50.815273, 50.815273), .Dim = c(5L, 2L))), class = c("XY", "POLYGON",
"sfg")), structure(list(structure(c(8.769568, 8.769568, 8.770507,
8.770507, 8.769568, 50.814852, 50.81527, 50.81527, 50.814852,
50.814852), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.769568, 8.769568, 8.770502,
8.770502, 8.769568, 50.814412, 50.814849, 50.814849, 50.814412,
50.814412), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.769568, 8.769568, 8.770502,
8.770502, 8.769568, 50.814005, 50.814408, 50.814408, 50.814005,
50.814005), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770502, 8.770502, 8.771301,
8.771301, 8.770502, 50.815273, 50.815717, 50.815717, 50.815273,
50.815273), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770518, 8.770518, 8.771301,
8.771301, 8.770518, 50.814852, 50.81527, 50.81527, 50.814852,
50.814852), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770507, 8.770507, 8.771301,
8.771301, 8.770507, 50.814408, 50.814849, 50.814849, 50.814408,
50.814408), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770507, 8.770507, 8.771296,
8.771296, 8.770507, 50.814005, 50.814405, 50.814405, 50.814005,
50.814005), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(c(8.769794, 8.769783, 50.814785, 50.814076), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(8.770051,
8.770035, 50.814785, 50.814069), .Dim = c(2L, 2L), class = c("XY",
"LINESTRING", "sfg")), structure(c(8.770271, 8.77026, 50.814781,
50.814076), .Dim = c(2L, 2L), class = c("XY", "LINESTRING", "sfg"
))), class = c("sfc_GEOMETRY", "sfc"), precision = 0, bbox = structure(c(xmin = 8.769563,
ymin = 50.814005, xmax = 8.771301, ymax = 50.815717), class = "bbox"), crs = structure(list(
epsg = 4326L, proj4string = "+proj=longlat +datum=WGS84 +no_defs"), class = "crs"), classes = c("POLYGON",
"POLYGON", "POLYGON", "POLYGON", "POLYGON", "POLYGON", "POLYGON",
"POLYGON", "LINESTRING", "LINESTRING", "LINESTRING"), n_empty = 0L)
# Visualize geometry
mapview(geometry)
I attempted to create regularly sampled points via the spsample function inside the polygons and connecting them by lines but was unsuccessful. appreciate any help I can get.
Here's one way to create lines given a polygon. It's probably not exactly what you want, since your request is quite specific, but hopefully the code is generic enough that you cn adapt it.
library(sf)
library(purrr)
polygon <- st_polygon(list(matrix(c(1,1,2,2,1,1,0,0,1,1), ncol = 2)))
# use polygon bounding box to o compute line parameters
bb <- st_bbox(polygon)
number_of_lines <- 5
line_length <- (bb[["ymax"]] - bb[["ymin"]]) / 1.2
y_offset <- bb[["ymin"]] + (bb[["ymax"]] - bb[["ymin"]] - line_length) / 2
# compute coordinates
xs <- seq(bb[["xmin"]], bb[["xmax"]], length.out = number_of_lines)
ys <- bb[["ymin"]] + line_length
# create a linestring
lines <- purrr::map2(xs, ys, ~st_linestring(matrix(c(.x, .x, .y,y_offset), ncol = 2))) %>% st_sfc(crs = st_crs(polygon))
# view
plot(polygon)
plot(lines, col = 2, add = TRUE)
I have the following map of Mexico. It shows all of its municipalities and around 400 weather stations.
I want to create a 10km buffer around each station and eventually, associate each municipality to a station that is located within each radius.
The map and the stations are stored on separate sf objects. I tired the following:
buffers <- st_buffer(stations, dist = 1)
I thought the dist argument was set to kilometers, so I tried dist = 10. Unfortunately, this returned HUGE buffers for each station. That's why I am using dist = 1, but even these buffers are as big as a state! This question, suggests I transform my stations to Irish Grid, but I couldn't replicate the accepted answer. I am now wondering what unit the dist argument is set to.
From the aforementioned question, I assume it's set to degrees. How can I set a 10km buffer around each station?
Additional info:
My CRS is set to 4326 on both objects (the Mexican map and the stations).
This is my stations data:
> dput(head(stations))
structure(list(station_number = c(1004L, 1005L, 1008L, 1012L,
1017L, 1018L), station_alt = c(1925, 1844, 2323, 1589, 2172,
2053), month = c(9L, 9L, 9L, 9L, 9L, 9L), Mean_min = c(11.6,
12.75, 12.25, 13.9666666666667, 12.9, 12.6833333333333), Mean_max = c(26.9333333333333,
26.85, 24.0833333333333, 29.0333333333333, 24.8666666666667,
26.1333333333333), months_observed = c(5L, 5L, 5L, 5L, 5L, 5L
), geometry = structure(list(structure(c(-102.199, 22.001), class = c("XY",
"POINT", "sfg")), structure(c(-102.372, 21.781), class = c("XY",
"POINT", "sfg")), structure(c(-102.135, 22.203), class = c("XY",
"POINT", "sfg")), structure(c(-102.802, 21.794), class = c("XY",
"POINT", "sfg")), structure(c(-102.444, 22.233), class = c("XY",
"POINT", "sfg")), structure(c(-102.415, 22.141), class = c("XY",
"POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = -102.802,
ymin = 21.781, xmax = -102.135, ymax = 22.233), class = "bbox"), crs = structure(list(
epsg = NA_integer_, proj4string = NA_character_), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(station_number = NA_integer_,
station_alt = NA_integer_, month = NA_integer_, Mean_min = NA_integer_,
Mean_max = NA_integer_, months_observed = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), row.names = c(NA,
6L), class = c("sf", "data.frame"))
Your coordinates are long/lat, so the distance will be in degrees. You should first project to a spatial reference in meter units and then take 10 000 meters.
The manual of st_buffer says this about the dist argument:
in case dist is a units object, it should be convertible to
arc_degree if x has geographic coordinates, and to st_crs(x)$units
otherwise
If you leave the coordinates in 4326 you should be able to take something like 0.1 which should be about 11 km for Mexico, but you will see a warning message:
In st_buffer.sfc(st_geometry(x), dist, nQuadSegs, endCapStyle =
endCapStyle, : st_buffer does not correctly buffer
longitude/latitude data
So first convert to another projection (in meter) and enter the distance in meters. This should work, which uses EPSG 7801:
library(sf)
pois <- st_as_sf(stations)
st_crs(pois) <- 4326
pois <- st_transform(pois, crs = 7801)
plot(st_geometry(pois))
buff <- st_buffer(pois, dist = 10000)
plot(st_geometry(buff), add = TRUE)
Control with leaflet and the measure tool:
buff <- st_transform(buff, crs = 4326)
library(leaflet)
leaflet() %>%
addTiles() %>%
addMeasure(primaryLengthUnit = "meters") %>%
addMarkers(data = pois) %>%
addPolygons(data = buff)