broom::augment: 评估错误：用 gamlss 找不到对象，但用 lm 都很好答案

【问题标题】：broom::augment: Evaluation error: object not found with gamlss but all good with lmbroom::augment: 评估错误：用 gamlss 找不到对象，但用 lm 都很好
【发布时间】：2018-08-13 18:21:26
【问题描述】：

我正在努力将gamlss 结果收集到数据框中。这继续示例here

使用lm的工作示例

library(tidyverse)
library(broom)
library(gamlss)

library(datasets)

# working
mro <- mtcars %>% 
  nest(-am) %>% 
  mutate(am = factor(am, levels = c(0, 1), labels = c("automatic", "manual")),
         fit = map(data, ~lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment))

使用gamlss的破例

# GAMLSS model.frame workaround for dplyr
# See https://stackoverflow.com/q/48979322/152860 
model.frame.gamlss <- function(formula, what = c("mu", "sigma", "nu", "tau"), parameter = NULL, ...) {
    object <- formula
    dots <- list(...)
    what <- if (!is.null(parameter)) {
        match.arg(parameter, choices = c("mu", "sigma", "nu", "tau"))
    } else match.arg(what)
    Call <- object$call
    parform <- formula(object, what)
    data <- if (!is.null(Call$data)) {
        ## problem here, as Call$data is .
        #eval(Call$data)
        # instead, this would work:
        eval(Call$data, environment(formula$mu.terms))
    } else {
        environment(formula$terms)
    }
    Terms <- terms(parform)
    mf <- model.frame(
        Terms, 
        data, 
        xlev = object[[paste(what, "xlevels", sep = ".")]]
    )
    mf
}

# broken
mro <- mtcars %>% 
  nest(-am) %>% 
  mutate(am = factor(am, levels = c(0, 1), labels = c("automatic", "manual")),
         fit = map(data, ~gamlss(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment))

欣赏任何提示或技巧。

【问题讨论】：

标签： r dplyr tidyverse broom gamlss

【解决方案1】：

到目前为止，这是我发现的最优雅的方法（反复试验）。很高兴得到纠正。

aug_func <- function(df){
          augment(gamlss(mpg ~ hp + wt + disp, data=df))
        }
mtcars %>% 
  mutate(am = factor(am, levels = c(0, 1), labels = c("automatic", "manual"))) %>%
  group_by(am) %>%
  do(aug_func(df=.)) %>%
    ggplot(aes(x = mpg, y = .fitted)) +
      geom_abline(intercept = 0, slope = 1, alpha = .2) +  # Line of perfect fit
      geom_point() +
      facet_grid(am ~ .) +
      labs(x = "Miles Per Gallon", y = "Predicted Value") +
      theme_bw()

【讨论】：