R 使用ggplot2：创建具有缩放和移动密度的镶嵌面散点图

我想使用facet_wrap将一些数据绘制为散点图，同时叠加一些信息，如线性回归和密度。 我设法做到了这一切，但密度值与我的点不成比例，这是正常的，因为这些点很远。然而，我想缩放和移动我的密度曲线，使它清晰可见；我不在乎它的真正价值，更在乎它的形状

下面是一个夸张的最小工作示例：

set.seed(48151623)
mydf <- data.frame(x1=rnorm(mean=5,n=100),x2=rnorm(n=100,mean=10),x3=rnorm(n=100,mean=20,sd=3))
mydf$var <- mydf$x1 + mydf$x2 * mydf$x3 
mydf.wide  <- melt(mydf,id.vars='var',measure.vars=c(1:3))
ggplot(data=mydf.wide,aes(x=value,y=var)) +
  geom_point(colour='red') +
  geom_smooth(method='lm') +
  stat_density(aes(x=value,y=..scaled..),position='identity',geom='line') +
  facet_wrap(~variable,scale='free_x')

理想情况下，我会使用

y=…scaled..*diff（range（value））+min（value）

，但当我这样做时，我得到一个错误，说找不到“value”。我怀疑问题与刻面有关，但我更愿意保留我的刻面

在这种情况下，如何缩放和移动密度曲线

---

我不确定这是否完全回答了你的问题，但太长了，无法发表评论，所以。。。在回答问题中的第二段代码时，由于您已经定义了

x=value

，因此可以在y的定义中使用

x

而不是

value

stat_density(aes(x=value,y=..scaled..*diff(range(x)) + 
min(x)),position='identity',geom='line')

这似乎可以修复错误并生成以下绘图：

---

当然，唯一的问题是，如果数据的y值很低，那么密度曲线仍然会与散点图重叠。但是，如果不是这样的话，我个人认为这是一个相当有用的数字，只要你能有效地传达y轴值在解释密度曲线时并不重要——只有曲线的形状才重要。

我建议绘制两个图，并将它们与

网格相结合。排列
：

p1 <- ggplot(data=mydf.wide,aes(x=value,y=var)) +
  geom_point(colour='red') +
  geom_smooth(method='lm') +
  facet_wrap(~variable,scale='free_x') +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        plot.margin =       unit(c(1, 1, 0, 0.5), "lines"))

p2 <- ggplot(data=mydf.wide,aes(x=value,y=var)) +
  stat_density(aes(x=value,y=..scaled..),position='identity',geom='line') +
  facet_wrap(~variable,scale='free_x') + 
  theme(strip.background=element_blank(),
        strip.text=element_blank(),
        plot.margin =       unit(c(-1, 1, 0.5, 0.35), "lines"))

library(gridExtra)
grid.arrange(p1, p2, heights = c(2,1))

p1我感谢大家的回答，这让我更好地理解了ggplot的基本机制。我也意识到我的要求有多尴尬；ggplot解决不了我的问题。
我没有使用ggplot
stat_density
而是在另一个数据框中直接计算我的密度，而是实现了我想要的目标：

set.seed(48151623)
mydf <- data.frame(x1=rnorm(mean=5,n=100),x2=rnorm(n=100,mean=10),x3=rnorm(n=100,mean=20,sd=3))
mydf$var <- mydf$x1 + mydf$x2 * mydf$x3 
mydf.wide  <- melt(mydf,id.vars='var',measure.vars=c(1:3))

mydf.densities <- do.call('rbind',lapply(unique(mydf.wide$variable), function(var) {
  tmp <- mydf.wide[which(mydf.wide$variable==var),c('var','value')]
  dfit <- density(tmp$value,cut=0)
  scaledy <-dfit$y/max(dfit$y) * diff(range(tmp$var)) + min(tmp$var)
  data.frame(x=dfit$x,y=scaledy,variable=rep(var,length(dfit$x)))
}))
ggplot(data=mydf.wide,aes(x=value,y=var)) +
  geom_point(colour='red') +
  geom_smooth(method='lm') +
  geom_line(aes(x=x,y=y),data=mydf.densities) +
  facet_wrap(~variable,scale='free_x')

set.seed（48151623）
mydf在
mydf.wide
中创建一个具有最大y值的新变量
mx
，然后传递
y=…scaled.*mx不工作在我看来，即使不是一个bug，至少是一个意想不到的行为。我脑海中唯一能想到的另一个选择是旧的备用：计算ggplot之外的密度，并将其存储在单独的数据框中。使用单独的data.frame计算密度正是它们在这里所做的：但我一直无法让它为我工作。基于我对您的代码的测试，我会感到惊讶（和困惑）如果您链接到的代码仍然有效。当然可以，因为该代码用于网格方面。这个主意看起来不错，但我的意思是我不能适应我的情况。这真的是个好主意吗？为什么不使用刻面，并在散点图上方使用具有自己y比例的密度曲线？你想要达到的目标听起来很像双轴，这一直都是很难达到的。我认为，这个想法是，同一个面板中的两个数据集不应该有不同的y比例，因为人类的感知倾向于将注意力集中在交叉线、相对坡度等上。如果字形之间的比例不同，这些都是没有意义的。而且，考虑添加一个使用<代码> GeoMug Rug < /代码>。有人发布了这个解决方案并擦除了它；我不知道为什么。在评论中，我们讨论了问题在于，我们的想法是将密度图移动到y的范围，而不是x的范围，x的范围约为[2,26]。
set.seed(48151623)
mydf <- data.frame(x1=rnorm(mean=5,n=100),x2=rnorm(n=100,mean=10),x3=rnorm(n=100,mean=20,sd=3))
mydf$var <- mydf$x1 + mydf$x2 * mydf$x3 
mydf.wide  <- melt(mydf,id.vars='var',measure.vars=c(1:3))

mydf.densities <- do.call('rbind',lapply(unique(mydf.wide$variable), function(var) {
  tmp <- mydf.wide[which(mydf.wide$variable==var),c('var','value')]
  dfit <- density(tmp$value,cut=0)
  scaledy <-dfit$y/max(dfit$y) * diff(range(tmp$var)) + min(tmp$var)
  data.frame(x=dfit$x,y=scaledy,variable=rep(var,length(dfit$x)))
}))
ggplot(data=mydf.wide,aes(x=value,y=var)) +
  geom_point(colour='red') +
  geom_smooth(method='lm') +
  geom_line(aes(x=x,y=y),data=mydf.densities) +
  facet_wrap(~variable,scale='free_x')