使用facet在图形上添加R ^ 2

Question

我正在多个方面绘制geom_points，并希望在每个方面上注释R ^ 2（最好是在facet_label而不是图形上。）我找到了一些代码here，它会给我R ^ 2和完整数据框而不是子集的回归方程。

我的data.frame已附加。

基本上我想关联ln_x和ln_y（由于命名约定不正确，ln_x实际上在y轴上）由roi_size面对。以下是我到目前为止的情况：

lm_eqn = function(df){
    m = lm(ln_x ~ ln_y, df);
    eq <- substitute(~~R^2~"="~r2, 
                     list(r2 = format(summary(m)$r.squared, digits = 3)))
    as.character(as.expression(eq));                 
}
p2 <- ggplot(df, aes(x=ln_x, y=ln_y)) + geom_point(shape=19, aes(colour=factor(depth))) + geom_smooth(method="lm") + 
    facet_wrap(~roi_size) + scale_color_discrete("depth (mm)")

p2  + labs(y=expression(ln(frac(C[low]^air,C[low]^depth))),
           x=expression(ln(frac(C[low]^depth,C[high]^depth))) ) +
    theme(axis.title.x = element_text(colour='blue', size=16, hjust=0.9)) + 
    theme(axis.title.y = element_text(colour='blue', size=16, angle=0)) + 
    geom_text(aes(x=1.5,y=2.2,label=lm_eqn(df),family="serif"), 
       color='blue',  parse=TRUE)

这会在每个构面上打印完整数据框的R ^ 2。如何调整为每个方面的数据打印R ^ 2，因为df取决于facet变量（roi_size）。另外，我如何在构面标签而不是图形上打印文本

structure(list(roi_size = c(54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05, 54.11, 49.18, 41.06, 32.31, 23.71, 
13.85, 64.78, 72.42, 80.05), depth = c(6L, 6L, 6L, 6L, 6L, 6L, 
6L, 6L, 6L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 12L, 12L, 12L, 
12L, 12L, 12L, 12L, 12L, 12L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 4L, 4L, 4L, 4L, 4L, 4L, 
4L, 4L, 4L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L), Cl_0 = c(2717019L, 2290435L, 
1705411L, 1255867L, 676405L, 375830L, 3384555L, 3522927L, 3636684L, 
2717019L, 2290435L, 1705411L, 1255867L, 676405L, 375830L, 3384555L, 
3522927L, 3636684L, 2717019L, 2290435L, 1705411L, 1255867L, 676405L, 
375830L, 3384555L, 3522927L, 3636684L, 2717019L, 2290435L, 1705411L, 
1255867L, 676405L, 375830L, 3384555L, 3522927L, 3636684L, 2717019L, 
2290435L, 1705411L, 1255867L, 676405L, 375830L, 3384555L, 3522927L, 
3636684L, 2717019L, 2290435L, 1705411L, 1255867L, 676405L, 375830L, 
3384555L, 3522927L, 3636684L, 2717019L, 2290435L, 1705411L, 1255867L, 
676405L, 375830L, 3384555L, 3522927L, 3636684L, 2717019L, 2290435L, 
1705411L, 1255867L, 676405L, 375830L, 3384555L, 3522927L, 3636684L
), Cl_d = c(1311893L, 1176363L, 914919L, 737442L, 443761L, 276579L, 
1613011L, 1747390L, 1899656L, 2530911L, 2163881L, 1677116L, 1216875L, 
653126L, 363175L, 2985875L, 3138564L, 3324939L, 455288L, 393637L, 
307026L, 233272L, 128367L, 71947L, 577623L, 634500L, 699825L, 
2635610L, 2271192L, 1728341L, 1263713L, 675911L, 374713L, 3167048L, 
3262837L, 3405654L, 947980L, 822282L, 643571L, 491770L, 271630L, 
152706L, 1193026L, 1306287L, 1430309L, 2086247L, 1908468L, 1466086L, 
1090016L, 568628L, 308709L, 2416470L, 2544936L, 2732394L, 637259L, 
551223L, 430289L, 326529L, 179923L, 100903L, 808082L, 887548L, 
977026L, 1629081L, 1490948L, 1176605L, 948455L, 530729L, 296142L, 
1911408L, 2045920L, 2205722L), Ch_d = c(179729L, 156181L, 122603L, 
93752L, 51903L, 29190L, 225278L, 245940L, 268489L, 274540L, 239477L, 
188807L, 145219L, 80749L, 45514L, 341415L, 371116L, 402963L, 
76663L, 66425L, 51975L, 39622L, 21903L, 12308L, 96886L, 106240L, 
116792L, 296116L, 258520L, 203978L, 156945L, 87444L, 49387L, 
367877L, 399837L, 433996L, 136638L, 118579L, 92957L, 71027L, 
39303L, 22096L, 171813L, 187973L, 205771L, 230744L, 200925L, 
158061L, 121140L, 67251L, 37884L, 288238L, 314112L, 342237L, 
100033L, 86700L, 67814L, 51612L, 28495L, 16011L, 126312L, 138429L, 
151981L, 201914L, 175714L, 138119L, 105720L, 58636L, 32989L, 
252634L, 275480L, 300587L), ln_x = c(0.73, 0.67, 0.62, 0.53, 
0.42, 0.31, 0.74, 0.7, 0.65, 0.07, 0.06, 0.02, 0.03, 0.04, 0.03, 
0.13, 0.12, 0.09, 1.79, 1.76, 1.71, 1.68, 1.66, 1.65, 1.77, 1.71, 
1.65, 0.03, 0.01, -0.01, -0.01, 0, 0, 0.07, 0.08, 0.07, 1.05, 
1.02, 0.97, 0.94, 0.91, 0.9, 1.04, 0.99, 0.93, 0.26, 0.18, 0.15, 
0.14, 0.17, 0.2, 0.34, 0.33, 0.29, 1.45, 1.42, 1.38, 1.35, 1.32, 
1.31, 1.43, 1.38, 1.31, 0.51, 0.43, 0.37, 0.28, 0.24, 0.24, 0.57, 
0.54, 0.5), ln_y = c(1.99, 2.02, 2.01, 2.06, 2.15, 2.25, 1.97, 
1.96, 1.96, 2.22, 2.2, 2.18, 2.13, 2.09, 2.08, 2.17, 2.14, 2.11, 
1.78, 1.78, 1.78, 1.77, 1.77, 1.77, 1.79, 1.79, 1.79, 2.19, 2.17, 
2.14, 2.09, 2.05, 2.03, 2.15, 2.1, 2.06, 1.94, 1.94, 1.93, 1.93, 
1.93, 1.93, 1.94, 1.94, 1.94, 2.2, 2.25, 2.23, 2.2, 2.13, 2.1, 
2.13, 2.09, 2.08, 1.85, 1.85, 1.85, 1.84, 1.84, 1.84, 1.86, 1.86, 
1.86, 2.09, 2.14, 2.14, 2.19, 2.2, 2.19, 2.02, 2.01, 1.99)), .Names = c("roi_size", 
"depth", "Cl_0", "Cl_d", "Ch_d", "ln_x", "ln_y"), row.names = c(NA, 
-72L), class = "data.frame")

Answer 1

您可以创建一个新数据框，其中包含roi_size级别的等式。在这里，使用了by：

eqns <- by(df, df$roi_size, lm_eqn)
df2 <- data.frame(eq = unclass(eqns), roi_size = as.numeric(names(eqns)))

现在，此数据框可用于geom_text功能：

geom_text(data = df2, aes(x = 1.5, y = 2.2, label = eq, family = "serif"), 
          color = 'blue',  parse = TRUE)

Answer 2

这是一个完整的解决方案，包括将R ^ 2值插入构面标签，否则建立在Sven Hohenstein的解决方案之上。

首先，更改获取R ^ 2值的函数，使其仅在没有任何额外文本的情况下获取数字

lm_eqn = function(df){
  m = lm(ln_x ~ ln_y, df);
  eq <- substitute(r2, 
                   list(r2 = format(summary(m)$r.squared, digits = 3)))
  as.character(as.expression(eq));                 
}

将每个roi_size的方程式放入数据帧中（与Sven的解决方案一样），

eqns <- by(df, df$roi_size, lm_eqn)
df2 <- data.frame(eq = unclass(eqns), roi_size = as.numeric(names(eqns)))

然后将它们与新列中的roi_size连接起来

df2$lab = paste("roi_size =", df2$roi_size, "R^2 =", df2$eq, sep=" ")

制作标签功能，引用您的标签数据框

r2_labeller <- function(variable,value){
  return(df2$lab)
}

然后在调用facet_wrap时使用标签函数进行绘图

ggplot(df, aes(x=ln_x, y=ln_y)) +
  geom_point(shape=19, aes(colour=factor(depth))) + 
  geom_smooth(method="lm") + 
  facet_wrap(~roi_size, labeller = r2_labeller) + 
  scale_color_discrete("depth (mm)") +
  labs(y=expression(ln(frac(C[low]^air,C[low]^depth))),
           x=expression(ln(frac(C[low]^depth,C[high]^depth))) ) +
  theme(axis.title.x = element_text(colour='blue', size=16, hjust=0.9)) + 
  theme(axis.title.y = element_text(colour='blue', size=16, angle=0))

Answer 3

以下似乎有效

  lm_eqn = function(df){
    m = lm(ln_x ~ ln_y, data=df)
    eq <- substitute(~~R^2~"="~r2, 
                      list(r2 = format(summary(m)$r.squared, digits = 3)))
    c(eq = as.character(as.expression(eq)));                 
 }

为每个roi_size

创建包含R ^ 2的新数据框

labeldata <- ddply(df,.(roi_size),lm_eqn )

和geom_text成为

geom_text(data=labeldata,aes(x=1.5,y=2.2,label=eq,family="serif"), color='blue',  parse=TRUE)