ggplot2：在非正交（例如-45度）轴上投影点或分布

Question

下图是Michael Clark使用的概念图， https://m-clark.github.io/docs/lord/index.html ，用于解释洛德悖论以及回归中的相关现象。

我的问题是在这种背景下提出并使用的ggplot2，但它在几何和图形方面更广泛。

我想重现这样的数字，但使用实际数据。我需要知道：

• 如何在原点绘制一个新轴，角度为 -45 度，对应于以下值y-x
• 如何绘制小正态分布或密度图，或y-x投影到该轴上的值的其他表示形式。

我的最小基本示例使用ggplot2，

library(ggplot2)
set.seed(1234)
N <- 200
group   <- rep(c(0, 1), each = N/2)
initial <- .75*group + rnorm(N, sd=.25)
final   <- .4*initial + .5*group + rnorm(N, sd=.1)
change  <- final - initial
df <- data.frame(id = factor(1:N), 
                group = factor(group, 
                               labels = c('Female', 'Male')), 
                initial, 
                final, 
                change)
#head(df)

#' plot, with regression lines and data ellipses
ggplot(df, aes(x = initial, y = final, color = group)) +
    geom_point() + 
    geom_smooth(method = "lm", formula  =  y~x) +
  stat_ellipse(size = 1.2) +
  geom_abline(slope  =  1, color = "black", size = 1.2) +
  coord_fixed(xlim = c(-.6, 1.2), ylim = c(-.6, 1.2)) +
  theme_bw() +
  theme(legend.position = c(.15, .85)) 

这给出了下图：

在几何中，我想要描绘的分布的 -45 度旋转轴的坐标是绘图原始空间中的 (yx)、(x+y)。但是我如何用 ggplot2其他软件绘制这些呢？

可接受的解决方案可能对如何表示 (yx) 的分布含糊不清，但应该解决如何在 (yx) 轴上显示它的问题。

Answer 1

有趣的问题！我还没有遇到过，但可能有一个包可以帮助自动执行此操作。这是使用两种技巧的手动方法：

1. clip = "off"函数的参数，coord_*允许我们在绘图区域之外添加注释。
2. 构建密度图，提取其坐标，然后旋转和平移它们。

首先，我们可以绘制从初始到最终变化的密度图，看到左偏分布：

(my_hist <- df %>%
    mutate(gain = final - initial) %>% # gain would be better name
    ggplot(aes(gain)) +
    geom_density())

现在我们可以提取该图的内容，并将坐标转换为我们希望它们出现在组合图中的位置：

a <- ggplot_build(my_hist)
rot = pi * 3/4
diag_hist <- tibble(
  x = a[["data"]][[1]][["x"]],
  y = a[["data"]][[1]][["y"]]
) %>%
  # squish
  mutate(y = y*0.2) %>%
  # rotate 135 deg CCW
  mutate(xy = x*cos(rot) - y*sin(rot),
         dens = x*sin(rot) + y*cos(rot)) %>%
  # slide
  mutate(xy = xy - 0.7,  #  magic number based on plot range below
         dens = dens - 0.7)

这是与原始情节的组合：

ggplot(df, aes(x = initial, y = final, color = group)) +
  geom_point() + 
  geom_smooth(method = "lm", formula  =  y~x) +
  stat_ellipse(size = 1.2) +
  geom_abline(slope  =  1, color = "black", size = 1.2) +
  coord_fixed(clip = "off", 
              xlim = c(-0.7,1.6),
              ylim = c(-0.7,1.6), 
              expand = expansion(0)) +
  annotate("segment", x = -1.4, xend = 0, y = 0, yend = -1.4) +
  annotate("path", x = diag_hist$xy, y = diag_hist$dens) +
  theme_bw() +
  theme(legend.position = c(.15, .85), 
        plot.margin = unit(c(.1,.1,2,2), "cm"))