如何在每个方面添加两个回归线方程和 R2？

Question

我想在每个方面添加两个回归线方程和 R2。我采用Jayden's function来解题，结果发现每个方程都是一样的。可能的原因是向函数发送了错误的数据子集。任何建议将不胜感激！

我的代码：

p <- ggplot(data=df,aes(x=x))+
  geom_point(aes(y = y1),size=2.0)+
  geom_smooth(aes(y = y1),method=lm,se=FALSE,size=0.5,
              fullrange = TRUE)+ # Add regression line;
  annotate("text",x = 150,y =320, label = lm_eqn(lm(y1~x,df)), # maybe wrong
           size = 2.0, parse = TRUE)+ # Add regression line equation;
  
  geom_point(aes(y = y2),size=2.0)+
  geom_smooth(aes(y = y2),method=lm,se=FALSE,size=0.5,
              fullrange = TRUE)+ # Add regression line;
  annotate("text",x = 225,y =50, label = lm_eqn(lm(y2~x,df)),
           size = 2.0, parse = TRUE)+ # Add regression line equation;
  facet_wrap(~trt)

我的数据框：

x   y1  y2  trt
22.48349    34.2    31.0    6030
93.52976    98.5    96.0    6030
163.00984   164.2   169.8   6030
205.62072   216.7   210.0   6030
265.46812   271.8   258.5   6030
23.79859    35.8    24.2    6060
99.97307    119.4   90.6    6060
189.91814   200.8   189.3   6060
268.10060   279.5   264.6   6060
325.65609   325.7   325.4   6060
357.59726   353.6   353.8   6060

我的剧情：

PS。每个面都有两条线和你的方程，两条线是对的，但两个方程是错的。显然，upper/lower 左右方面的方程式应该彼此不同。

Answer 1

1) ggplot2 首先尝试将 df 转换为长格式（参见 ## 行）。我们创建了一个注释数据框 ann，它定义了文本及其与 geom_text 一起使用的位置。请注意，由于绘图由 trt 分面，geom_text 将使用 ann 的每一行中的 trt 列将该行与适当的分面相关联。

library(ggplot2)
library(reshape2)

long <- melt(df, measure.vars = 2:3) ##

trts <- unique(long$trt)
ann <- data.frame(x = c(0, 100), 
                  y = c(250, 100), 
                  label = c(lm_eqn(lm(y1 ~ x, df, subset = trt == trts[1])), 
                            lm_eqn(lm(y2 ~ x, df, subset = trt == trts[1])),
                            lm_eqn(lm(y1 ~ x, df, subset = trt == trts[2])), 
                            lm_eqn(lm(y2 ~ x, df, subset = trt == trts[2]))),
                  trt = rep(trts, each = 2),
                  variable = c("y1", "y2"))

ggplot(long, aes(x, value)) +
       geom_point() + 
       geom_smooth(aes(col = variable), method = "lm", se = FALSE,
              full_range = TRUE) + 
       geom_text(aes(x, y, label = label, col = variable), data = ann, 
             parse = TRUE, hjust = -0.1, size = 2) +
       facet_wrap(~ trt)

ann 可以这样定义：

f <- function(v) lm_eqn(lm(value ~ x, long, subset = variable==v[[1]] & trt==v[[2]]))
Grid <- expand.grid(variable = c("y1", "y2"), trt = trts)
ann <- data.frame(x = c(0, 100), y = c(250, 100), label = apply(Grid, 1, f), Grid)

（图片后续）

2) lattice 在这种情况下使用 lattice 可能更容易：

library(lattice)

xyplot(y1 + y2 ~ x | factor(trt), df, 
       key = simpleKey(text = c("y1", "y2"), col = c("blue", "red")),
       panel = panel.superpose, 
       panel.groups = function(x, y, group.value, ...) {
          if (group.value == "y1") {
              X <- 150; Y <- 300; col <- "blue"
          } else {
              X <- 250; Y <- 100; col <- "red"
          }
          panel.points(x, y, col = col)
          panel.abline(lm(y ~ x), col = col)
          panel.text(X, Y, parse(text = lm_eqn(lm(y ~ x))), col = col, cex = 0.7)
       }
)

（图片后续）

3) latticeExtra 或者我们可以使点阵图更像 ggplot2:

library(latticeExtra)

xyplot(y1 + y2 ~ x | factor(trt), df, par.settings = ggplot2like(),
       key = simpleKey(text = c("y1", "y2"), col = c("blue", "red")),
       panel = panel.superpose, 
       panel.groups = function(x, y, group.value, ...) {
          if (group.value == "y1") {
              X <- 150; Y <- 300; col <- "blue"
          } else {
              X <- 250; Y <- 100; col <- "red"
          }
          panel.points(x, y, col = col)
          panel.grid()
          panel.abline(lm(y ~ x), col = col)
          panel.text(X, Y, parse(text = lm_eqn(lm(y ~ x))), col = col, cex = 0.7)
       }
)

（图片后续）

注：我们用这个作为df：

df <-
structure(list(x = c(22.48349, 93.52976, 163.00984, 205.62072, 
265.46812, 23.79859, 99.97307, 189.91814, 268.1006, 325.65609, 
357.59726), y1 = c(34.2, 98.5, 164.2, 216.7, 271.8, 35.8, 119.4, 
200.8, 279.5, 325.7, 353.6), y2 = c(31, 96, 169.8, 210, 258.5, 
24.2, 90.6, 189.3, 264.6, 325.4, 353.8), trt = c(6030L, 6030L, 
6030L, 6030L, 6030L, 6060L, 6060L, 6060L, 6060L, 6060L, 6060L
)), .Names = c("x", "y1", "y2", "trt"), class = "data.frame", row.names = c(NA, 
-11L))

更新

添加了彩色文本。
添加了备选 ann。
添加了格子解决方案。
在晶格解决方案中添加了 latticeExtra 变化。

如何在每个方面添加两个回归线方程和 R2？

how to add two regression line equations and R2s with each facet?

r

ggplot2

facet-wrap