使用gratia::draw转换轴刻度时图形出现白线的解决方法

问题场景 #

使用qgam构建分位数GAM模型，通过gratia的draw()函数绘制平滑曲面，移除默认图层后添加散点图，未转换轴刻度时图形显示正常，但添加modulus_trans()轴转换后，图形出现多余白线，需解决该问题。

重现代码 #

加载包并构建模型

library("mgcv")
library("qgam")
library("gratia")
library("ggplot2")
library("dplyr")
library("scales")

# 构建qgam模型
qg0 <- qgam(z0 ~ te(x0, y0, k=c(5,5), bs=c("cr","cr")), data=dat0, qu=0.5)

# 使用gratia绘图并移除第二个图层
sm0 <- smooth_estimates(qg0)
dw0 <- draw(qg0)
dw0$layers[[2]] <- NULL  

正常图形（无轴转换）

dw0 +
  geom_point(data=dat0, aes(x=x0, y=y0), size=3, shape=21, fill="black", alpha=0.3)

出现问题的图形（添加轴转换）

dw0 +
  geom_point(data=dat0, aes(x=x0, y=y0), size=3, shape=21, fill="black", alpha=0.3) +
  scale_x_continuous(trans = modulus_trans(0.5)) +
  scale_y_continuous(trans = modulus_trans(0.5))

数据 #

dat0 <-
structure(list(x0 = c(2.44, 2.76, 2.53, 2.31, 2.9, 2.51, 2.82, 
2.98, 2.53, 2.42, 2.66, 2.36, 2.78, 2.44, 2.24, 2.31, 2.65, 2.93, 
2.71, 2.62, 2.66, 2.37, 2.99, 2.9, 2.7, 2.9, 2.98, 2.55, 2.28, 
2.36, 2.19, 2.85, 2.75, 2.65, 2.69, 2.77, 2.71, 2.2, 2.54, 2.52, 
2.49, 2.7, 2.83, 2.99, 2.87, 2.66, 2.65, 2.6, 2.16, 2.04, 2.66, 
2.11, 2.81, 2.76, 2.88, 2.49, 2.56, 2.87, 2.98, 2.59, 2.91, 2.11, 
2.58, 2.72, 2.47, 2.87, 2.51, 2.07, 2.95, 2.66, 2.88, 2.61, 2.62, 
2.5, 3, 2.76, 2.91, 2.67, 2.29, 2.83, 2.43, 2.37, 2.78, 3, 2.1, 
2.34, 2.73, 2.95, 2.69, 2.88, 2.95, 2.95, 2.83, 2.66), y0 = c(0.7, 
1.48, 5.85, 3.47, 0.48, 6.38, 0.64, 2.24, 4.9, 0.29, 4.54, 2.08, 
0.9, 0.53, 1.2, 3.95, 2.65, 1.32, 5.59, 1.14, 1.96, 1.06, 5.9, 
2.2, 0.54, 3.49, 1.51, 2.5, 0.67, 3.05, 1.47, 2.05, 1.25, 1.01, 
1.98, 1.1, 2.72, 1.75, 2.92, 2.83, 0.89, 0.43, 2.25, 0.96, 1.57, 
2.92, 3.15, 0.72, 0.41, 3.64, 2.9, 7.48, 0.71, 1.91, 3.19, 0.8, 
2.74, 5.05, 1.35, 0.9, 1.15, 1.12, 2.65, 1.76, 3.12, 5.38, 3.47, 
1.92, 1.31, 2.29, 0.89, 0.92, 0.8, 2.1, 1.5, 2.69, 2.03, 0.52, 
1.79, 3.06, 4.28, 5.13, 0.55, 2.61, 0.67, 2.8, 0.77, 0.61, 4.7, 
0.77, 0.54, 4.44, 2.25, 0.46), z0 = c(1.7, 4.09, 14.79, 8.01, 
1.4, 16.02, 1.81, 6.66, 12.39, 0.7, 12.04, 4.91, 2.51, 1.29, 
2.69, 9.12, 7.02, 3.86, 15.14, 2.98, 5.2, 2.51, 17.66, 6.37, 
1.46, 10.12, 4.5, 6.37, 1.52, 7.19, 3.22, 5.84, 3.45, 2.69, 5.32, 
3.04, 7.37, 3.86, 7.42, 7.13, 2.22, 1.17, 6.37, 2.87, 4.5, 7.78, 
8.36, 1.87, 0.88, 7.42, 7.72, 15.79, 1.99, 5.26, 9.18, 1.99, 
7.02, 14.5, 4.03, 2.34, 3.33, 2.37, 6.84, 4.79, 7.72, 15.44, 
8.71, 3.98, 3.86, 6.08, 2.57, 2.4, 2.1, 5.26, 4.5, 7.42, 5.9, 
1.4, 4.09, 8.65, 10.41, 12.16, 1.52, 7.83, 1.4, 6.55, 2.1, 1.81, 
12.63, 2.22, 1.58, 13.1, 6.37, 1.23)), row.names = c(NA, -94L
), class = "data.frame")

解决方案 #

白线出现的原因是draw()生成的ggplot对象中，曲面图层的坐标基于原始数据刻度，添加轴转换后，ggplot会对这些图层的坐标强制应用转换，导致曲面边缘点连接异常。

方法1：手动基于平滑估计数据构建绘图 #

直接对平滑估计数据和原始数据提前应用轴转换，再绘制图形：

# 对平滑估计数据应用轴转换
sm0_trans <- sm0 %>%
  mutate(
    x0 = modulus_trans(0.5)$transform(x0),
    y0 = modulus_trans(0.5)$transform(y0)
  )

# 手动绘制曲面+散点
ggplot(sm0_trans, aes(x = x0, y = y0)) +
  geom_raster(aes(fill = est), interpolate = TRUE) +
  geom_contour(aes(z = est), colour = "white", linewidth = 0.5) +
  geom_point(data = dat0 %>% mutate(
    x0 = modulus_trans(0.5)$transform(x0),
    y0 = modulus_trans(0.5)$transform(y0)
  ), aes(x = x0, y = y0), size = 3, shape = 21, fill = "black", alpha = 0.3) +
  scale_fill_viridis_c() +
  # 设置轴标签为原始刻度的转换后显示
  scale_x_continuous(
    breaks = seq(2, 3, 0.2),
    labels = round(modulus_trans(0.5)$inverse(seq(2, 3, 0.2)), 2)
  ) +
  scale_y_continuous(
    breaks = seq(0, 7, 1),
    labels = round(modulus_trans(0.5)$inverse(seq(0, 7, 1)), 2)
  ) +
  labs(x = "x0", y = "y0", fill = "Estimate") +
  theme_minimal()

方法2：修改draw()生成的图层 #

移除draw()生成的原始曲面图层，重新基于转换后的数据绘制曲面：

# 移除draw()生成的第一个曲面图层，重新添加转换后的曲面
dw0_fixed <- dw0 %>%
  remove_layers(1) %>%
  geom_raster(data = sm0 %>% mutate(
    x0 = modulus_trans(0.5)$transform(x0),
    y0 = modulus_trans(0.5)$transform(y0)
  ), aes(x = x0, y = y0, fill = est), interpolate = TRUE) %>%
  geom_contour(data = sm0 %>% mutate(
    x0 = modulus_trans(0.5)$transform(x0),
    y0 = modulus_trans(0.5)$transform(y0)
  ), aes(x = x0, y = y0, z = est), colour = "white", linewidth = 0.5) %>%
  scale_x_continuous(trans = modulus_trans(0.5)) %>%
  scale_y_continuous(trans = modulus_trans(0.5)) %>%
  geom_point(data=dat0, aes(x=x0, y=y0), size=3, shape=21, fill="black", alpha=0.3)

dw0_fixed

内容的提问来源于stack exchange，提问作者denis