How to force trailing zeroes in 'polynom::polynomial' object? (specifically to modify behavior of stat_lm and stat_regline_equation from ggpubr)

user_2597347 0
Viewed 157

I am trying to modify how stat_regline_equation displays the regression line equation on a plot made with ggscatter from the R package ggpubr. Specifically, I want to show a consistent number of digits of coefficients, even when some rounded coefficients have trailing zeros, which are typically removed. Here is an example:

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')

enter image description here

Graph I is fine, graph H has one trailing zero removed, and graph E has the slope removed entirely because it rounds to 1.00. Based on a great answer I got here as well as a different answer here, I tried to modify the package code using trace(ggpubr:::.stat_lm, edit = TRUE) to modify lines 13 and 14 from

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

to

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

Here is the problem: if you pass a polynom::polynomial object to signif or round, they return another polynom::polynomial object, but for formatC or sprintf they return characters:

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"

Therefore my attempt to use formatC above doesn't work. I am guessing that the polynom::polynomial class has built-in methods for round and signif, and none for formatC, so the output is coerced for the latter. I could potentially try to modify the class definition of polynom::polynomial, but at this stage I feel like there has to be an easier way to get trailing zeros on the regression equations that display on my graphs. And I am hoping that this is a common enough desire that someone has an easier solution, or at the very least that an answer might be useful to more people besides myself.

ggpmisc ggpubr ggplot2 r
2 Answers

EDIT: This answer only partly fixes the problem. It still displays only 56.83 + 1 x instead of 1.00 x. I'm leaving the answer since someone else may be able to build from this.

A big part of the problem is polynom:::print.polynomial, which contains:

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

This will never print trailing zeroes due to as.character.polynomial. So, we can just create a new as.character.polynomial that DOES allow that. I just modified the existing code a bit as an example, and you can tweak it further:

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 = " ")
}

Example:

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

However, .stat_lm will then output it as italic(y)~`=`~56.83 + 1.00*~italic(x), and it will consequently be used as an expression. I'm not familiar enough with ggplot2 to figure out the rest, so I'll leave that to someone else.

enter image description here

user_58056700

As one problem is expression() we get closer to the desired output using package 'ggtext' and the equations formatted as markdown. Package 'ggpmisc' follows the grammar of graphics so there is more to type than with 'ggpubr' but it retains all the flexibility of 'ggplot2' and the concept of layers. It formats equations as R expressions by default but it also can return LaTeX and markdown formatted equations. It uses signif() internally so the number of digits after the decimal point can vary. The number of significant digits can be controlled through parameter coef.digits.

The values retain trailing zeros based on the number of significant digits rather than the number of digits after the decimal point as small coefficients for high order terms of a polynomial are important.

I prefer theme_bw() to theme_classic() for plots with panels, theme_classic() would give a plot formatted almost as in the question.

[code updated for R (>= 4.2.0) and 'ggpmisc' (>= 0.4.5).]

library(ggpmisc)
#> Loading required package: ggpp
#> Loading required package: ggplot2
#> 
#> Attaching package: 'ggpp'
#> The following object is masked from 'package:ggplot2':
#> 
#>     annotate
library(ggtext)

diamonds |>
  subset(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 = 1, fill = NA, label.size = NA,
               hjust = 0) +
  facet_wrap(~color) +
  theme_bw()

Created on 2022-06-03 by the reprex package (v2.0.1)

Note: The statistic stat_poly_eq() in package 'ggpmisc' is the original piece of code which was copied without acknowledgement and renamed as stat_regline_equation() in 'ggpubr'. Meanwhile, development of package 'ggpmisc' has continued and currently stat_poly_eq() has several new features and bug fixes. One of the features added soon after package 'ggtext' made it to CRAN is the support for markdown encoded equations, which I used in the example above.

user_24198920
Related