表达式动态定位在 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 symbol 1: 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 字符串。因此，我使用 paste0 重写了您的 bquote。我还对你的乐趣做了两个小改动 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 添加了第二个图：

注意图片不显示sub-/superscripts。但是它们会出现在绘图中 window 以及保存绘图时。

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

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

Expressions dynamically positioned on multiple lines in ggplot

expression

r

ggplot2