ggplot2 中有没有办法将文本放置在弯曲的路径上？
Is there way in ggplot2 to place text on a curved path?
有没有办法在 ggplot2 中沿着密度线或任何路径放置文本？就此而言，我的意思是曾经作为标签，在这种 xkcd 风格中： 1835, 1950 (middle panel), 1392, or 2234 (middle panel). Alternatively, is there a way to have the line be repeating text, such as this xkcd #930 ？我对所有的xkcd表示歉意，我不确定这些样式叫什么，这是我能想到的唯一一个我以前见过的地方以这种方式区分区域。
注意：我不是谈论the hand-drawn xkcd style, nor
我知道我可以放置一段 straight/flat 文本，例如通过 annotate 或 geom_text，但我很好奇弯曲这样的文本以使其看起来一致数据曲线。
我也很好奇这种行文风格有没有名字？
示例 ggplot2 图使用 annotate(...):
以上示例图在 Inkscape 中用弯曲文本修改：
编辑：根据要求，这是 3 月和 4 月前两次试运行的数据：
df <- data.frame(
monthly_run = c('March', 'March', 'March', 'March', 'March', 'March', 'March',
'March', 'March', 'March', 'March', 'March', 'March', 'March',
'April', 'April', 'April', 'April', 'April', 'April', 'April',
'April', 'April', 'April', 'April', 'April', 'April', 'April'),
duration = c(36, 44, 45, 48, 50, 50, 51, 54, 55, 57, 60, 60, 60, 60, 30,
40, 44, 47, 47, 47, 53, 53, 54, 55, 56, 57, 69, 77)
)
ggplot(df, aes(x = duration, group = monthly_run, color = monthly_run)) +
geom_density() +
theme_minimal()`
好问题。我经常思考这个问题。我不知道有什么包本身允许它，但你自己做并不难，因为 geom_text 接受 angle 作为美学映射。
假设我们有以下情节：
library(ggplot2)
df <- data.frame(y = sin(seq(0, pi, length.out = 100)),
x = seq(0, pi, length.out = 100))
p <- ggplot(df, aes(x, y)) +
geom_line() +
coord_equal() +
theme_bw()
p
以及我们想要 运行 沿用的以下标签：
label <- "PIRATES VS NINJAS"
我们可以将标签拆分成字符：
label <- strsplit(label, "")[[1]]
棘手的部分来了。我们需要 space 沿着路径均匀地排列字母，这需要计算出实现此目的的 x 坐标。我们在这里需要几个辅助函数：
next_x_along_sine <- function(x, d)
{
y <- sin(x)
uniroot(f = \(b) b^2 + (sin(x + b) - y)^2 - d^2, c(0, 2*pi))$root + x
}
x_along_sine <- function(x1, d, n)
{
while(length(x1) < n) x1 <- c(x1, next_x_along_sine(x1[length(x1)], d))
x1
}
这些允许我们创建一个由字母、坐标和角度组成的小数据框来绘制我们的字母：
df2 <- as.data.frame(approx(df$x, df$y, x_along_sine(1, 1/13, length(label))))
df2$label <- label
df2$angle <- atan(cos(df2$x)) * 180/pi
现在我们可以用普通的旧图 geom_text:
p + geom_text(aes(y = y + 0.1, label = label, angle = angle), data = df2,
vjust = 1, size = 4, fontface = "bold")
或者，如果我们想用文本替换部分行：
df$col <- cut(df$x, c(-1, 0.95, 2.24, 5), c("black", "white", "#000000"))
ggplot(df, aes(x, y)) +
geom_line(aes(color = col, group = col)) +
geom_text(aes(label = label, angle = angle), data = df2,
size = 4, fontface = "bold") +
scale_color_identity() +
coord_equal() +
theme_bw()
或者，通过一些主题调整：
附录
实际上，我可能不想写一个 geom_textpath 包，但我认为根据 OP 的示例展示可能适用于标记密度曲线的方法会很有用。它需要以下功能套件：
#-----------------------------------------------------------------------
# Converts a (delta y) / (delta x) gradient to the equivalent
# angle a letter sitting on that line needs to be rotated by to
# sit perpendicular to it. Includes a multiplier term so that we
# can take account of the different scale of x and y variables
# when plotting, as well as the device's aspect ratio.
gradient_to_text_angle <- function(grad, mult = 1)
{
angle <- atan(mult * grad) * 180 / pi
}
#-----------------------------------------------------------------------
# From a given set of x and y co-ordinates, determine the gradient along
# the path, and also the Euclidean distance along the path. It will also
# calculate the multiplier needed to correct for differences in the x and
# y scales as well as the current plotting device's aspect ratio
get_path_data <- function(x, y)
{
grad <- diff(y)/diff(x)
multiplier <- diff(range(x))/diff(range(y)) * dev.size()[2] / dev.size()[1]
new_x <- (head(x, -1) + tail(x, -1)) / 2
new_y <- (head(y, -1) + tail(y, -1)) / 2
path_length <- cumsum(sqrt(diff(x)^2 + diff(multiplier * y / 1.5)^2))
data.frame(x = new_x, y = new_y, gradient = grad,
angle = gradient_to_text_angle(grad, multiplier),
length = path_length)
}
#-----------------------------------------------------------------------
# From a given path data frame as provided by get_path_data, as well
# as the beginning and ending x co-ordinate, produces the appropriate
# x, y values and angles for letters placed along the path.
get_path_points <- function(path, x_start, x_end, letters)
{
start_dist <- approx(x = path$x, y = path$length, xout = x_start)$y
end_dist <- approx(x = path$x, y = path$length, xout = x_end)$y
diff_dist <- end_dist - start_dist
letterwidths <- cumsum(strwidth(letters))
letterwidths <- letterwidths/sum(strwidth(letters))
dist_points <- c(start_dist, letterwidths * diff_dist + start_dist)
dist_points <- (head(dist_points, -1) + tail(dist_points, -1))/2
x <- approx(x = path$length, y = path$x, xout = dist_points)$y
y <- approx(x = path$length, y = path$y, xout = dist_points)$y
grad <- approx(x = path$length, y = path$gradient, xout = dist_points)$y
angle <- approx(x = path$length, y = path$angle, xout = dist_points)$y
data.frame(x = x, y = y, gradient = grad,
angle = angle, length = dist_points)
}
#-----------------------------------------------------------------------
# This function combines the other functions to get the appropriate
# x, y positions and angles for a given string on a given path.
label_to_path <- function(label, path, x_start = head(path$x, 1),
x_end = tail(path$x, 1))
{
letters <- unlist(strsplit(label, "")[1])
df <- get_path_points(path, x_start, x_end, letters)
df$letter <- letters
df
}
#-----------------------------------------------------------------------
# This simple helper function gets the necessary density paths from
# a given variable. It can be passed a grouping variable to get multiple
# density paths
get_densities <- function(var, groups)
{
if(missing(groups)) values <- list(var)
else values <- split(var, groups)
lapply(values, function(x) {
d <- density(x)
data.frame(x = d$x, y = d$y)})
}
#-----------------------------------------------------------------------
# This is the end-user function to get a data frame of letters spaced
# out neatly and angled correctly along the density curve of the given
# variable (with optional grouping)
density_labels <- function(var, groups, proportion = 0.25)
{
d <- get_densities(var, groups)
d <- lapply(d, function(x) get_path_data(x$x, x$y))
labels <- unique(groups)
x_starts <- lapply(d, function(x) x$x[round((length(x$x) * (1 - proportion))/2)])
x_ends <- lapply(d, function(x) x$x[round((length(x$x) * (1 + proportion))/2)])
do.call(rbind, lapply(seq_along(d), function(i) {
df <- label_to_path(labels[i], d[[i]], x_starts[[i]], x_ends[[i]])
df$group <- labels[i]
df}))
}
定义了这些函数后，我们现在可以做：
set.seed(100)
df <- data.frame(value = rpois(100, 3),
group = rep(paste("This is a very long label",
"that will nicely demonstrate the ability",
"of text to follow a density curve"), 100))
ggplot(df, aes(value)) +
geom_density(fill = "forestgreen", color = NA, alpha = 0.2) +
geom_text(aes(x = x, y = y, label = letter, angle = angle),
data = density_labels(df$value, df$group, 0.8)) +
theme_bw()
最后，这个问题促使我和 Teun van den Brand (@teunbrand) 开发了 geomtextpath 包，现在在 CRAN 上。
所以现在可以更直接、更简单地回答这个问题了：
library(geomtextpath)
ggplot(df, aes(x = duration, color = monthly_run)) +
geom_textdensity(aes(label = monthly_run, hjust = monthly_run,
vjust = monthly_run), size = 6) +
scale_hjust_manual(values = c(0.4, 0.55)) +
scale_vjust_manual(values = c(1.1, -0.2)) +
scale_y_continuous(limits = c(0, 0.06)) +
theme_minimal() +
theme(legend.position = "none")
有没有办法在 ggplot2 中沿着密度线或任何路径放置文本？就此而言，我的意思是曾经作为标签，在这种 xkcd 风格中： 1835, 1950 (middle panel), 1392, or 2234 (middle panel). Alternatively, is there a way to have the line be repeating text, such as this xkcd #930 ？我对所有的xkcd表示歉意，我不确定这些样式叫什么，这是我能想到的唯一一个我以前见过的地方以这种方式区分区域。
注意：我不是谈论the hand-drawn xkcd style, nor
我知道我可以放置一段 straight/flat 文本，例如通过 annotate 或 geom_text，但我很好奇弯曲这样的文本以使其看起来一致数据曲线。
我也很好奇这种行文风格有没有名字？
示例 ggplot2 图使用 annotate(...):
以上示例图在 Inkscape 中用弯曲文本修改：
编辑：根据要求，这是 3 月和 4 月前两次试运行的数据：
df <- data.frame(
monthly_run = c('March', 'March', 'March', 'March', 'March', 'March', 'March',
'March', 'March', 'March', 'March', 'March', 'March', 'March',
'April', 'April', 'April', 'April', 'April', 'April', 'April',
'April', 'April', 'April', 'April', 'April', 'April', 'April'),
duration = c(36, 44, 45, 48, 50, 50, 51, 54, 55, 57, 60, 60, 60, 60, 30,
40, 44, 47, 47, 47, 53, 53, 54, 55, 56, 57, 69, 77)
)
ggplot(df, aes(x = duration, group = monthly_run, color = monthly_run)) +
geom_density() +
theme_minimal()`
好问题。我经常思考这个问题。我不知道有什么包本身允许它，但你自己做并不难，因为 geom_text 接受 angle 作为美学映射。
假设我们有以下情节：
library(ggplot2)
df <- data.frame(y = sin(seq(0, pi, length.out = 100)),
x = seq(0, pi, length.out = 100))
p <- ggplot(df, aes(x, y)) +
geom_line() +
coord_equal() +
theme_bw()
p
以及我们想要 运行 沿用的以下标签：
label <- "PIRATES VS NINJAS"
我们可以将标签拆分成字符：
label <- strsplit(label, "")[[1]]
棘手的部分来了。我们需要 space 沿着路径均匀地排列字母，这需要计算出实现此目的的 x 坐标。我们在这里需要几个辅助函数：
next_x_along_sine <- function(x, d)
{
y <- sin(x)
uniroot(f = \(b) b^2 + (sin(x + b) - y)^2 - d^2, c(0, 2*pi))$root + x
}
x_along_sine <- function(x1, d, n)
{
while(length(x1) < n) x1 <- c(x1, next_x_along_sine(x1[length(x1)], d))
x1
}
这些允许我们创建一个由字母、坐标和角度组成的小数据框来绘制我们的字母：
df2 <- as.data.frame(approx(df$x, df$y, x_along_sine(1, 1/13, length(label))))
df2$label <- label
df2$angle <- atan(cos(df2$x)) * 180/pi
现在我们可以用普通的旧图 geom_text:
p + geom_text(aes(y = y + 0.1, label = label, angle = angle), data = df2,
vjust = 1, size = 4, fontface = "bold")
或者，如果我们想用文本替换部分行：
df$col <- cut(df$x, c(-1, 0.95, 2.24, 5), c("black", "white", "#000000"))
ggplot(df, aes(x, y)) +
geom_line(aes(color = col, group = col)) +
geom_text(aes(label = label, angle = angle), data = df2,
size = 4, fontface = "bold") +
scale_color_identity() +
coord_equal() +
theme_bw()
或者，通过一些主题调整：
附录
实际上，我可能不想写一个 geom_textpath 包，但我认为根据 OP 的示例展示可能适用于标记密度曲线的方法会很有用。它需要以下功能套件：
#-----------------------------------------------------------------------
# Converts a (delta y) / (delta x) gradient to the equivalent
# angle a letter sitting on that line needs to be rotated by to
# sit perpendicular to it. Includes a multiplier term so that we
# can take account of the different scale of x and y variables
# when plotting, as well as the device's aspect ratio.
gradient_to_text_angle <- function(grad, mult = 1)
{
angle <- atan(mult * grad) * 180 / pi
}
#-----------------------------------------------------------------------
# From a given set of x and y co-ordinates, determine the gradient along
# the path, and also the Euclidean distance along the path. It will also
# calculate the multiplier needed to correct for differences in the x and
# y scales as well as the current plotting device's aspect ratio
get_path_data <- function(x, y)
{
grad <- diff(y)/diff(x)
multiplier <- diff(range(x))/diff(range(y)) * dev.size()[2] / dev.size()[1]
new_x <- (head(x, -1) + tail(x, -1)) / 2
new_y <- (head(y, -1) + tail(y, -1)) / 2
path_length <- cumsum(sqrt(diff(x)^2 + diff(multiplier * y / 1.5)^2))
data.frame(x = new_x, y = new_y, gradient = grad,
angle = gradient_to_text_angle(grad, multiplier),
length = path_length)
}
#-----------------------------------------------------------------------
# From a given path data frame as provided by get_path_data, as well
# as the beginning and ending x co-ordinate, produces the appropriate
# x, y values and angles for letters placed along the path.
get_path_points <- function(path, x_start, x_end, letters)
{
start_dist <- approx(x = path$x, y = path$length, xout = x_start)$y
end_dist <- approx(x = path$x, y = path$length, xout = x_end)$y
diff_dist <- end_dist - start_dist
letterwidths <- cumsum(strwidth(letters))
letterwidths <- letterwidths/sum(strwidth(letters))
dist_points <- c(start_dist, letterwidths * diff_dist + start_dist)
dist_points <- (head(dist_points, -1) + tail(dist_points, -1))/2
x <- approx(x = path$length, y = path$x, xout = dist_points)$y
y <- approx(x = path$length, y = path$y, xout = dist_points)$y
grad <- approx(x = path$length, y = path$gradient, xout = dist_points)$y
angle <- approx(x = path$length, y = path$angle, xout = dist_points)$y
data.frame(x = x, y = y, gradient = grad,
angle = angle, length = dist_points)
}
#-----------------------------------------------------------------------
# This function combines the other functions to get the appropriate
# x, y positions and angles for a given string on a given path.
label_to_path <- function(label, path, x_start = head(path$x, 1),
x_end = tail(path$x, 1))
{
letters <- unlist(strsplit(label, "")[1])
df <- get_path_points(path, x_start, x_end, letters)
df$letter <- letters
df
}
#-----------------------------------------------------------------------
# This simple helper function gets the necessary density paths from
# a given variable. It can be passed a grouping variable to get multiple
# density paths
get_densities <- function(var, groups)
{
if(missing(groups)) values <- list(var)
else values <- split(var, groups)
lapply(values, function(x) {
d <- density(x)
data.frame(x = d$x, y = d$y)})
}
#-----------------------------------------------------------------------
# This is the end-user function to get a data frame of letters spaced
# out neatly and angled correctly along the density curve of the given
# variable (with optional grouping)
density_labels <- function(var, groups, proportion = 0.25)
{
d <- get_densities(var, groups)
d <- lapply(d, function(x) get_path_data(x$x, x$y))
labels <- unique(groups)
x_starts <- lapply(d, function(x) x$x[round((length(x$x) * (1 - proportion))/2)])
x_ends <- lapply(d, function(x) x$x[round((length(x$x) * (1 + proportion))/2)])
do.call(rbind, lapply(seq_along(d), function(i) {
df <- label_to_path(labels[i], d[[i]], x_starts[[i]], x_ends[[i]])
df$group <- labels[i]
df}))
}
定义了这些函数后，我们现在可以做：
set.seed(100)
df <- data.frame(value = rpois(100, 3),
group = rep(paste("This is a very long label",
"that will nicely demonstrate the ability",
"of text to follow a density curve"), 100))
ggplot(df, aes(value)) +
geom_density(fill = "forestgreen", color = NA, alpha = 0.2) +
geom_text(aes(x = x, y = y, label = letter, angle = angle),
data = density_labels(df$value, df$group, 0.8)) +
theme_bw()
最后，这个问题促使我和 Teun van den Brand (@teunbrand) 开发了 geomtextpath 包，现在在 CRAN 上。
所以现在可以更直接、更简单地回答这个问题了：
library(geomtextpath)
ggplot(df, aes(x = duration, color = monthly_run)) +
geom_textdensity(aes(label = monthly_run, hjust = monthly_run,
vjust = monthly_run), size = 6) +
scale_hjust_manual(values = c(0.4, 0.55)) +
scale_vjust_manual(values = c(1.1, -0.2)) +
scale_y_continuous(limits = c(0, 0.06)) +
theme_minimal() +
theme(legend.position = "none")