Open dominicroye opened 1 year ago
AllanCameron
commented
1 year ago Thanks for pointing this out. It also looks as if parse isn't recognised either. These arguments don't seem to be handled by the underlying sf helpers. I'll need to take a look at this and let you know when it's patched.
glorious1
commented
1 year ago Here are other parameters that are also unrecognized.
Warning message:
In layer_sf(geom = GeomTextsf, data = data, mapping = mapping, stat = stat, :
Ignoring unknown parameters: `gap`, `offset`, `text_only`, `rich`, and `remove_long`
jkaucic
commented
2 months ago Will there be more developments regarding geom_textsf? Sadly, also aesthetics do not seem to work, i.e. spacing and others. Also, halo effect (e.g. implemented in ggrepel https://github.com/slowkow/ggrepel/commit/9ec17e3491145e89dab4f696bf9ade57d4be7a88 ) or spacing to other labels (see also ggrepel) would be extremely important additions for linestring labelling in maps.
The combination of sf and geomtextpath would be extremely valuable for everyone who is visualising and labelling line geometries, e.g. road networks in maps etc. But the way it is currently implemented, it is not really feasible, as e.g. the labels of a street network randomly overlap each other and aesthetics cannot be aligned with background layers (e.g. make text opaque etc.)
teunbrand
commented
2 months ago Parameters should probably be passed on, but I don't think the halo/shadow effect needs to be implemented because you can use {ggfx} as illustrated here: https://github.com/AllanCameron/geomtextpath/issues/58#issuecomment-1013734961. I'm not sure what you mean by 'aesthetics cannot be aligned with background layers (e.g. make text opaque etc.)'. Does the alpha aesthetic not work?
AllanCameron
commented
2 months ago @jkaucic I am happy to have a look at this. Are you able to provide an example where you have poorly placed linestrings so I can get a better feel for the problem and work on various solutions?
jkaucic
commented
2 months ago First of all, thank you very much for you quick response(s), much appreciated! @teunbrand thanks for the tip regarding ggfx, works like a charm!
@AllanCameron I have compiled a code showing the problem; what I would like to be able to do on a labeling/layout side (with reference to QGIS, where this works quite well) and finally, what I have done by manually manipulating the data to get what I want (which is quite cumbersome). The example data is contained in the code.
library(tidyverse)
library(sf)
library(viridis)
library(geomtextpath) # for curved sf labels (along streets)
library(ggfx) # for outer glow of text labels
# Fetch data
streets_orig <- st_read("https://oeawcloud.oeaw.ac.at/index.php/s/tkionyRmkeRjSnH/download/streets_neubau.gpkg", "streets_orig")
buildings_orig <- st_read("https://oeawcloud.oeaw.ac.at/index.php/s/neFT8wCaJQ7xj9P/download/buildings_neubau.gpkg", "buildings_orig")
# lets plot the labels and see how it looks like
ggplot(buildings_orig) +
geom_sf(color = NA) +
theme_void() +
theme(
legend.position = "none",
panel.background = element_rect(fill = "white", colour = NA),
plot.background = element_rect(fill = "white", colour = NA)) +
with_outer_glow(geom_textsf(data = streets_orig,
aes(label = FEATURENAME),
linecolour = NA,
colour = "dimgrey",
size = 2.5,
text_smoothing = 0,
inherit.aes = F),
colour = "white", sigma = 0, expand = 5)
# Actually doesn't look that bad in terms of messiness, but the selection of labels displayed or not displayed is quite random
# Specificity of this street layer: Each segment between two intersections is a separate feature -> therefore, labels are displayed for each segment (if labels do not exceed the segment length; remove_long seems to be forced TRUE in geom_textsf)
# What doesn't look so nice is the duplication of labels along specific streets (this is due to separate segments)
# Also, for the most important street on the bottom, no label is displayed as the label length exceeds the length of each line segment
# Can we combine segments to a multilinestring for each street, so labels are not duplicated? -> no, geomtextpath cannot deal with multiline objects it seems
# It would be great, if geomtextpath could handle multilinestring.
# However, as a workaround, we can add the st_line_merge function, which merges the multilinestring elements of each street (group_by) into one long linestring
# However, this only works if there are no discontinuities along the line, because then it always becomes a multiline
streets_combined <- streets_orig %>%
group_by(FEATURENAME) %>%
summarise(geom = st_combine(geom)) %>%
st_line_merge()
st_geometry_type(streets_combined, by_geometry = F) # GEOMETRY, i.e. it is a combination of linestrings (continuous street) and multilinestrings (streets with discontinuities, e.g. there's a square with a different name in the middle)
# lets plot the labels and see how it looks like
# labels are only shown for linestrings, no labels are shown when input is a multilinestring
ggplot(buildings_orig) +
geom_sf(color = NA) +
theme_void() +
theme(
legend.position = "none",
panel.background = element_rect(fill = "white", colour = NA),
plot.background = element_rect(fill = "white", colour = NA)) +
with_outer_glow(geom_textsf(data = streets_combined,
aes(label = FEATURENAME),
linecolour = NA,
colour = "dimgrey",
size = 2.5,
text_smoothing = 0,
inherit.aes = F),
colour = "white", sigma = 0, expand = 5)
# We now managed to get rid of the multiplication of street labels, but added some messiness, as labels now sometimes overlap (e.g. in the middle)
# But again, for the most important street on the bottom, no label is displayed as the label length exceeds the length of each line segment
# So with this kind of street layer we have to tweak the line segments to get near the labeling we want
# The following operations would be nice if implemented from a layout side, without having to change the data structure behind
# A nice solution of line labeling is implemented in QGIS: Depending on the zoom level, the labels are displayed without overlapping each other and without repeating (there are options for curved placement, repeating labels by setting a repeat distance, label overrun distance to extend labels past start or end of a line feature and label anchoring along line features)
# I'm no programmer, but in QGIS, labeling (and its position) seems to be independent from the amount of line features of a street (same label). Labeling follows the line feature, but you can tweak the position of a label independent from centroids of the line or whatever.
# Manual tweaking of street layer to improve label selection and position:
# Step 1: Filter streets by length; here: only streets longer than 300m are selected (only display labels for the most important ones and also safeguard that label length doesn't exceed street length)
streets_orig$length <- as.numeric(st_length(streets_orig)) # length of segments
streets_sel <- streets_orig %>%
group_by(FEATURENAME) %>%
mutate(totallength = sum(length)) %>%
ungroup() %>%
filter(totallength > 300)
# Step 2: Reduce amount of segments by street, so that there are not too many labels (ideally, we want to control the position of labels, so that it looks nice on the map)
# We take the combined linestrings from above and split them into two segments each
# First we have to deal with the multiline features:
streets_combined$types <- st_geometry_type(streets_combined)
unique(streets_combined$types) # [1] LINESTRING MULTILINESTRING
streets_line <- streets_combined %>%
filter(types == "LINESTRING")
streets_multiline <- streets_combined %>%
filter(types == "MULTILINESTRING") %>%
st_cast("LINESTRING")
plot(streets_line$geom, col = "blue") # these are continuous lines
plot(streets_multiline$geom, col = "red", add = TRUE) #these are lines with some form of discontinuity
# We remove extremely short segments, which can be source of discontinuity
streets_multiline$length <- as.numeric(st_length(streets_multiline))
# remove segments < 200m (arbitrary number for this example)
streets_multiline_filter <- streets_multiline %>%
filter(length > 200)
plot(streets_multiline$geom, col = "blue")
plot(streets_multiline_filter$geom, col = "red", add = TRUE)
# again st_line_merge to get streets as one linestring each
streets_combined2 <- streets_multiline_filter %>%
group_by(FEATURENAME) %>%
summarise(geom = st_combine(geom)) %>%
st_line_merge()
st_geometry_type(streets_combined2, by_geometry = T) # We almost made it; only one multilinestring left -> discontinuity due to square in between street segments
# Again filter types
streets_combined2$types <- st_geometry_type(streets_combined2)
streets_line2 <- streets_combined2 %>%
filter(types == "LINESTRING")
streets_multiline2 <- streets_combined2 %>%
filter(types == "MULTILINESTRING")
# fix for discontinuous street: cast to point and combine points back to line
streets_line3 <- streets_multiline2 %>%
st_cast('MULTIPOINT') %>%
group_by(FEATURENAME) %>%
summarise(geom = st_combine(geom)) %>%
st_union(by_feature = TRUE) %>%
st_cast('LINESTRING')
st_geometry_type(streets_line3, by_geometry = T)
# lets check what we've done
plot(streets_combined$geom, col = "grey") # original selection
plot(streets_line$geom, col = "orange", add = TRUE) # first selection of continuous streets
plot(streets_line2$geom, col = "blue", add = TRUE) # addition of continuous streets after removing some intersections
plot(streets_line3$geom, col = "green", add = TRUE) # addition of continuous streets after removing 'holes'
# Now that we have continuous streets, we can split some of them in halve to have nicer placement of labels (+ repetition of labels for longer streets)
# bind together all street layers
streets_combined <- bind_rows(streets_line,streets_line2,streets_line3) %>%
select(-types)
length(unique(streets_combined$FEATURENAME))-nrow(streets_combined) # 0: Each street is one linestring
plot(streets_combined$geom, col = "grey") # final selection
# Select streets above certain length threshold
streets_combined$length <- as.numeric(st_length(streets_combined))
max <- max(streets_combined$length)
streets_manip <- streets_combined %>%
filter(length > max/2) # arbitrary threshold
# Sample points at the middle of the linestring
# Function:
st_line_midpoints <- function(sf_lines = NULL) {
g <- st_geometry(sf_lines)
g_mids <- lapply(g, function(x) {
coords <- as.matrix(x)
# this is just a copypaste of View(maptools:::getMidpoints):
get_mids <- function (coords) {
dist <- sqrt((diff(coords[, 1])^2 + (diff(coords[, 2]))^2))
dist_mid <- sum(dist)/2
dist_cum <- c(0, cumsum(dist))
end_index <- which(dist_cum > dist_mid)[1]
start_index <- end_index - 1
start <- coords[start_index, ]
end <- coords[end_index, ]
dist_remaining <- dist_mid - dist_cum[start_index]
mid <- start + (end - start) * (dist_remaining/dist[start_index])
return(mid)
}
mids <- st_point(get_mids(coords))
})
out <- st_sfc(g_mids, crs = st_crs(sf_lines))
out <- st_sf(out)
}
streets_midpoints <- st_line_midpoints(streets_manip)
plot(streets_combined$geom, col = "grey")
plot(streets_midpoints, col = "blue", add = T) # we're going to split the longer streets at these points to get two labels for these streets
# Now split lines by midpoints to get two segments per street
st_intersects(streets_midpoints, streets_manip, sparse=FALSE) # test: lines and respective mid-points do not intersect according to sf
st_erase = function(x, y) st_difference(x, st_union(y)) # function to erase small part from line in the middle
streets_manip_split <- st_erase(streets_manip, st_buffer(streets_midpoints,0.000001)) %>% # sf issue: have to work with buffer of points to get the intersection right
st_cast("LINESTRING")
# combine into final selection
streets_combined <- streets_combined %>%
filter(length <= max/2) # arbitrary threshold
streets_manip <- bind_rows(streets_combined,streets_manip_split)
st_geometry_type(streets_manip, by_geometry = F)
# lets plot the labels again see how it looks like
# labels are only shown for all linestrings, we have two labels for the longer streets and the important street at the bottom is also labelled
# However, we have still some overlap between street labels, which I will now clean manually
ggplot(buildings_orig) +
geom_sf(color = NA) +
theme_void() +
theme(
legend.position = "none",
panel.background = element_rect(fill = "white", colour = NA),
plot.background = element_rect(fill = "white", colour = NA)) +
with_outer_glow(geom_textsf(data = streets_manip,
aes(label = FEATURENAME),
linecolour = NA,
colour = "dimgrey",
size = 2.5,
text_smoothing = 0,
inherit.aes = F),
colour = "white", sigma = 0, expand = 5)
# Manual cleaning of labels: remove overlapping and strange looking labels (segments)
streets_labels <- streets_manip %>%
group_by(FEATURENAME) %>%
mutate(dupl = row_number()) %>%
ungroup %>%
filter(!FEATURENAME %in% c("Mondscheingasse","Mentergasse","Schrankgasse","Gardegasse","Hermanngasse","Siebensterngasse")) %>%
filter(FEATURENAME != "Kaiserstraße" | dupl != 1,
FEATURENAME != "Burggasse" | dupl != 2)
# lets plot the labels one final time
# now we have manually manipulated enough to have an okayish labelling of streets
ggplot(buildings_orig) +
geom_sf(color = NA) +
theme_void() +
theme(
legend.position = "none",
panel.background = element_rect(fill = "white", colour = NA),
plot.background = element_rect(fill = "white", colour = NA)) +
with_outer_glow(geom_textsf(data = streets_labels,
aes(label = FEATURENAME),
linecolour = NA,
colour = "dimgrey",
size = 2.5,
text_smoothing = 0,
inherit.aes = F),
colour = "white", sigma = 0, expand = 5)@jkaucic sorry - I'm just getting round to looking at this now. Unfortunately I'm getting a 404 when trying to read the files. Do you have alternate links I could use to work through your code?
jkaucic
commented
1 month ago Hi - it seems the link expired - I generated a new one: Please exchange these lines of code:
# Fetch data
streets_orig <- st_read("https://oeawcloud.oeaw.ac.at/index.php/s/SYTa75NC4xdDoQt/download/streets_neubau.gpkg", "streets_orig")
buildings_orig <- st_read("https://oeawcloud.oeaw.ac.at/index.php/s/6mTR6WHDeCLMZBB/download/buildings_neubau.gpkg", "buildings_orig")@jkaucic Thank you. I've got access to the links and looked though your script. As you have well demonstrated, it requires quite a lot of effort, including significant manipulation of the underlying sf object to get a nice output for a given input. The mechanism of geomtextpath is such that string positions also change as the plotting window size is rescaled. To get this working as desired would require ensuring that geomtextpath reliably gives a nice output for any given output and also scales nicely as the window sized is changed. This is obviously possible, since QGIS and many other applications manage it, though it might be the case that geomtextpath's core mechanism just doesn't lend itself well to this application. In any case it would require a large amount of single-handed development, and since I am also just a hobbyist, I cannot guarantee I will have the time to take this on. I will have a look and see whether I can at least make some incremental improvements in the first instance.
I cannot specify the straight argument since it seems unknown for geom_textsf().