Задание формулы для каждого фасета с использованием stat_poly_eq в ggplot2

Question

Я взял этот пример набора данных здесь:

# Load library
library(ggplot2)

# Load data
data(mtcars)

# Plot data
p <- ggplot(mtcars,aes(x = disp, y = mpg)) + geom_point() + facet_grid(gear ~ am)
p <- p + geom_smooth(method="lm")
print(p)

В приведенном выше коде методы и формулы регрессии одинаковы во всех аспектах. Если мы хотим указать формулу для фасета (или панели) 6, у нас есть следующий код, отсюда:

# Smoothing function with different behaviour depending on the panel
custom.smooth <- function(formula, data,...){
  smooth.call <- match.call()

  if(as.numeric(unique(data$PANEL)) == 6) {
    # Linear regression
    smooth.call[[1]] <- quote(lm)
    # Specify formula
    smooth.call$formula <- as.formula("y ~ log(x)")
  }else{
    # Linear regression
    smooth.call[[1]] <- quote(lm)
  }

  # Perform fit
  eval.parent(smooth.call)
}

# Plot data with custom fitting function
p <- ggplot(mtcars,aes(x = disp, y = mpg)) + geom_point() + facet_grid(gear ~ am)
p <- p + geom_smooth(method = "custom.smooth", se = FALSE)
print(p)

Теперь, если я хочу добавить уравнения регрессии к этим аспектам:

# Load library
library(ggpmisc)
p + stat_poly_eq(formula = y ~ x,aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
    parse=TRUE,label.x.npc = "right")

Тогда что мне делать, чтобы указать уравнение и R2, отображаемые на панели 6, которые могут соответствовать модели, которую я указывал ранее? Смотрите график ниже, теперь панель 6 имеет свою собственную модель подгонки, а метка уравнения - нет. Может быть, мы можем определить аналогичную функцию, как мы сделали для параметров ggplot2?

Answer 1

Кажется, что функция, которую вы вызываете custom.smooth содержит строку, которая определяет формулу как "y ~ log(x)", Поэтому вам также необходимо указать это в своем stat_poly_eq функция, следовательно, полиномиальная форма (но в действительности логарифмическая) линейного уравнения.

Т.е. добавить:

p + stat_poly_eq(formula = y ~ log(x),
                     aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                     parse=TRUE,label.x.npc = "right")

Answer 2

Этот ответ не совсем отвечает на вопрос при рассмотрении деталей, но соответствует заголовку, поэтому, надеюсь, будет полезен будущим посетителям.

stat_poly_eq()предназначен для использования с модельными формулами, где непреобразованный x (или непреобразованный y ) является независимой переменной. Он не поддерживает формулу модели, напримерy ~ log(x)без ручной замены x на _log(x) в метке уравнения внутри вызова, даже если используется во всех панелях. В самой последней версии 'ggpmisc' можно иметь полиномы разных степеней в каждой панели, используя определяемую пользователем функцию метода.

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

poly_degree <- function(formula, data, ...) {
  if (all(data$PANEL == 6)) {
    formula <- y ~ poly(x, 2, raw = TRUE)
  }
  lm(formula = formula, data = data, ...)
}

ggplot(mtcars,aes(x = disp, y = mpg)) +
  geom_point() +
  stat_poly_line(method = "poly_degree") +
  stat_poly_eq(method = "poly_degree",
               use_label(c("eq", "r2")),
               size = 3,
               label.x = "right") +
  theme(legend.position = "bottom") + 
  facet_grid(gear ~ am)

^{Создано 17 октября 2022 г. с репрексом v2.0.2}

Answer 3

Вы можете обновить формулу панели 6 индивидуально (конечно, вы также можете обновить все панели с такой функцией, но здесь это не нужно)

rename_panel_expression <- function(grb, panel, expr) {
  g <- grb$grobs[[panel + 1]]$children
  grb$grobs[[panel + 1]]$children[[grep("GRID.text", names(g))]]$label <- expr
  grb
}

l <- lm(mpg ~ log(disp), mtcars[mtcars$am == 1 & mtcars$gear == 5, ])

tt <- rename_panel_expression(ggplotGrob(p), 6, 
  bquote(italic(y)~`=`~.(round(l$coefficients[1], 3)) - .(round(abs(l$coefficients[2]), 3))*~italic(x)~~~italic(R)^2~`=`~.(round(summary(l)$r.squared, 3))))

grid::grid.newpage()
grid::grid.draw(tt)