R ggplot无法使用镶嵌面_包裹和分组绘制平滑gam
我正在尝试使用ggplot绘制一个多面板和多线图,该图具有群体美学以及R ggplot无法使用镶嵌面_包裹和分组绘制平滑gam,r,ggplot2,facet-wrap,gam,R,Ggplot2,Facet Wrap,Gam,我正在尝试使用ggplot绘制一个多面板和多线图,该图具有群体美学以及facet\u wrap。但是,当一组数据点太少时,geom_smooth会对刻面图中的所有线失败 plot1 <- ggplot(data=df1, aes(x=Year, y=Mean, group=Group2, linetype=Group2, shape=Group2)) + geom_errorbar(aes(ymin=Mean-SE, ymax=Mean+SE),
facet\u wrap
。但是,当一组数据点太少时,geom_smooth
会对刻面图中的所有线失败
plot1 <- ggplot(data=df1,
aes(x=Year, y=Mean, group=Group2, linetype=Group2, shape=Group2)) +
geom_errorbar(aes(ymin=Mean-SE, ymax=Mean+SE), width=0.2) +
geom_smooth(method = "gam", se=F, formula = y ~ s(x, k=3), size = 1, colour="black") +
geom_point(position=pd, size=2, fill="white") +
scale_x_continuous(limits=c(min(df1$Year-0.1), max(df1$Year+0.1)),
breaks=seq(min(df1$Year),max(df1$Year),5)) +
facet_wrap(~Group1, scales = "free", ncol=2) +
theme_bw() +
theme(axis.text.x = element_text(),
axis.title.x = element_blank(),
strip.background = element_blank(),
axis.line.x = element_line(colour="black"),
axis.line.y = element_line(colour="black"),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
legend.position="top",
legend.title = element_blank())
plot(plot1)
策划
很明显,有足够的数据在组factorB中为factorC绘制一条平滑的线。有什么想法吗 我认为这相当棘手。在对for
StatSmooth
进行了一些测试和阅读后,我将我的发现总结如下:
观察
geom_smooth()李>
如果将绘图分为多个面板,则仅具有不符合要求的数据组的面板受到影响李>
这不会发生在公式=y~x
(即默认公式)上李>
使用默认公式的某些其他方法(例如“lm”
,“glm”
)不会出现这种情况,但使用方法=“黄土”
时会出现这种情况李>
如果数据组只有一个观察值,则不会发生这种情况
我们可以用一些简化的代码重现上述内容:
# 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))
当参数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")))
也将返回一个有效的对象,尽管有大量的警告。但是,将其传递给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
换句话说,如果指定组中只有一个观测值,StatSmooth
立即返回一个空白数据帧。因此,它永远不会到达代码的后续部分来抛出任何错误
解决方法:
在确定了事情偏离轨道的地方之后,我们可以对compute\u组
code进行调整(请参见注释和注释部分):
处理此问题的一个非常简单的方法是将导致传递到geom\u smooth
的数据中出现问题的行进行子集划分:
库(tidyverse)
df1%group_by(Group1,Group2)%>%filter(n()>2),#子集
method=“gam”,公式=y~s(x,k=3))+
几何点()
面_包裹(~Group1)
您只是没有足够的数据用于GAM。既然直线是直的,为什么不使用lm
<代码>ggplot(数据=df1,aes(x=年,y=平均值,颜色=组2))+几何误差条(aes(ymin=平均值SE,ymax=平均值+SE),宽度=0.2)+几何平滑(方法='lm',SE=假)+几何点()+面包(~Group1)
谢谢Alistaire,但显然有四个点足以实现gam平滑,然而,由于另一组中只有两点,它失败了。问题是为什么完整的情节失败了,当然它不应该为这两个点画一个gam平滑,但它肯定应该为另一组画一个gam平滑。为了方便起见,我还提供了摘要数据,因为数据集非常庞大,而且有许多组比较。问题在于未能绘制平滑的曲线,而不是其背后的统计信息!!!你可以创建一个有3个点的GAM,但是作为一个观测者,我非常怀疑任何数据很少的回归,特别是如果它是曲线的话。这就是说,这个问题可以有效地推广到更合理的情况下,平滑需要更多的数据。谢谢大家的努力。阿利斯泰尔创造了一个简单的解决方案,但Z-Lin确实打开了引擎盖,找出了失败的原因和原因。
model <- do.call(mgcv::gam,
args = list(formula = y ~ s(x, k = 3),
data = df.2 %>% filter(group == "B" & facet == "X")))
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
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
if (length(unique(data$x)) < 2) {
# Not enough data to perform fit
return(data.frame())
}
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
)
# 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
)