如何在 ggplot 面板 (facet_grid) 中提取 stat_smooth 曲线最大值?

How to extract stat_smooth curve maxima in gpplot panel (facet_grid)?

我使用 facet_grid 命令和两个不同的拟合方程(1 月 - 4 月和 5 月 - 6 月)用 18 个网格创建了这个图。我有两件事需要帮助:

  1. (听起来很明显,但是)我无法在互联网上找到工作代码来提取 stat_smooth 拟合的最大曲线。如果有人可以展示和解释代码的含义,我将不胜感激。这是我能找到的最接近的,但我不确定它是什么意思:
gb <- ggplot_build(p1)

curve_max <- gb$data[[1]]$x[which(diff(sign(diff(gb$data[[1]]$y)))==-2)+1]
  1. 如何在每条曲线上添加一条垂直线来指示最大值?

Data file (rlc2 <- read_excel)

情节

plot <- ggplot(rlc2, aes(par, etr, color=month, group=site))+
  geom_point()+
  stat_smooth(data = subset(rlc2, rlc2$month!="May" & rlc2$month!="Jun"),
              method = "glm",
              formula = y ~ x + log(x),
              se = FALSE,
              method.args = list(family = gaussian(link = "log"), start=c(a=0, b=0, c=0)))+
  stat_smooth(data = subset(rlc2, rlc2$month=="May" | rlc2$month=="Jun"),
              method = "nlsLM",
              formula = y ~ M*(1 - exp(-(a*x))),
              se = FALSE,
              method.args = list(start=c(M=0, a=10)))+
  facet_grid(rows = vars(month), cols = vars(site))
plot

field_rlc_plot

也欢迎任何其他建议。我受过程序员的教育,所以我的代码可能有点乱。谢谢你的帮忙。

试试这个:

首先,拟合数据并提取拟合的最大值。

my.fit <- function(month, site,  data) {
  fit <- glm(formula = etr ~ par + log(par),
      data = data,
      family=gaussian(link = "log")
      )
  #arrange  the dersired output in a tibble
  tibble(max  = max(fit$fitted.values),
         site = site,
         month = month)
}

#Apply a custom function `my.fit` on each subset of data
#according to month and site using the group_by/nest/map method
# the results are rowbinded and returned in a data.frame

my.max<-
  rlc2 %>% 
  dplyr::group_by(month, site) %>% 
  tidyr::nest() %>% 
  purrr::pmap_dfr(my.fit)

接下来,将结果加入您的数据并绘制 geom_line

rlc2  %>% 
  dplyr::left_join(my.max) %>% 
  ggplot(aes(x = par, y = etr))+
  geom_point()+
  stat_smooth(data = subset(rlc2, rlc2$month!="May" & rlc2$month!="Jun"),
              method = "glm",
              formula = y ~ x + log(x),
              se = FALSE,
              method.args = list(family = gaussian(link = "log"), start=c(a=0, b=0, c=0)))+
  stat_smooth(data = subset(rlc2, rlc2$month=="May" | rlc2$month=="Jun"),
              method = "nlsLM",
              formula = y ~ M*(1 - exp(-(a*x))),
              se = FALSE,
              method.args = list(start=c(M=0, a=10)))+
  geom_line(aes(y=max), col="red")+
  facet_grid(rows = vars(month), cols = vars(site))