我正在努力将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))
感谢任何提示或提示。
到目前为止,这是我发现的最优雅的方法(反复试验)。很高兴能够纠正。
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()