Я думаю, что это довольно сложно.После некоторого тестирования и чтения текущего кода GH для StatSmooth я суммировал свои выводы следующим образом:
Наблюдения
geom_smooth() не удалосьчтобы нарисовать все сглаженные линии на панели графика, если любой из групп данных имеет слишком мало наблюдений для method = "gam" AND formula = y ~ s(x, k = 3); - Если график гранен на несколько панелей, затрагиваются только панели с поврежденными группами данных;
- Этого не происходит для
formula = y ~ x (т. Е. По умолчанию); - Это не происходит для некоторых других методов (например,
"lm", "glm") с формулой по умолчанию, но действительно происходит с method = "loess"; - Этого не происходит, еслигруппа данных имеет только 1 наблюдение.
Мы можем воспроизвести вышеупомянутое с некоторым упрощенным кодом:
# create sample data
n <- 30
set.seed(567)
df.1 <- data.frame( # there is only 1 observation for group == B
x = rnorm(n), y = rnorm(n),
group = c(rep("A", n - 1), rep("B", 1)),
facet = sample(c("X", "Y"), size = n, replace = TRUE))
set.seed(567)
df.2 <- data.frame( # there are 2 observations for group == B
x = rnorm(n), y = rnorm(n),
group = c(rep("A", n - 2), rep("B", 2)),
facet = sample(c("X", "Y"), size = n, replace = TRUE))
# create base plot
p <- ggplot(df.2, aes(x = x, y = y, color = group)) +
geom_point() + theme_bw()
# problem: no smoothed line at all in the entire plot
p + geom_smooth(method = "gam", formula = y ~ s(x, k = 3))
# problem: no smoothed line in the affected panel
p + facet_wrap(~ facet) +
geom_smooth(method = "gam", formula = y ~ s(x, k = 3))
# no problem with default formula: smoothed lines in both facet panels
p + facet_wrap(~ facet) + geom_smooth(method = "gam")
# no problem with lm / glm, but problem with loess
p + facet_wrap(~ facet) + geom_smooth(method = "lm")
p + facet_wrap(~ facet) + geom_smooth(method = "glm")
p + facet_wrap(~ facet) + geom_smooth(method = "loess")
# no problem if there's only one observation (instead of two)
p %+% df.1 + geom_smooth(method = "gam", formula = y ~ s(x, k = 3))
p %+% df.1 + facet_wrap(~ facet) +
geom_smooth(method = "gam", formula = y ~ s(x, k = 3))
Пояснения к наблюдениям 1 и 2:
Я полагаю, что проблема заключается в последних двух строках функции StatSmooth compute_group.Первая строка вызывает функцию модели (например, stats::glm, stats::loess, mgcv::gam) для фрейма данных для каждой группы, определенной отображением aes(group = ...), а вторая строка вызывает одну из оболочек вокруг stats::predict(), чтобы получитьсглаженные значения (и доверительный интервал, если применимо) для модели.
model <- do.call(method, c(base.args, method.args))
predictdf(model, xseq, se, level)
Когда параметры method = "gam", formula = y ~ s(x, k = 3) используются для фрейма данных только с 2 наблюдениями, это происходит:
model <- do.call(mgcv::gam,
args = list(formula = y ~ s(x, k = 3),
data = df.2 %>% filter(group == "B" & facet == "X")))
Ошибка в smooth.construct.tp.smooth.spec (объект, dk $ data, dk $ knots): термин содержит меньше уникальных ковариатных комбинаций, чем указанные максимальные степени свободы
model, объект, определенный для получения результата do.call(...), даже не был создан.Последняя строка кода predictdf(...) выдаст ошибку, потому что model не существует. Без огранки это влияет на все вычисления, выполненные StatSmooth, и geom_smooth() не получает пригодных для использования данных для создания любого geom в его слое. С фасетой вышеуказанные вычисления выполняются отдельно для каждого фасета, поэтому затрагиваются только фасеты с проблемными данными.
Пояснения к наблюдениям 3 и 4:
В дополнение к вышесказанному, если мы не укажем формулу для замены по умолчанию y ~ x, мы получим действительный объект модели из gam / lm / glm, которыйможет быть передано в неэкспортированную функцию ggplot2 predictdf для кадра данных значений прогноза:
model <- do.call(mgcv::gam, # or stats::lm, stats::glm
args = list(formula = y ~ x,
data = df.2 %>% filter(group == "B" & facet == "X")))
result <- ggplot2:::predictdf(
model,
xseq = seq(-2, 1.5, length.out = 80), # pseudo range of x-axis values
se = FALSE, level = 0.95) # default SE / level parameters
loess также вернет действительный объект, хотя и с множеством предупреждений.Однако передача его в predictdf приведет к ошибке:
model <- do.call(stats::loess,
args = list(formula = y ~ x,
data = df.2 %>% filter(group == "B" & facet == "X")))
result <- ggplot2:::predictdf(
model,
xseq = seq(-2, 1.5, length.out = 80), # pseudo range of x-axis values
se = FALSE, level = 0.95) # default SE / level parameters
Ошибка в объекте predLoess (объект $ y, объект $ x, newx = if (is.null (newdata)) объекта$ x else if (is.data.frame (newdata)) as.matrix (model.frame (delete.response (term (object))),: NA / NaN / Inf в вызове внешней функции (аргумент 5)
Объяснение для наблюдения 5:
StatSmooth Функция compute_group начинается со следующего:
if (length(unique(data$x)) < 2) {
# Not enough data to perform fit
return(data.frame())
}
Другими словами, еслив указанной группе есть только 1 наблюдение, StatSmooth немедленно возвращает пустой фрейм данных и, следовательно, никогда не достигнет последующих частей кода, чтобы выдать ошибку.
Обходной путь:
Определив, где что-то пошло не так, мы можем внести изменения в код compute_group (см. Аннотированные и закомментированные фрагменты):
new.compute_group <- function(
data, scales, method = "auto", formula = y~x, se = TRUE, n = 80, span = 0.75,
fullrange = FALSE, xseq = NULL, level = 0.95, method.args = list(), na.rm = FALSE) {
if (length(unique(data$x)) < 2) return(data.frame())
if (is.null(data$weight)) data$weight <- 1
if (is.null(xseq)) {
if (is.integer(data$x)) {
if (fullrange) {
xseq <- scales$x$dimension()
} else {
xseq <- sort(unique(data$x))
}
} else {
if (fullrange) {
range <- scales$x$dimension()
} else {
range <- range(data$x, na.rm = TRUE)
}
xseq <- seq(range[1], range[2], length.out = n)
}
}
if (identical(method, "loess")) method.args$span <- span
if (is.character(method)) method <- match.fun(method)
base.args <- list(quote(formula), data = quote(data), weights = quote(weight))
# if modelling fails, return empty data frame
# model <- do.call(method, c(base.args, method.args))
model <- try(do.call(method, c(base.args, method.args)))
if(inherits(model, "try-error")) return(data.frame())
# if modelling didn't fail, but prediction returns NA,
# also return empty data frame
# predictdf(model, xseq, se, level)
pred <- try(ggplot2:::predictdf(model, xseq, se, level))
if(inherits(pred, "try-error")) return(data.frame())
return(pred)
}
Определить новый слой статистики, который использует эту версию:
# same as stat_smooth() except that it uses stat = StatSmooth2, rather
# than StatSmooth
stat_smooth_local <- function(
mapping = NULL, data = NULL, geom = "smooth", position = "identity", ...,
method = "auto", formula = y ~ x, se = TRUE, n = 80, span = 0.75,
fullrange = FALSE, level = 0.95, method.args = list(), na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE) {
layer(
data = data, mapping = mapping, stat = StatSmooth2,
geom = geom, position = position, show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
method = method, formula = formula, se = se, n = n,
fullrange = fullrange, level = level, na.rm = na.rm,
method.args = method.args, span = span, ...
)
)
}
# inherit from StatSmooth
StatSmooth2 <- ggproto(
"StatSmooth2", ggplot2::StatSmooth,
compute_group = new.compute_group
)
Результат:
Мы можем выполнить те же случаи, что и раньше, заменив geom_smooth() на stat_smooth_local(), и убедитесь, чтосглаженные слои geom видны в каждом случае (обратите внимание, что некоторые из них по-прежнему будут вызывать сообщения об ошибках):
# problem resolved: smoothed line for applicable group in the entire plot
p + stat_smooth_local(method = "gam", formula = y ~ s(x, k = 3))
# problem resolved: smoothed line for applicable group in the affected panel
p + facet_wrap(~ facet) +
stat_smooth_local(method = "gam", formula = y ~ s(x, k = 3))
# still no problem with default formula
p + facet_wrap(~ facet) + stat_smooth_local(method = "gam")
# still no problem with lm / glm; problem resolved for loess
p + facet_wrap(~ facet) + stat_smooth_local(method = "lm")
p + facet_wrap(~ facet) + stat_smooth_local(method = "glm")
p + facet_grid(~ facet) + stat_smooth_local(method = "loess")
# still no problem if there's only one observation (instead of two)
p %+% df.1 + stat_smooth_local(method = "gam", formula = y ~ s(x, k = 3))
p %+% df.1 + facet_wrap(~ facet) +
stat_smooth_local(method = "gam", formula = y ~ s(x, k = 3))
# showing one pair of contrasts here
cowplot::plot_grid(
p + facet_wrap(~ facet) + ggtitle("Before") +
geom_smooth(method = "gam", formula = y ~ s(x, k = 3)),
p + facet_wrap(~ facet) + ggtitle("After") +
stat_smooth_local(method = "gam", formula = y ~ s(x, k = 3)),
nrow = 2
)
