Automatic Label Placement for GIS maps in R - r

I'm making GIS maps in R using the sf package (and related packages) to read in shapefiles, and ggplot2 (and friends) for plotting. This works fine, but I can find no way to (automatically/programmatically) create label placements for features such as rivers and roads. These features are typically linestrings, with irregular shapes. See image attached for example from wikimedia.
The ggrepel package works well for labeling points in an automated way, but this doesn't make much sense for other geographic features that aren't discrete Lat/Long points.
I could imagine doing this by placing individual text labels on each feature individually, but I'm looking for something more automated, if possible. I realize such automation isn't a trivial problem, but it's been solved before (ArcGIS apparently has a way of doing this with an extension called maplex, but I don't have access to the software, and I'd like to stay in R if possible).
Does anyone know of a way of doing this?
MWE here:
#MWE Linestring labeling
library(tidyverse)
library(sf)
library(ggrepel)
set.seed(120)
#pick a county from the built-in North Carolina dataset
BuncombeCounty <- st_read(system.file("shapes/", package="maptools"), "sids") %>%
filter(NAME == "Buncombe")
#pick 4 random points in that county
pts_sf <- data.frame(
x = seq(-82.3, -82.7, by=-0.1) %>%
sample(4),
y = seq(35.5, 35.7, by=0.05) %>%
sample(4),
placenames = c("A", "B", "C", "D")
) %>%
st_as_sf(coords = c("x","y"))
#link those points into a linestring
linestring_sf <- pts_sf %>%
st_coordinates() %>%
st_linestring()
st_cast("LINESTRING")
#plot them with labels, using geom_text_repel() from the `ggrepel` package
ggplot() +
geom_sf(data = BuncombeCounty) +
geom_sf(data = linestring_sf) +
geom_label_repel(data = pts_sf,
stat = "sf_coordinates",
aes(geometry = geometry,
label = placenames),
nudge_y = 0.05,
label.r = 0, #don't round corners of label boxes
min.segment.length = 0,
segment.size = 0.4,
segment.color = "dodgerblue")

I think I have something that might work for you. I've taken the liberty of changing your example to something a bit more realistic: a couple of random "rivers" made with smoothed random walks, each 100 points long:
library(tidyverse)
library(sf)
library(ggrepel)
BuncombeCounty <- st_read(system.file("shapes/", package = "maptools"), "sids") %>%
filter(NAME == "Buncombe")
set.seed(120)
x1 <- seq(-82.795, -82.285, length.out = 100)
y1 <- cumsum(runif(100, -.01, .01))
y1 <- predict(loess(y1 ~ x1, span = 0.1)) + 35.6
x2 <- x1 + 0.02
y2 <- cumsum(runif(100, -.01, .01))
y2 <- predict(loess(y2 ~ x2, span = 0.1)) + 35.57
river_1 <- data.frame(x = x1, y = y1) %>%
st_as_sf(coords = c("x", "y")) %>%
st_coordinates() %>%
st_linestring() %>%
st_cast("LINESTRING")
river_2 <- data.frame(x = x2, y = y2) %>%
st_as_sf(coords = c("x", "y")) %>%
st_coordinates() %>%
st_linestring() %>%
st_cast("LINESTRING")
We can plot them as per your example:
riverplot <- ggplot() +
geom_sf(data = BuncombeCounty) +
geom_sf(data = river_1, colour = "blue", size = 2) +
geom_sf(data = river_2, colour = "blue", size = 2)
riverplot
My solution is basically to extract points from the linestrings and label them. Like the picture at the top of your question, you might want multiple copies of each label along the length of the linestring, so if you want n labels you just extract n equally-spaced points.
Of course, you want to be able to label both rivers at once without the labels clashing, so you'll need to be able to pass multiple geographical features as a named list.
Here is a function that does all that:
linestring_labels <- function(linestrings, n)
{
do.call(rbind, mapply(function(linestring, label)
{
n_points <- length(linestring)/2
distance <- round(n_points / (n + 1))
data.frame(x = linestring[1:n * distance],
y = linestring[1:n * distance + n_points],
label = rep(label, n))
}, linestrings, names(linestrings), SIMPLIFY = FALSE)) %>%
st_as_sf(coords = c("x","y"))
}
So if we put the objects we want to label in a named list like this:
river_list <- list("River 1" = river_1, "River 2" = river_2)
Then we can do this:
riverplot +
geom_label_repel(data = linestring_labels(river_list, 3),
stat = "sf_coordinates",
aes(geometry = geometry, label = label),
nudge_y = 0.05,
label.r = 0, #don't round corners of label boxes
min.segment.length = 0,
segment.size = 0.4,
segment.color = "dodgerblue")

It's now much easier to do this using the geomtextpath package. Using the same example data as above, we can now do:
library(geomtextpath)
ggplot() +
geom_sf(data = BuncombeCounty, fill = "#DADABA") +
geom_textsf(data = river_1, size = 4, vjust = -1, text_smoothing = 30,
label = paste(rep("River 1", 3), collapse = "\t\t\t\t\t\t\t\t"),
linecolour = "blue3") +
geom_textsf(data = river_2, size = 4, vjust = -0.5, text_smoothing = 30,
label = paste(rep("River 2", 3), collapse = "\t\t\t\t\t\t\t\t"),
linecolour = "blue3")

Related

Avoid overlap of points on a timeline (1-D repeling)

I want to create a timeline plot that roughly resembles the example below: lots of overlap at some points, not a lot of overlap at others.
What I need: overlapping images should repel each other where necessary, eliminating or reducing overlap. Ideally I'd be able to implement either a vertical or horizontal repel.
library(tidyverse)
library(ggimage)
test_img <- list.files(system.file("extdata", package="ggimage"), pattern="png", full.names=TRUE)
set.seed(123)
df <-
tibble(date = as.Date(paste0("2020-", round(runif(45, 1, 2)), "-", round(runif(45, 1, 10)))),
group = paste0("Timeline ", rep(1:9, each = 5)),
img = sample(test_img, size = 45, replace = T) )
df %>%
ggplot() +
geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
geom_image(aes(x = date, y = group, image = img, group = group), asp = 1)
Something similar to the repelling in ggbeeswarm::geom_beeswarm or ggrepel::geom_text_repel would be nice, but those don't support images. So I think I need to pre-apply some kind of 1-dimensional packing algorithm, implementing iterative pair-wise repulsion on my vector of dates within each group, to try to find a non-overlapping arrangement.
Any ideas? Thank you so much!
Created on 2021-10-30 by the reprex package (v2.0.1)
Here is the solution I’ve been able to come up with, repurposing the circleRepelLayout function from the awesome packcircles package
into the repel_vector vector function that takes in your overlapping vector and a "repel_radius", and returns, if possible, a non-overlapping version.
I demonstrate the solution with the richtext geom since this is a geom I’ve always wished had repel functionality.
library(packcircles)
library(tidyverse)
library(ggtext)
library(ggimage)
repel_vector <- function(vector, repel_radius = 1, repel_bounds = range(vector)){
stopifnot(is.numeric(vector))
repelled_vector <-
packcircles::circleRepelLayout(x = data.frame(vector, ypos = 1, repel_radius),
xysizecols = c("vector", "ypos", "repel_radius"),
xlim = repel_bounds, ylim = c(0,1),
wrap = FALSE) %>%
as.data.frame() %>%
.$layout.x
return(repelled_vector)
}
overlapping_vec <- c(1, 1.1, 1.2, 10, 10.1, 10.2)
repelled_vec_default <- repel_vector(overlapping_vec)
repelled_vec_tighter <- repel_vector(overlapping_vec, repel_radius = 0.35)
ggplot() +
annotate("richtext", x = overlapping_vec, y = 3, label = "**test**", alpha = 0.5) +
annotate("richtext", x = repelled_vec_default, y = 2, label = "**test**", alpha = 0.5) +
annotate("richtext", x = repelled_vec_tighter, y = 1, label = "**test**", alpha = 0.5) +
scale_y_continuous(breaks = 1:3, labels = c("Tighter repel", "Default repel", "Overlapping points"))
In theory you apply this to 2D repelling as well.
To solve the problem in my question, this can be applied like so:
test_img <- list.files(system.file("extdata", package="ggimage"), pattern="png", full.names=TRUE)
set.seed(123)
df <-
tibble(date = as.Date(paste0("2020-", round(runif(45, 1, 2)), "-", round(runif(45, 1, 10)))),
group = paste0("Timeline ", rep(1:9, each = 5)),
img = sample(test_img, size = 45, replace = T) ) %>%
group_by(group) %>%
mutate(repelled_date = repel_vector(as.numeric(date),
repel_radius = 4,
repel_bounds = range(as.numeric(date)) + c(-3,3)),
repelled_date = as.Date(repelled_date, origin = "1970-01-01"))
df %>%
ggplot() +
geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
geom_image(aes(x = repelled_date, y = group, image = img, group = group), asp = 1)
Created on 2021-10-30 by the reprex package (v2.0.1)

How do I draw directed arrows based on one ordered list in R?

So, I have a data frame in R with node number and Lat, Long of different points.
Sample data for it:
library(tidyverse)
set.seed(4)
node <- seq(1, 10)
lat <- runif(10, 77, 78)
long <- runif(10, 22, 23)
df <- data.frame(node, lat, long)
ggplot()+
geom_point(aes(x=long, y=lat))+
geom_text(aes(x=long, y=lat, label=node), size=5)
[
Now I have a list with the routes like this:
route <- c(1,6,2,3,1,10,4,1,5,8,1,3,7,1)
Based on the order of the route, I want to draw arrows on the previous plot, so that it will look something like this:
How can it be done? I could use geom_path but it will give the order based on the order of the data frame. Also if different colours can be added for the different routes like 1->6->2->3->1 in one colour, 1->5->8->1 in another then it will be better. But at the time the arrow can be sufficient.
One minor change made to route (includes 9):
route <- c(1,6,2,3,1,10,4,1,5,8,1,9,7,1)
Try creating a data.frame of segments - this will allow you customize in greater detail, including color. The data.frame should have start and end values for longitude, latitude.
df_seg <- data.frame(
lat1 = df$lat[route[-length(route)]],
long1 = df$long[route[-length(route)]],
lat2 = df$lat[route[2:length(route)]],
long2 = df$long[route[2:length(route)]],
color = c(rep("blue", 4), rep("green", 3), rep("red", 3), rep("purple", 3))
)
Then you can use geom_segment referencing this data.frame:
ggplot()+
geom_point(aes(x=long, y=lat))+
geom_text(aes(x=long, y=lat, label=node), size=5) +
geom_segment(data = df_seg,
aes(x = long1, y = lat1, xend = long2, yend = lat2),
arrow = arrow(angle = 12, type = "closed"),
linetype = 1,
color = df_seg$color)
Plot
I came up with a very similar answer to the one Ben provided, just with a more flexible way of defining the coloring groups whenever the start position is 1 (this part could probably be a one liner, but I couldn't figure it out quickly) and using joins to get the start and end segment positions.
Your code with the amended route:
library(tidyverse)
set.seed(4)
node <- seq(1, 10)
lat <- runif(10, 77, 78)
long <- runif(10, 22, 23)
df <- data.frame(node, lat, long)
route <- c(1,6,2,3,1,10,4,1,5,8,1,9,7,1)
Creating the segment dataframe:
df2 = tibble(start = route, end = route[c(2:length(route), 1)]) %>%
filter(start != end) %>%
left_join(df, by = c("start" = "node")) %>%
left_join(df, by = c("end" = "node"), suffix = c("_start", "_end")) %>%
mutate(temp_coloring = if_else(start == 1, 1, 0)) %>%
mutate(coloring = if_else(temp_coloring == 1, cumsum(temp_coloring), NA_real_)) %>%
fill(coloring) %>%
select(-temp_coloring) %>%
mutate(coloring = as_factor(coloring))
Plotting:
df %>%
ggplot()+
geom_point(aes(x=long, y=lat))+
geom_text(aes(x=long, y=lat, label=node), size=5) +
geom_segment(data = df2 , aes(x = long_start, y = lat_start, xend = long_end, yend = lat_end, color = coloring),
arrow = arrow(length = unit(0.1, "inches")))

Simulate a two-dimensional random walk in a grid in R and plot with ggplot

I was looking for a simple code that could simulate a two-dimensional random walk in a grid (using R), and then plot the data using ggplot.
In particular, I was interested to a random walk from few position (5 points) in a 2D grid to the center of the square grid. It is just for visualisation purposes.
And my idea was then to plot the results with ggplot on a discrete grid (as the one simulated), may be using the function geom_tile.
Do you have any suggestion for a pre-existing code that I could easily manipulate?
Here is a small example with a for loop. From here, you can simply adjust how X_t and Y_t are defined:
Xt = 0; Yt = 0
for (i in 2:1000)
{
Xt[i] = Xt[i-1] + rnorm(1,0,1)
Yt[i] = Yt[i-1] + rnorm(1,0,1)
}
df <- data.frame(x = Xt, y = Yt)
ggplot(df, aes(x=x, y=y)) + geom_path() + theme_classic() + coord_fixed(1)
EDIT ----
After chatting with OP I've revised the code to include a step probability. This may result in the walk being stationary much more frequently. In higher dimensions, you will need to scale your prob factor lower in order to compensate for more options.
finally, my function does not account for an absolute distance, it only considers points on the grid that are within a certain step size in all dimensions. For example, hypothetically, at position c(0,0) you could go to c(1,1) with this function. But I guess this is relative to the grid's connectiveness.
If the OP wants to only consider nodes that are within 1 (by distance) of the current position, then use the following version of move_step()
move_step <- function(cur_pos, grid, prob = 0.04, size = 1){
opts <- grid %>%
rowwise() %>%
mutate(across(.fns = ~(.x-.env$cur_pos[[cur_column()]])^2,
.names = '{.col}_square_diff')) %>%
filter(sqrt(sum(c_across(ends_with("_square_diff"))))<=.env$size) %>%
select(-ends_with("_square_diff")) %>%
left_join(y = mutate(cur_pos, current = TRUE), by = names(grid))
new_pos <- opts %>%
mutate(weight = case_when(current ~ 1-(prob*(n()-1)), #calculate chance to move,
TRUE ~ prob), #in higher dimensions, we may have more places to move
weight = if_else(weight<0, 0, weight)) %>% #thus depending on prob, we may always move.
sample_n(size = 1, weight = weight) %>%
select(-weight, -current)
new_pos
}
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(ggplot2)
library(gganimate)
move_step <- function(cur_pos, grid, prob = 0.04, size = 1){
opts <- grid %>%
filter(across(.fns = ~ between(.x, .env$cur_pos[[cur_column()]]-.env$size, .env$cur_pos[[cur_column()]]+.env$size))) %>%
left_join(y = mutate(cur_pos, current = TRUE), by = names(grid))
new_pos <- opts %>%
mutate(weight = case_when(current ~ 1-(prob*(n()-1)), #calculate chance to move,
TRUE ~ prob), #in higher dimensions, we may have more places to move
weight = if_else(weight<0, 0, weight)) %>% #thus depending on prob, we may always move.
sample_n(size = 1, weight = weight) %>%
select(-weight, -current)
new_pos
}
sim_walk <- function(cur_pos, grid, grid_prob = 0.04, steps = 50, size = 1){
iterations <- cur_pos
for(i in seq_len(steps)){
cur_pos <- move_step(cur_pos, grid, prob = grid_prob, size = size)
iterations <- bind_rows(iterations, cur_pos)
}
iterations$i <- 1:nrow(iterations)
iterations
}
origin <- data.frame(x = 0, y =0)
small_grid <- expand.grid(x = -1:1, y = -1:1)
small_walk <- sim_walk(cur_pos = origin,
grid = small_grid)
ggplot(small_walk, aes(x, y)) +
geom_path() +
geom_point(color = "red") +
transition_reveal(i) +
labs(title = "Step {frame_along}") +
coord_fixed()
large_grid <- expand.grid(x = -10:10, y = -10:10)
large_walk <- sim_walk(cur_pos = origin,
grid = large_grid,
steps = 100)
ggplot(large_walk, aes(x,y)) +
geom_path() +
geom_point(color = "red") +
transition_reveal(i) +
labs(title = "Step {frame_along}") +
xlim(c(-10,10)) + ylim(c(-10,10))+
coord_fixed()
large_walk %>%
count(x, y) %>%
right_join(y = expand.grid(x = -10:10, y = -10:10), by = c("x","y")) %>%
mutate(n = if_else(is.na(n), 0L, n)) %>%
ggplot(aes(x,y)) +
geom_tile(aes(fill = n)) +
coord_fixed()
multi_dim_walk <- sim_walk(cur_pos = data.frame(x = 0, y = 0, z = 0),
grid = expand.grid(x = -20:20, y = -20:20, z = -20:20),
steps = 100, size = 2)
library(cowplot)
plot_grid(
ggplot(multi_dim_walk, aes(x, y)) + geom_path(),
ggplot(multi_dim_walk, aes(x, z)) + geom_path(),
ggplot(multi_dim_walk, aes(y, z)) + geom_path())
Created on 2021-05-06 by the reprex package (v1.0.0)
Here is a base R option using Reduce + replicate + plot for 2D random walk process
set.seed(0)
plot(
setNames(
data.frame(replicate(
2,
Reduce(`+`, rnorm(99), init = 0, accumulate = TRUE)
)),
c("X", "Y")
),
type = "o"
)

Make grid map from spatial data

I have spatial coordinates in a data frame where each row (Longitude, Latitude) corresponds to the occurrence of an event I am following. I tried to map these data but instead of using points, I want to create a grid with cells of a resolution of 5 nautical miles (~ 0.083333) and count the number of occurrences of the event is each cell and plot it.
This is the code I came to write with the help of some resources. But it doesn't look the way I expected it to be. Can you figure out what's I'm doing wrong? I attached the raw positions and the resulting map I get.
Here is the link to the data.
re_pi = read.csv(file = "~/Desktop/Events.csv")
gridx <- seq(from=-19,to=-10,by=0.083333)
gridy <- seq(from=20,to=29,by=0.083333)
xcell <- unlist(lapply(re_pi$LON,function(x) min(which(gridx>x))))
ycell <- unlist(lapply(re_pi$LAT,function(y) min(which(gridy>y))))
re_pi$cell <- (length(gridx) - 1) * ycell + xcell
rr = re_pi %>%
group_by(cell)%>%
summarise(Lat = mean(LAT),Lon = mean(LON),Freq = length(cell))
my_theme <- theme_bw() + theme(panel.ontop=TRUE, panel.background=element_blank())
my_cols <- scale_color_distiller(palette='Spectral')
my_fill <- scale_fill_distiller(palette='Spectral')
ggplot(rr, aes(y=Lat, x=Lon, fill=Effort)) + geom_tile(width=1.2, height=1.2) +
borders('world', xlim=range(rr$Lon), ylim=range(rr$Lat), colour='black') + my_theme + my_fill +
coord_quickmap(xlim=range(rr$Lon), ylim=range(rr$Lat))
Nice dataset, assume these are fishing vessel VMS data. Here may be one way to achieve your objective, heavily reliant on the tidyverse and by-passing raster and shapes.
library(tidyverse)
library(mapdata) # higher resolution maps
# poor man's gridding function
grade <- function (x, dx) {
if (dx > 1)
warning("Not tested for grids larger than one")
brks <- seq(floor(min(x)), ceiling(max(x)), dx)
ints <- findInterval(x, brks, all.inside = TRUE)
x <- (brks[ints] + brks[ints + 1])/2
return(x)
}
d <-
read_csv("https://raw.githubusercontent.com/abenmhamed/data/main/Events.csv") %>%
janitor::clean_names() %>%
# make a grid 0.01 x 0.01 longitude / latitude
mutate(lon = grade(lon, 0.01),
lat = grade(lat, 0.01)) %>%
group_by(lon, lat) %>%
count() %>%
# not much happening south of 21 and north of 26
filter(between(lat, 21, 26.25))
d %>%
ggplot() +
theme_bw() +
geom_tile(aes(lon, lat, fill = n)) +
scale_fill_viridis_c(option = "B", direction = -1) +
# only data within the data-bounds
borders(database = "worldHires",
xlim = range(d$lon), ylim = range(d$lat),
fill = "grey") +
labs(x = NULL, y = NULL, fill = "Effort") +
# limit plot
coord_quickmap(xlim = range(d$lon), ylim = range(d$lat)) +
# legends within plot
theme(legend.position = c(0.77, 0.26))
Here is my attempt using the sf package. First I imported your data and converted it to an sf object. Then, I created another sf object which includes the grids. I used the raster package and the sf package in order to create the grids. Once I had the two sf object, I counted how many data points exist in each grid and added the results as a new column in foo. Finally, I drew a graphic.
library(tidyverse)
library(sf)
library(raster)
library(viridis)
# Import the data and convert it to an sf object
mydata <- read_csv("https://raw.githubusercontent.com/abenmhamed/data/main/Events.csv") %>%
st_as_sf(coords = c("LON", "LAT"),
crs = 4326, agr = "constant")
# Create an sf object for the grid
gridx <- seq(from = -19,to = -10, by = 0.083333)
gridy <- seq(from = 20,to = 29, by = 0.083333)
foo <- raster(xmn = -19, xmx = -10,
ymn = 20, ymx = 29,
nrows = length(gridx),
ncols = length(gridy)) %>%
rasterToPolygons() %>%
st_as_sf(crs = 4326) %>%
mutate(group = 1:(length(gridx)*length(gridy))) %>%
st_cast("MULTIPOLYGON")
# Now count how many data points exist in each grid
mutate(foo,
count = lengths(st_intersects(x = foo, y = mydata))) -> foo
# Draw a graphic
ggplot() +
geom_sf(data = foo, aes(fill = count)) +
scale_fill_viridis(option = "D") -> g

Create shaded polygons around points with ggplot2

I saw yesterday this beautiful map of McDonalds restaurants in USA. I wanted to replicate it for France (I found some data that can be downloaded here).
I have no problem plotting the dots:
library(readxl)
library(ggplot2)
library(raster)
#open data
mac_do_FR <- read_excel("./mcdo_france.xlsx")
mac_do_FR_df <- as.data.frame(mac_do_FR)
#get a map of France
mapaFR <- getData("GADM", country="France", level=0)
#plot dots on the map
ggplot() +
geom_polygon(data = mapaFR, aes(x = long, y = lat, group = group),
fill = "transparent", size = 0.1, color="black") +
geom_point(data = mac_do_FR_df, aes(x = lon, y = lat),
colour = "orange", size = 1)
I tried several methods (Thiessen polygons, heat maps, buffers), but the results I get are very poor. I can't figure out how the shaded polygons were plotted on the American map. Any pointers?
Here's my result, but it did take some manual data wrangling.
Step 1: Get geospatial data.
library(sp)
# generate a map of France, along with a fortified dataframe version for ease of
# referencing lat / long ranges
mapaFR <- raster::getData("GADM", country="France", level=0)
map.FR <- fortify(mapaFR)
# generate a spatial point version of the same map, defining your own grid size
# (a smaller size yields a higher resolution heatmap in the final product, but will
# take longer to calculate)
grid.size = 0.01
points.FR <- expand.grid(
x = seq(min(map.FR$long), max(map.FR$long), by = grid.size),
y = seq(min(map.FR$lat), max(map.FR$lat), by = grid.size)
)
points.FR <- SpatialPoints(coords = points.FR, proj4string = mapaFR#proj4string)
Step 2: Generate a voronoi diagram based on store locations, & obtain the corresponding polygons as a SpatialPolygonsDataFrame object.
library(deldir)
library(dplyr)
voronoi.tiles <- deldir(mac_do_FR_df$lon, mac_do_FR_df$lat,
rw = c(min(map.FR$long), max(map.FR$long),
min(map.FR$lat), max(map.FR$lat)))
voronoi.tiles <- tile.list(voronoi.tiles)
voronoi.center <- lapply(voronoi.tiles,
function(l) data.frame(x.center = l$pt[1],
y.center = l$pt[2],
ptNum = l$ptNum)) %>%
data.table::rbindlist()
voronoi.polygons <- lapply(voronoi.tiles,
function(l) Polygon(coords = matrix(c(l$x, l$y),
ncol = 2),
hole = FALSE) %>%
list() %>%
Polygons(ID = l$ptNum)) %>%
SpatialPolygons(proj4string = mapaFR#proj4string) %>%
SpatialPolygonsDataFrame(data = voronoi.center,
match.ID = "ptNum")
rm(voronoi.tiles, voronoi.center)
Step 3. Check which voronoi polygon each point on the map overlaps with, & calculate its distance to the corresponding nearest store.
which.voronoi <- over(points.FR, voronoi.polygons)
points.FR <- cbind(as.data.frame(points.FR), which.voronoi)
rm(which.voronoi)
points.FR <- points.FR %>%
rowwise() %>%
mutate(dist = geosphere::distm(x = c(x, y), y = c(x.center, y.center))) %>%
ungroup() %>%
mutate(dist = ifelse(is.na(dist), max(dist, na.rm = TRUE), dist)) %>%
mutate(dist = dist / 1000) # convert from m to km for easier reading
Step 4. Plot, adjusting the fill gradient parameters as needed. I felt the result of a square root transformation looks quite good for emphasizing distances close to a store, while a log transformation is rather too exaggerated, but your mileage may vary.
ggplot() +
geom_raster(data = points.FR %>%
mutate(dist = pmin(dist, 100)),
aes(x = x, y = y, fill = dist)) +
# optional. shows outline of France for reference
geom_polygon(data = map.FR,
aes(x = long, y = lat, group = group),
fill = NA, colour = "white") +
# define colour range, mid point, & transformation (if desired) for fill
scale_fill_gradient2(low = "yellow", mid = "red", high = "black",
midpoint = 4, trans = "sqrt") +
labs(x = "longitude",
y = "latitude",
fill = "Distance in km") +
coord_quickmap()

Resources