尽管线宽如何保持线型间距不变
How to keep linetype spacing constant despite line size
我一直在尝试在 ggplot2 或网格中绘制线条，当尺寸不同时，线段之间的间距相等。但是我一直没有成功所以我请求你的帮助。
在下面的示例中，如何在线宽不同的情况下保持线段之间的绝对间距相等？
我想避免自己制作自定义 makeContent.myclass 方法来控制它。
library(ggplot2)
library(grid)
df <- data.frame(
x = c(1:2, 1:2),
y = c(1:2, 2:1),
size = c(1,1,10,10)
)
# In ggplot2
ggplot(df, aes(x, y, size = size, group = size)) +
geom_line(linetype = 2)
# In grid
lines <- polylineGrob(
x = scales::rescale(df$x),
y = scales::rescale(df$y),
id = c(1,1,2,2),
gp = gpar(lty = 2, lwd = c(1, 10))
)
grid.newpage(); grid.draw(lines)
我想要类似于以下插图画家制作的东西。注意红线段是等长的。
有什么想法吗？感谢阅读！
这可能不是您要找的 Teunbrand，但我想您可以将您的线条转换为一系列沿线条等距分布的细多边形。
此函数采用一系列 x 和 y 坐标和 returns 虚线（作为单个 treeGrob）。根据你的例子，它 returns 它在标准化的 npc 坐标中。您可以完全控制线宽、破折号长度和中断长度（但不是图案）以及颜色。恐怕单位有点随意，这与生产标准相去甚远，但它相当有效：
segmentify <- function(x, y, linewidth = 1, dash_len = 1,
break_len = 1, col = "black")
{
linewidth <- 0.002 * linewidth
dash_len <- 0.01 * dash_len
break_len <- 0.04 * break_len
if(length(y) != length(x))
stop("x and y must be the same length")
if(!is.numeric(x) | !is.numeric(y))
stop("x and y must be numeric vectors")
if(length(x) < 2)
stop("Insufficient x, y pairs to make line.")
x <- scales::rescale(x)
y <- scales::rescale(y)
n_dashes <- 0
skip_len <- break_len + dash_len
df <- list()
for(i in seq_along(x)[-1])
{
x_diff <- x[i] - x[i - 1]
y_diff <- y[i] - y[i - 1]
seg_len <- sqrt(x_diff^2 + y_diff^2)
seg_prop <- skip_len / seg_len
dist_from_start <- n_dashes * skip_len
prop_start <- dist_from_start/seg_len
x_start <- x[i-1] + prop_start * x_diff
y_len <- y_diff * seg_prop
x_len <- x_diff * seg_prop
y_start <- y[i-1] + prop_start * y_diff
n_breaks <- (seg_len - dist_from_start)/skip_len
n_dashes <- (n_dashes + n_breaks) %% 1
n_breaks <- floor(n_breaks)
if(n_breaks)
{
df[[length( df) + 1]] <- data.frame(
x = seq(x_start, x[i], by = x_len),
y = seq(y_start, y[i], by = y_len)
)
df[[length( df)]]$theta <-
atan(rep(y_diff/x_diff, length( df[[length( df)]]$x)))
}
}
df <- do.call(rbind, df)
df$x1 <- df$x + sin( df$theta) * linewidth + cos(df$theta) * dash_len
df$x2 <- df$x + sin( df$theta) * linewidth - cos(df$theta) * dash_len
df$x3 <- df$x - sin( df$theta) * linewidth - cos(df$theta) * dash_len
df$x4 <- df$x - sin( df$theta) * linewidth + cos(df$theta) * dash_len
df$y1 <- df$y - cos( df$theta) * linewidth + sin(df$theta) * dash_len
df$y2 <- df$y - cos( df$theta) * linewidth - sin(df$theta) * dash_len
df$y3 <- df$y + cos( df$theta) * linewidth - sin(df$theta) * dash_len
df$y4 <- df$y + cos( df$theta) * linewidth + sin(df$theta) * dash_len
do.call(grid::grobTree, lapply(seq(nrow(df)), function(i) {
grid::polygonGrob(c(df$x1[i], df$x2[i], df$x3[i], df$x4[i]),
c(df$y1[i], df$y2[i], df$y3[i], df$y4[i]),
gp = gpar(col = "#00000000", lwd = 0, fill = col))
}))
}
使用起来相当简单：
set.seed(2)
x <- 1:10
y <- rnorm(10)
grid::grid.newpage()
grid::grid.draw(segmentify(x, y))
而在不影响间距的情况下改变线宽是这样的：
grid::grid.newpage()
grid::grid.draw(segmentify(x, y, linewidth = 3))
您可以像这样控制间距和颜色：
grid::grid.newpage()
grid::grid.draw(segmentify(x, y, linewidth = 2, break_len = 0.5, col = "forestgreen"))
好吧，在 Allan 的鼓励下，我自己画了一些东西并没有那么糟糕，我决定也尝试解决这个问题。它正在做我试图避免这个问题的事情，但它可能对你们其他人有帮助。
我采用了稍微不同的方法，主要区别在于 (1) 我们保留多段线而不是转换为多边形，以及 (2) 我不太熟悉三角函数，所以我使用 approxfun() 代替插入线和 (3) 我们将使用绝对单位而不是相对单位，因此在调整设备大小时不会很尴尬。
首先，因为我打算在自定义 geom 函数中使用它，所以我的目标是制作一个易于粘贴到 geom 绘制方法末尾的 grob 结构。你可以给它一个 grob，或者一个 grob 的参数。它更改了 grob 的 class，稍后将变得相关，删除了线型参数并添加了破折号和断线的信息。
library(grid)
library(scales)
linetypeGrob <- function(x, ..., dashes = 1, breaks = 1) {
if (!inherits(x, "polyline")) {
x <- polylineGrob(x, ...)
}
class(x)[[1]] <- "linetypeGrob"
x$gp$lty <- NULL
x$dashes <- dashes
x$breaks <- breaks
x
}
现在正如我上面提到的，我们将回到 class。自定义 grob classes 的巧妙之处在于，您可以在绘制它们之前拦截它们，以便您可以进行最后一刻的更改。为此，我们对grid中的makeContext函数写了一个S3方法，进行相应的修改。我知道这是一个很长的函数，但我试图通过插入说明我正在尝试做什么的注释来使其更容易理解。
makeContext.linetypeGrob <- function(x) {
# Sort out line IDs
id <- x$id
if (is.null(id)) {
if (is.null(x$id.lengths)) {
id <- rep(1L, length(x$x))
} else {
id <- rep(seq_along(x$id.lengths), x$id.lengths)
}
}
# Delete previous line IDs
x$id <- NULL
x$id.lengths <- NULL
# Take dashes and breaks parameters out of the old grob
dashes <- x$dashes
x$dashes <- NULL
breaks <- x$breaks
x$breaks <- NULL
# Convert to absolute units
newx <- convertX(x$x, "mm", TRUE)
newy <- convertY(x$y, "mm", TRUE)
# Express lines as points along a cumulative distances
dist <- sqrt(diff(newx)^2 + diff(newy)^2)
cumdist <- cumsum(c(0, dist))
# Take new lines as a sequence along the cumulative distance
starts <- seq(0, max(cumdist), by = (dashes + breaks))
ends <- seq(dashes, max(cumdist), by = (dashes + breaks))
if (length(ends) == length(starts) - 1) {
# Case when the end actually should have gone beyond `max(cumdist)`
ends <- c(ends, max(cumdist))
}
# Set index for graphical parameters
gp_i <- findInterval(starts, cumdist[cumsum(rle(id)$lengths)]) + 1
# Basically dealing with elbow pieces a bit
# Find mismatches between the original segments that starts and ends fall on
start_id <- findInterval(starts, cumdist)
end_id <- findInterval(ends, cumdist)
mismatch <- which(start_id != end_id)
# Insert elbow pieces
starts <- c(starts, cumdist[end_id[mismatch]])
starts <- starts[{o <- order(starts)}] # Need the order for later
ends <- sort(c(ends, cumdist[end_id[mismatch]]))
# Join elbow pieces
new_id <- seq_along(start_id)
if (length(mismatch)) {
i <- rep_len(1, length(new_id))
i[mismatch] <- 2
new_id <- rep(new_id, i)
}
# Seperate lines with different IDs
keepfun <- approxfun(cumdist, id)
keep <- (keepfun(starts) %% 1) == 0 & (keepfun(ends) %% 1) == 0
# Interpolate x
xfun <- approxfun(cumdist, newx)
x0 <- xfun(starts[keep])
x1 <- xfun(ends[keep])
# Interpolate y
yfun <- approxfun(cumdist, newy)
y0 <- yfun(starts[keep])
y1 <- yfun(ends[keep])
# Expand graphic parameters by new ID
x$gp[] <- lapply(x$gp, function(x){
if (length(x) == 1) {
return(x)
} else {
x[as.integer(gp_i)]
}
})
# Put everything back into the grob
x$x <- unit(as.vector(rbind(x0, x1)), "mm")
x$y <- unit(as.vector(rbind(y0, y1)), "mm")
x$id <- as.vector(rbind(new_id[keep], new_id[keep]))
class(x)[[1]] <- "polyline"
x
}
最后，为了证明它的工作原理，我将使用这个新的 grob 绘制一些虚拟数据。您可以像绘制普通多段线 grob 一样使用它。
set.seed(100)
x <- c(cumsum(rnorm(10)), cumsum(rnorm(10)))
y <- c(cumsum(rnorm(10)), cumsum(rnorm(10)))
id <- rep(c(1, 2), each = 10)
gp <- gpar(lwd = c(2, 10), lineend = "butt",
col = c("magenta", "blue"))
grob <- linetypeGrob(scales::rescale(x),
scales::rescale(y),
id = id, gp = gp, dashes = 5, breaks = 2)
grid.newpage(); grid.draw(grob)
您可以看到，如果我调整设备大小，破折号和折线的长度保持不变：
我一直在尝试在 ggplot2 或网格中绘制线条，当尺寸不同时，线段之间的间距相等。但是我一直没有成功所以我请求你的帮助。
在下面的示例中，如何在线宽不同的情况下保持线段之间的绝对间距相等？
我想避免自己制作自定义 makeContent.myclass 方法来控制它。
library(ggplot2)
library(grid)
df <- data.frame(
x = c(1:2, 1:2),
y = c(1:2, 2:1),
size = c(1,1,10,10)
)
# In ggplot2
ggplot(df, aes(x, y, size = size, group = size)) +
geom_line(linetype = 2)
# In grid
lines <- polylineGrob(
x = scales::rescale(df$x),
y = scales::rescale(df$y),
id = c(1,1,2,2),
gp = gpar(lty = 2, lwd = c(1, 10))
)
grid.newpage(); grid.draw(lines)
我想要类似于以下插图画家制作的东西。注意红线段是等长的。
有什么想法吗？感谢阅读！
这可能不是您要找的 Teunbrand，但我想您可以将您的线条转换为一系列沿线条等距分布的细多边形。
此函数采用一系列 x 和 y 坐标和 returns 虚线（作为单个 treeGrob）。根据你的例子，它 returns 它在标准化的 npc 坐标中。您可以完全控制线宽、破折号长度和中断长度（但不是图案）以及颜色。恐怕单位有点随意，这与生产标准相去甚远，但它相当有效：
segmentify <- function(x, y, linewidth = 1, dash_len = 1,
break_len = 1, col = "black")
{
linewidth <- 0.002 * linewidth
dash_len <- 0.01 * dash_len
break_len <- 0.04 * break_len
if(length(y) != length(x))
stop("x and y must be the same length")
if(!is.numeric(x) | !is.numeric(y))
stop("x and y must be numeric vectors")
if(length(x) < 2)
stop("Insufficient x, y pairs to make line.")
x <- scales::rescale(x)
y <- scales::rescale(y)
n_dashes <- 0
skip_len <- break_len + dash_len
df <- list()
for(i in seq_along(x)[-1])
{
x_diff <- x[i] - x[i - 1]
y_diff <- y[i] - y[i - 1]
seg_len <- sqrt(x_diff^2 + y_diff^2)
seg_prop <- skip_len / seg_len
dist_from_start <- n_dashes * skip_len
prop_start <- dist_from_start/seg_len
x_start <- x[i-1] + prop_start * x_diff
y_len <- y_diff * seg_prop
x_len <- x_diff * seg_prop
y_start <- y[i-1] + prop_start * y_diff
n_breaks <- (seg_len - dist_from_start)/skip_len
n_dashes <- (n_dashes + n_breaks) %% 1
n_breaks <- floor(n_breaks)
if(n_breaks)
{
df[[length( df) + 1]] <- data.frame(
x = seq(x_start, x[i], by = x_len),
y = seq(y_start, y[i], by = y_len)
)
df[[length( df)]]$theta <-
atan(rep(y_diff/x_diff, length( df[[length( df)]]$x)))
}
}
df <- do.call(rbind, df)
df$x1 <- df$x + sin( df$theta) * linewidth + cos(df$theta) * dash_len
df$x2 <- df$x + sin( df$theta) * linewidth - cos(df$theta) * dash_len
df$x3 <- df$x - sin( df$theta) * linewidth - cos(df$theta) * dash_len
df$x4 <- df$x - sin( df$theta) * linewidth + cos(df$theta) * dash_len
df$y1 <- df$y - cos( df$theta) * linewidth + sin(df$theta) * dash_len
df$y2 <- df$y - cos( df$theta) * linewidth - sin(df$theta) * dash_len
df$y3 <- df$y + cos( df$theta) * linewidth - sin(df$theta) * dash_len
df$y4 <- df$y + cos( df$theta) * linewidth + sin(df$theta) * dash_len
do.call(grid::grobTree, lapply(seq(nrow(df)), function(i) {
grid::polygonGrob(c(df$x1[i], df$x2[i], df$x3[i], df$x4[i]),
c(df$y1[i], df$y2[i], df$y3[i], df$y4[i]),
gp = gpar(col = "#00000000", lwd = 0, fill = col))
}))
}
使用起来相当简单：
set.seed(2)
x <- 1:10
y <- rnorm(10)
grid::grid.newpage()
grid::grid.draw(segmentify(x, y))
而在不影响间距的情况下改变线宽是这样的：
grid::grid.newpage()
grid::grid.draw(segmentify(x, y, linewidth = 3))
您可以像这样控制间距和颜色：
grid::grid.newpage()
grid::grid.draw(segmentify(x, y, linewidth = 2, break_len = 0.5, col = "forestgreen"))
好吧，在 Allan 的鼓励下，我自己画了一些东西并没有那么糟糕，我决定也尝试解决这个问题。它正在做我试图避免这个问题的事情，但它可能对你们其他人有帮助。
我采用了稍微不同的方法，主要区别在于 (1) 我们保留多段线而不是转换为多边形，以及 (2) 我不太熟悉三角函数，所以我使用 approxfun() 代替插入线和 (3) 我们将使用绝对单位而不是相对单位，因此在调整设备大小时不会很尴尬。
首先，因为我打算在自定义 geom 函数中使用它，所以我的目标是制作一个易于粘贴到 geom 绘制方法末尾的 grob 结构。你可以给它一个 grob，或者一个 grob 的参数。它更改了 grob 的 class，稍后将变得相关，删除了线型参数并添加了破折号和断线的信息。
library(grid)
library(scales)
linetypeGrob <- function(x, ..., dashes = 1, breaks = 1) {
if (!inherits(x, "polyline")) {
x <- polylineGrob(x, ...)
}
class(x)[[1]] <- "linetypeGrob"
x$gp$lty <- NULL
x$dashes <- dashes
x$breaks <- breaks
x
}
现在正如我上面提到的，我们将回到 class。自定义 grob classes 的巧妙之处在于，您可以在绘制它们之前拦截它们，以便您可以进行最后一刻的更改。为此，我们对grid中的makeContext函数写了一个S3方法，进行相应的修改。我知道这是一个很长的函数，但我试图通过插入说明我正在尝试做什么的注释来使其更容易理解。
makeContext.linetypeGrob <- function(x) {
# Sort out line IDs
id <- x$id
if (is.null(id)) {
if (is.null(x$id.lengths)) {
id <- rep(1L, length(x$x))
} else {
id <- rep(seq_along(x$id.lengths), x$id.lengths)
}
}
# Delete previous line IDs
x$id <- NULL
x$id.lengths <- NULL
# Take dashes and breaks parameters out of the old grob
dashes <- x$dashes
x$dashes <- NULL
breaks <- x$breaks
x$breaks <- NULL
# Convert to absolute units
newx <- convertX(x$x, "mm", TRUE)
newy <- convertY(x$y, "mm", TRUE)
# Express lines as points along a cumulative distances
dist <- sqrt(diff(newx)^2 + diff(newy)^2)
cumdist <- cumsum(c(0, dist))
# Take new lines as a sequence along the cumulative distance
starts <- seq(0, max(cumdist), by = (dashes + breaks))
ends <- seq(dashes, max(cumdist), by = (dashes + breaks))
if (length(ends) == length(starts) - 1) {
# Case when the end actually should have gone beyond `max(cumdist)`
ends <- c(ends, max(cumdist))
}
# Set index for graphical parameters
gp_i <- findInterval(starts, cumdist[cumsum(rle(id)$lengths)]) + 1
# Basically dealing with elbow pieces a bit
# Find mismatches between the original segments that starts and ends fall on
start_id <- findInterval(starts, cumdist)
end_id <- findInterval(ends, cumdist)
mismatch <- which(start_id != end_id)
# Insert elbow pieces
starts <- c(starts, cumdist[end_id[mismatch]])
starts <- starts[{o <- order(starts)}] # Need the order for later
ends <- sort(c(ends, cumdist[end_id[mismatch]]))
# Join elbow pieces
new_id <- seq_along(start_id)
if (length(mismatch)) {
i <- rep_len(1, length(new_id))
i[mismatch] <- 2
new_id <- rep(new_id, i)
}
# Seperate lines with different IDs
keepfun <- approxfun(cumdist, id)
keep <- (keepfun(starts) %% 1) == 0 & (keepfun(ends) %% 1) == 0
# Interpolate x
xfun <- approxfun(cumdist, newx)
x0 <- xfun(starts[keep])
x1 <- xfun(ends[keep])
# Interpolate y
yfun <- approxfun(cumdist, newy)
y0 <- yfun(starts[keep])
y1 <- yfun(ends[keep])
# Expand graphic parameters by new ID
x$gp[] <- lapply(x$gp, function(x){
if (length(x) == 1) {
return(x)
} else {
x[as.integer(gp_i)]
}
})
# Put everything back into the grob
x$x <- unit(as.vector(rbind(x0, x1)), "mm")
x$y <- unit(as.vector(rbind(y0, y1)), "mm")
x$id <- as.vector(rbind(new_id[keep], new_id[keep]))
class(x)[[1]] <- "polyline"
x
}
最后，为了证明它的工作原理，我将使用这个新的 grob 绘制一些虚拟数据。您可以像绘制普通多段线 grob 一样使用它。
set.seed(100)
x <- c(cumsum(rnorm(10)), cumsum(rnorm(10)))
y <- c(cumsum(rnorm(10)), cumsum(rnorm(10)))
id <- rep(c(1, 2), each = 10)
gp <- gpar(lwd = c(2, 10), lineend = "butt",
col = c("magenta", "blue"))
grob <- linetypeGrob(scales::rescale(x),
scales::rescale(y),
id = id, gp = gp, dashes = 5, breaks = 2)
grid.newpage(); grid.draw(grob)
您可以看到，如果我调整设备大小，破折号和折线的长度保持不变：