0

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

工作示例使用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))

感谢任何提示或提示。

4

1 回答 1

0

到目前为止,这是我发现的最优雅的方法(反复试验)。很高兴站起来纠正。

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

在此处输入图像描述

于 2018-03-06T03:52:45.050 回答