如何在 ggplot2 中围绕虚线绘制轮廓或边框？

Question

我有一个图，我试图将各个感兴趣组的线性回归线与整个样本的线性拟合进行比较。

library(ggplot2);library(curl)
df<-read.csv(curl("https://raw.githubusercontent.com/megaraptor1/mydata/main/example.csv"))
df$group<-as.factor(df$group)
ggplot(df %>% group_by(group),
       aes(x,y,col=group))+
  geom_point(size=2.5,shape=21,aes(fill=group),col="black")+
  scale_x_continuous(breaks=seq(1,3.25,0.25))+
  scale_y_continuous(breaks=seq(0,17,1))+
  geom_smooth(data=df %>% group_by(group),
              formula=y~x,method="lm",level=0.9,se=F)+  
  geom_smooth(data=df,linetype="dashed",fill="white",colour="black",size=.75)+
  geom_smooth(data=df,linetype="dashed",fill="white",colour="black",size=1)+
  labs(color="group",fill="group")+
  guides(color=guide_legend(ncol=2),fill=guide_legend(ncol=2))+
  theme_classic()+
  theme(legend.position = "none")

在此图中，所有样本的拟合均由黑色虚线表示。然而，这条线与周围的数据并没有太大区别，很难看到。我想在黑色虚线周围放置一个白色轮廓，以使其突出并从周围的数据中脱颖而出。

但是，我无法通过 ggplot2 这样做。我知道可以通过在黑线后面绘制一条稍粗的白线来通过非虚线来做到这一点。但是如果我尝试用虚线这样做，它不会产生预期的效果（见上面的代码），因为改变线条的粗细也会改变虚线的长度和间距，因此两者不会对齐并且使黑色虚线弹出。

有什么方法可以在ggplot中设置虚线的边框，在黑色虚线周围绘制白色边框？

Answer 1

我们可以将数据重新参数化为段以表示虚线。首先，我们获取拟合所需的数据。

library(tidyverse)
library(ggplot2)

df<-read.csv(curl::curl("https://raw.githubusercontent.com/megaraptor1/mydata/main/example.csv"))
df$group<-as.factor(df$group)

line <- layer_data(ggplot(mapping = aes(x, y)) + geom_smooth(data = df))
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

然后，我们可以在固定距离处对线进行插值，得到虚线段。

dash_length <- 0.025
xrange <- range(line$x)
xstart <- seq(xrange[1], xrange[2], by = dash_length * 2)
xend <- xstart + dash_length

linedat <- data.frame(
  x = xstart,
  xend = xend,
  y = approx(line$x, line$y, xout = xstart, rule = 2)$y,
  yend = approx(line$x, line$y, xout = xend, rule = 2)$y
)

然后，您可以将这些虚线段添加为一条宽白线和一条细黑线，以呈现白色轮廓。

ggplot(df %>% group_by(group),
       aes(x,y,col=group))+
  geom_point(size=2.5,shape=21,aes(fill=group),col="black")+
  scale_x_continuous(breaks=seq(1,3.25,0.25))+
  scale_y_continuous(breaks=seq(0,17,1))+
  geom_smooth(data=df %>% group_by(group),
              formula=y~x,method="lm",level=0.9,se=F)+  
  geom_segment(
    data = linedat,
    aes(x = x, y = y, xend = xend, yend = yend),
    colour = "white", size = 2, lineend = "round"
  ) +
  geom_segment(
    data = linedat,
    aes(x = x, y = y, xend = xend, yend = yend),
    colour = "black", size = 1
  ) +
  labs(color="group",fill="group")+
  guides(color=guide_legend(ncol=2),fill=guide_legend(ncol=2))+
  theme_classic()+
  theme(legend.position = "none")

^{由reprex package (v1.0.0) 于 2021-04-05 创建}

请注意，如果直线不直，此方法可能会产生倾斜的结果。

Answer 2

诀窍是先绘制平滑线，然后在它们上面绘制虚线。
为了有白色背景并使黑色虚线突出，请在黑色虚线之前绘制一条较大的白线。

library(ggplot2)
library(curl)

df <- read.csv(curl("https://raw.githubusercontent.com/megaraptor1/mydata/main/example.csv"))
df$group <- factor(df$group)

ggplot(df, aes(x, y, color = group)) +
  geom_point(aes(fill = group), size = 2.5, shape = 21, color = "black") +
  geom_smooth(formula = y ~ x, method = "lm", se = FALSE) +  
  # First plot the background solid white line
  geom_smooth(
    method = loess,
    formula = y ~ x,
    se = FALSE,
    linetype = "solid",
    colour = "white",
    size = 2
  ) +
  # Then a dashed black line on top of it
  # This line is narrower than the background one
  geom_smooth(
    method = loess,
    formula = y ~ x,
    se = FALSE,
    linetype = "dashed",
    colour = "black",
    size = 1.5
  ) +
  #
  scale_x_continuous(breaks = seq(1,3.25,0.25)) +
  scale_y_continuous(breaks = seq(0,17,1)) +
  theme_classic() +
  theme(legend.position = "none")

Answer 3

或者我们可以将alpha=0.2 添加到geom_point()

ggplot(df %>% group_by(group),
       aes(x,y,col=group))+
  geom_point(size=2.5,shape=21,aes(fill=group),col="black", alpha = 0.2)+
  scale_x_continuous(breaks=seq(1,3.25,0.25))+
  scale_y_continuous(breaks=seq(0,17,1))+
  geom_smooth(data=df %>% group_by(group),
              formula=y~x,method="lm",level=0.9,se=F)+  
  geom_smooth(data=df,linetype="dashed",fill="white",colour="black",size=.75)+
  geom_smooth(data=df,linetype="dashed",fill="white",colour="black",size=1)+
  labs(color="group",fill="group")+
  guides(color=guide_legend(ncol=2),fill=guide_legend(ncol=2))+
  theme_classic()+
  theme(legend.position = "none")

输出：