r - 在 ggplot 中动态定位在多行上的表达式

Question

我正在尝试创建一个带有四个动态定位的表达式行的图。它应该看起来像下面的图(我必须通过将每个表达式放在不同的代码行上并手动设置 x 和 y 坐标来手动执行此操作，但我想将其自动化，因为我有很多图要做):

所有的图都有不同的比例，所以如果我可以将表达式组合为一个对象来定位在右上角，那就太好了。我正在使用的代码如下:

dat <- data.frame("x" = sample(1:100, 800, replace = T),
                  "y" = sample(1:100, 800, replace = T))
                  
mod <- lm(y ~ poly(x, 1, raw =T), dat)

eq <- linEq(mod, 3)
r2 <- bquote(italic("R")^2~"="~.(round(summary(mod)$adj.r.squared, 2)))
f.value <- round(summary(mod)$fstatistic[[1]], 2)
df1 <- summary(mod)$fstatistic[[2]]
df2 <- summary(mod)$fstatistic[[3]]
f.text <- bquote(italic("F")[.(df1)*","~.(df2)]~"="~.(f.value))
p.value <- bquote(italic("p")~.(ifelse(lmp(mod) < 0.001, "<", "="))~.(ifelse(lmp(mod) < 0.001, "0.001", round(lmp(mod),3))))

p <- ggplot(data=dat, aes(x = x, y = y))+
  geom_point()+
  geom_smooth(method='lm', formula= y ~ x, se = F)+
  xlab("X")+
  ylab("Y")+
  annotate(geom = "text", x = (1*max(dat$x)), y = (1*max(dat$y)),
           label = paste0(eq, r2, f.text, p.value, sep = "\n"),
           parse = T,
           hjust = "inward")+
  theme_classic()

但我收到此错误:

Error in parse(text = text[[i]]) : :1:18: unexpected symbol1: y = 51.5 + 0.0278x^

我知道我可以使用 deparse()函数与每个单一的表达式(这就是我创建图像时所做的)，但我不知道如何将它集成到我的代码中，以便我可以自动定位所有四行。
任何想法将不胜感激!
非常感谢，
卡罗莱纳州
需要一些自定义函数才能使上述代码工作。它们如下:

linEq <- function(lmObj, dig) {
  paste0(c("","y = "),
         c("",signif(lmObj$coef[1], dig)),
         c("",ifelse(sign(lmObj$coef)[2]==1," + "," - ")),
         c("",signif(abs(lmObj$coef[2]), dig)), c("", "x"),
         collapse="")
}

lmp <- function (modelobject) {
  if (class(modelobject) != "lm") stop("Not an object of class 'lm' ")
  f <- summary(modelobject)$fstatistic
  p <- pf(f[1],f[2],f[3],lower.tail=F)
  attributes(p) <- NULL
  return(p)
}

Answer 1

我不经常使用数学符号。这可能就是为什么我总是在使用它以及用不同的方式将它们添加到 ggplot 中挣扎的原因。对我来说最有效的是使用 paste0 设置 plotmath 字符串。 .所以我改写了你的bquote s 使用 paste0 .我还对你的乐趣做了两个小改动linEq (将 = 替换为 == ，在 x 之前添加了 *)。
为了把你的四个标签放在图上，我把它们放在一个向量中，并将 y 位置设置为一个向量。
但是，我的方法不会自动为您的标签选择正确的 x 和 y 位置。我不认为有一种简单的方法可以实现这一目标，并且适用于每种情况。这就是我选择将标签放在情节顶部的原因。
感谢@teunbrand 的评论:至少对于标签的 x 轴位置，您可以做 x=Inf对齐图右侧的标签。

library(ggplot2)

set.seed(42)

dat <- data.frame(
  "x" = sample(1:100, 800, replace = T),
  "y" = sample(1:100, 800, replace = T)
)

mod <- lm(y ~ poly(x, 1, raw = T), dat)

linEq <- function(lmObj, dig) {
  paste0(c("", "y == "),
    c("", signif(lmObj$coef[1], dig)),
    c("", ifelse(sign(lmObj$coef)[2] == 1, " + ", " - ")),
    c("", signif(abs(lmObj$coef[2]), dig)), c("", "* x"),
    collapse = ""
  )
}

lmp <- function(modelobject) {
  if (class(modelobject) != "lm") stop("Not an object of class 'lm' ")
  f <- summary(modelobject)$fstatistic
  p <- pf(f[1], f[2], f[3], lower.tail = F)
  attributes(p) <- NULL
  return(p)
}


eq <- linEq(mod, 3)
r2 <- paste0("italic(R)^{2} == ", round(summary(mod)$adj.r.squared, 2))
f.value <- round(summary(mod)$fstatistic[[1]], 2)
df1 <- summary(mod)$fstatistic[[2]]
df2 <- summary(mod)$fstatistic[[3]]
f.text <- paste0("italic(F)['", df1, ",", df2, "'] == ", f.value)
p.value <- paste0("italic(p) ", ifelse(lmp(mod) < 0.001, "<", "=="), ifelse(lmp(mod) < 0.001, "0.001", round(lmp(mod), 3)))

ggplot(data = dat, aes(x = x, y = y)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x, se = F) +
  xlab("X") +
  ylab("Y") +
  annotate(
    geom = "text", x = (1 * max(dat$x)), y = c(2, 1.8, 1.6, 1.4) * max(dat$y),
    label = c(eq, r2, f.text, p.value),
    parse = TRUE,
    hjust = "inward"
  ) +
  theme_classic()

编辑 也许这符合您的需求。不确定这是否适用于您的所有图，但是......下面的方法首先通过 grid 对来自标签的对象进行处理。包裹。其次，利用 patchwork 包，您可以将它们添加为右上角的插图。使用 patchwork 的一个警告是不是不适用于 grid.arrange (至少我有一个错误)，即您必须使用 patchwork 将您的图粘合在一起也。例如，我通过简单地将 x 和 y 缩放 10 添加了第二个图:
备注 图片不显示子/上标。但它们显示在绘图窗口以及保存绘图时。

library(patchwork)

make_grob <- function(labels, y, size = unit(8, "pt")) {
  grob_list <- purrr::map2(labels, y, 
              ~ grid::textGrob(scales::parse_format()(.x), hjust = 1, 
                       x = grid::unit(1, "npc"), y = grid::unit(.y, "npc"), 
                       gp = grid::gpar(fontsize = size))
              
              )
  
  grid::grobTree(grob_list[[1]], grob_list[[2]], grob_list[[3]], grob_list[[4]])
}


gt <- make_grob(list(eq, r2, f.text, p.value), y = seq(.2, .8, .2))
gg1 <- ggplot(data = dat, aes(x = x, y = y)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x, se = F) +
  xlab("X") +
  ylab("Y") +
  theme_classic() +
  patchwork::inset_element(gt, left = .7, bottom = .7, right = 1, top = 1, align_to = "plot", on_top = TRUE)

gg2 <- ggplot(data = dat, aes(x = 10 * x, y = 10 * y)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x, se = F) +
  xlab("X") +
  ylab("Y") +
  theme_classic() +
  patchwork::inset_element(gt, left = .7, bottom = .7, right = 1, top = 1, align_to = "plot", on_top = TRUE)

gg1 + gg2