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

Question

我想在每个方面添加两个回归线方程和 R2。我采用了杰登的函数来解决这个问题，但我发现每个方程都是一样的。可能的原因是向函数发送了错误的数据子集。任何建议将被认真考虑！

我的代码：

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。每个方面有两条线和你的方程，两条线是对的，但两个方程是错误的。显然，左右方面的上/下方程应该彼此不同。

Answer 1

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

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 变体。