How to set maximum radius of polygon - r

Question

I draw a map in which points are represented as polygons. The points are found close to a southern state border. The code is:
library(leaflet)
library(sf)
long <- c( 4.676119175, 4.53172103 , 4.939782877, 5.074127987, 5.072757119)
lat <- c(51.477299959, 51.589766239, 51.624436295, 51.520707997, 51.631483055)
labs <- c("A", "B", "C", "D", "E")
colors <- rainbow(length(labs))
df <- data.frame(ID = labs, X = long, Y = lat)
points <- st_geometry(st_as_sf(df, coords = c("X", "Y")))
points0 <- st_set_crs(points, 4326)
area <- rnaturalearth::ne_countries(country = c('netherlands'), scale = 'large', returnclass = 'sf')
polys <- points %>% st_union() %>% st_voronoi() %>% st_cast() %>% st_set_crs(., 4326)
polys <- polys[unlist(st_intersects(points0, polys))] %>% st_intersection(y = area)
leaflet() %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addPolygons (data = polys,
fillColor = colors,
fillOpacity = 1,
weight = 0.5,
color = "black") %>%
addCircleMarkers(lng = long,
lat = lat,
label = labs,
color = "black",
radius = 5,
weight = 1,
fill = TRUE,
fillColor = colors,
fillOpacity = 1)
The results looks like this:
The problem is that the polygons get stretched out to the north way to much. This may be solved by setting a bounding box, but I would prefer to solve this by setting a maximum size (or radius) for the polygons. How exactly can I set the maximum radius?

Answer 1

I suggest adding another call of sf::st_intersection() with an object of buffered points.
You have two alternatives:
intersect with a buffer of a single lab - number C seems a good candidate, as it is placed in the middle
intersect with pairwise buffers of each lab; purrr:map2() will be your friend here for pairwise intersection
I find the results of a single intersection more visually pleasing, but this may be not the most important factor so make your own choice...
As a comment: my natural earth is a bit buggy at the moment, so I am using GISCO by Eurostat as a source of map of the Netherlands instead; in a high resolution because I really dig the tiny exclaves of Belgium...
library(leaflet)
library(rnaturalearth)
library(sf)
long <- c( 4.676119175, 4.53172103 , 4.939782877, 5.074127987, 5.072757119)
lat <- c(51.477299959, 51.589766239, 51.624436295, 51.520707997, 51.631483055)
labs <- c("A", "B", "C", "D", "E")
colors <- rainbow(length(labs))
points <- data.frame(ID = labs, X = long, Y = lat) %>%
st_as_sf(coords = c("X", "Y"), crs = 4326) %>%
mutate(ID = ordered(ID))
area <- giscoR::gisco_get_countries(country = "NL", resolution = "01") # my Natural Earth is buggy at the momemt
# intersection with a single buffer around C
polys <- points %>%
st_union() %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326) %>%
st_intersection(area) %>%
st_intersection(st_buffer(dplyr::filter(points, ID == "C"), units::as_units(30000, "m"))) %>%
st_as_sf() %>%
st_join(points) # add back labs id's
palette <- colorFactor(palette = colors,
domain = polys$ID)
leaflet(data = polys) %>%
addProviderTiles("Esri.WorldGrayCanvas") %>%
addPolygons(fillColor = ~palette(ID),
stroke = F) %>%
addCircleMarkers(data = points,
fillColor = ~palette(ID),
stroke = F,
fillOpacity = 1)
# intersection with pairwise buffers
polys <- points %>%
st_union() %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326) %>%
st_intersection(area) %>%
purrr::map2(st_geometry(st_buffer(points, units::as_units(30000, "m"))), st_intersection) %>%
st_as_sfc(crs = 4326) %>%
st_as_sf() %>%
st_join(points) # add back labs id's
mapview::mapview(polys)