如何结合 geom_smooth() 修复 x 和 y 轴？

Question

我正在尝试使用相同的 x 和 y 刻度线（即纵横比 =1）制作方形图。 最初我想将 facet_wrap 与 ggplot 一起使用，但是从 stackoverflow 上的许多问题中阅读，我意识到这是不可能的。所以现在我想把它们一张一张地画出来，最后用 grid.arrange 来组织这些图。 但它仍然不适合我。我可以让轴正确，但现在来自 geom_smooth() 的置信区间不再正确绘制。

dat <- structure(list(analyte = structure(c(2L, 8L, 9L, 5L, 6L, 4L, 
1L, 7L, 10L, 3L, 9L, 10L, 7L, 7L, 10L, 10L, 10L, 10L, 6L, 6L, 
10L, 6L, 4L, 6L, 7L, 4L, 2L, 10L, 10L, 4L, 2L, 6L, 6L, 8L, 10L, 
1L, 1L, 3L, 8L, 2L, 1L, 10L, 7L, 6L, 3L, 3L, 7L, 7L, 6L, 6L, 
9L, 5L, 9L, 7L, 6L, 7L, 8L, 7L, 5L, 7L, 5L), .Label = c("Alanine", 
"Glutamic acid", "Glutamine", "Glycine", "Histidine", "Isoleucine", 
"Leucine", "Phenylalanine", "Tyrosine", "Valine"), class = "factor"), 
    x = c(23.8, 51.5, 68.8, 83.5, 165.8, 178.6, 201.1, 387.4, 
    417.7, 550.1, 101.4, 103.1, 115.5, 119.9, 131.4, 156.9, 157.2, 
    169.9, 170.1, 174.6, 204.3, 21.8, 218.7, 22.2, 220.3, 226, 
    24.3, 259.3, 263.1, 301, 38.7, 39.8, 41.5, 42.4, 428.9, 431.7, 
    437.2, 440.1, 46.7, 47, 462.6, 470.1, 474.5, 51.3, 512.3, 
    516.4, 527.2, 547.3, 57.3, 58.5, 60.6, 63.9, 65.9, 69.9, 
    71.8, 771.9, 81.2, 82.4, 82.6, 823.5, 83.8), y = c(100L, 
    50L, 50L, 80L, 160L, 210L, 240L, 390L, 340L, 620L, 70L, 90L, 
    70L, 90L, 130L, 130L, 160L, 130L, 160L, 150L, 180L, 30L, 
    140L, 30L, 230L, 210L, 60L, 230L, 270L, 250L, 60L, 30L, 50L, 
    50L, 390L, 480L, 460L, 410L, 50L, 290L, 410L, 420L, 440L, 
    50L, 530L, 730L, 530L, 400L, 50L, 40L, 40L, 100L, 50L, 70L, 
    70L, 750L, 50L, 70L, 110L, 800L, 160L)), class = "data.frame", row.names = c(NA, 
-61L))

还有剧情：

my.formula <- y ~ x

p1 <- ggplot(dat[which(dat$analyte== 'Alanine'),], aes(x = x, y = y))+ geom_point()+
   scale_x_continuous(limits=c(min(dat[which(dat$analyte== 'Alanine'),]$x, dat[which(dat$analyte== 'Alanine'),]$y), max(dat[which(dat$analyte== 'Alanine'),]$x,dat[which(dat$analyte== 'Alanine'),]$y))) +
                             scale_y_continuous(limits=c(min(dat[which(dat$analyte== 'Alanine'),]$x, dat[which(dat$analyte== 'Alanine'),]$y), max(dat[which(dat$analyte== 'Alanine'),]$x,dat[which(dat$analyte== 'Alanine'),]$y))) +
  geom_smooth(method='lm') + stat_poly_eq(formula = my.formula, aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
              parse = T, size=3)
p1 

更新： 所以我尝试将建议的代码和我自己的一些设置结合起来，我越来越接近了。但这让我发疯，为什么置信区间没有在某些图中绘制并且在一个图中绘制错误（丙氨酸）（见最后一张图）？

更新后的代码：

dat_split <- split(dat, dat$analyte)

plots <- 
  lapply(dat_split, function(df)
    ggplot(df, aes(x = x, y = y)) +
      geom_point() +
      scale_x_continuous(expand= c(0,0), limits=c(min(as.numeric(min(df$x)-as.numeric(1/8*min(df$x))), as.numeric(min(df$y)-as.numeric(1/8*min(df$y)))), max(as.numeric(max(df$x)+as.numeric(1/8*max(df$x))), as.numeric(max(df$y)+as.numeric(1/8*max(df$y)))))) +
      scale_y_continuous(expand= c(0,0), limits=c(min(as.numeric(min(df$x)-as.numeric(1/8*min(df$x))), as.numeric(min(df$y)-as.numeric(1/8*min(df$y)))), max(as.numeric(max(df$x)+as.numeric(1/8*max(df$x))), as.numeric(max(df$y)+as.numeric(1/8*max(df$y)))))) +
      theme(aspect.ratio = 1) +
      geom_smooth(method = 'lm', inherit.aes = T, se=T) +
      ggtitle(df$analyte[1]) +
      ggpmisc::stat_poly_eq(formula = my.formula, 
                            aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                            parse = TRUE, size=3))


gridExtra::grid.arrange(grobs = plots)

Answer 1

这似乎大致符合您的要求。对于某些分析物因子，x 和 y 范围有很大不同，所以我不确定您是否真的想用相同的轴显示它们。

dat_split <- split(dat, dat$analyte)

plots <- 
   lapply(dat_split, function(df)
     ggplot(df, aes(x = x, y = y)) +
     geom_point() +
     coord_equal() +
     geom_smooth(method = 'lm', inherit.aes = T) +
     ggtitle(df$analyte[1]) +
     ggpmisc::stat_poly_eq(formula = my.formula, 
                      aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
             parse = T, size=3))

gridExtra::grid.arrange(grobs = plots)