如何在“polynom::polynomial”对象中强制尾随零？ 特别是从 ggpubr 修改 stat_lm 和 stat_regline_equation 的行为

如何解决如何在“polynom::polynomial”对象中强制尾随零？ 特别是从 ggpubr 修改 stat_lm 和 stat_regline_equation 的行为

我正在尝试修改 stat_regline_equation 如何在使用 R 包 ggscatter 中的 ggpubr 绘制的图上显示回归线方程。具体来说，我想显示一致的系数位数，即使一些舍入系数有尾随零，通常会被删除。下面是一个例子：

library(tidyverse)
library(ggpubr)

diamonds %>%
  filter(color %in% c("E","H","I")) %>%
  ggscatter(x="carat",y="table",add="reg.line") +
    facet_wrap(~color) +
    stat_regline_equation(label.y.npc = 'top')

图 I 很好，图 H 删除了一个尾随零，图 E 完全删除了斜率，因为它四舍五入到 1.00。 基于我得到的一个很好的答案 here 以及一个不同的答案 here，我尝试使用 trace(ggpubr:::.stat_lm,edit = TRUE) 修改包代码以修改第 13 行和第 14 行

eq.char <- as.character(signif(polynom::as.polynomial(coefs),2))

到

eq.char <- as.character(formatC(polynom::as.polynomial(coefs),format = "f",digits = 2))

问题在于：如果您将 polynom::polynomial 对象传递给 signif 或 round，它们会返回另一个 polynom::polynomial 对象，但对于 formatC 或 { {1}} 他们返回字符：

sprintf

因此，我尝试使用上面的 coefs = diamonds %>% filter(color=='E') %>% stats::lm(table~carat,.) %>% stats::coef() coefs %>% polynom::as.polynomial() %>% formatC(format='f',digits=2) %>% class() %>% print() coefs %>% polynom::as.polynomial() %>% signif(digits = 2) %>% class() %>% print() [1] "character" [1] "polynomial" 是行不通的。我猜测 formatC 类具有 polynom::polynomial 和 round 的内置方法，而 signif 没有内置方法，因此后者的输出是强制的。我可能会尝试修改 formatC 的类定义，但在这个阶段，我觉得必须有一种更简单的方法来获得我的图形上显示的回归方程的尾随零。我希望这是一个足够普遍的愿望，有人有更简单的解决方案，或者至少答案可能对除我以外的更多人有用。

解决方法

编辑：这个答案只能部分解决问题。它仍然只显示 56.83 + 1 x 而不是 1.00 x。我将留下答案，因为其他人可能能够以此为基础进行构建。

问题的很大一部分是polynom:::print.polynomial，其中包含：

p <- as.character.polynomial(signif(x,digits = digits),decreasing = decreasing)

由于 as.character.polynomial，这将永远不会打印尾随零。因此，我们可以创建一个允许这样做的新 as.character.polynomial。作为示例，我只是稍微修改了现有代码，您可以进一步调整：

as.character.polynomial <- function (x,decreasing = FALSE,digits = 2,nsmall = 2) {
  p <- format(unclass(x),digits = digits,nsmall = nsmall)
  lp <- length(p) - 1
  names(p) <- 0:lp
  p <- p[as.numeric(p) != 0]
  if (length(p) == 0) 
    return("0")
  if (decreasing) 
    p <- rev(p)
  signs <- ifelse(as.numeric(p) < 0,"- ","+")
  signs[1] <- if (signs[1] == "- ") "-" else ""
  np <- names(p)
  pow <- paste("x^",np,sep = "")
  pow[np == "0"] <- ""
  pow[np == "1"] <- "x"
  stars <- rep.int("*",length(p))
  stars[p == "" | pow == ""] <- ""
  paste0(signs,p,stars,pow,collapse = " ")
}

示例：

coefs %>%
  polynom::as.polynomial() %>%
  as.character.polynomial
# [1] "56.83 + 1.00*x

然而，.stat_lm 会将其输出为 italic(y)~`=`~56.83 + 1.00*~italic(x)，因此它将被用作表达式。我对 ggplot2 不够熟悉，无法弄清楚其余部分，所以我将其留给其他人。

,

因为一个问题是 expression()，我们使用包 'ggtext' 和格式化为 markdown 的方程更接近所需的输出。包 'ggpmisc' 遵循图形语法，因此比 'ggpubr' 有更多的输入，但它保留了 'ggplot2' 的所有灵活性和层的概念。默认情况下，它将方程格式化为 R 表达式，但它也可以返回 LaTeX 和 Markdown 格式的方程。它在内部使用 signif()，因此小数点后的位数可能会有所不同。有效位数可以通过参数coef.digits控制。

library(tidyverse)
library(ggpmisc)
library(ggtext)

diamonds %>%
  filter(color %in% c("E","H","I")) %>%
  ggplot(aes(x=carat,y=table)) +
  geom_point() +
  stat_poly_line() +
  stat_poly_eq(aes(label = after_stat(eq.label)),geom = "rich_text",output.type = "markdown",label.y = 72,label.x = 0.5,fill = NA,label.size = NA,hjust = 0) +
  facet_wrap(~color) +
  theme_bw()

[2021-06-26] 使用当前的 'ggpmisc' 开发版本（未来版本 0.4.1），我们得到以下图：

这些值根据有效数字的数量而不是小数点后的数字数量保留尾随零，因为多项式高阶项的小系数很重要。

注意： 'ggpmisc' 包中的统计数据 stat_poly_eq() 是原始代码段，它未经确认就被复制并在 'ggpubr' 中重命名为 stat_regline_equation()。同时，软件包“ggpmisc”的开发仍在继续，目前 stat_poly_eq() 具有多项新功能和错误修复。 'ggtext' 包加入 CRAN 后不久添加的功能之一是对 Markdown 编码方程的支持，我在上面的示例中使用了该功能。

^{由 reprex package (v2.0.0) 于 2021 年 6 月 20 日创建}