[英]ggplot2 se=TRUE for stat_smooth in facet_grid dependent on if statement
我試圖獲取給定條件的標准誤差以繪制在圖上。 我希望它顯示某些圖形而不顯示其他圖形,並且我試圖在stat_smooth中使用if語句來實現此目的:
library(ggplot2)
ggplot(diamonds, aes(depth, price)) +
stat_smooth(method="glm", se = ifelse(color == "I", FALSE, TRUE), formula=y~x,
alpha=0.2, size=1, aes(fill=cut)) +
facet_grid(.~ color)
但是,它似乎無法識別出顏色變量:
Error in ifelse(color == "I", FALSE, TRUE) : object 'color' not found
我還嘗試映射一個變量來保存此true和false值:
library(dplyr)
diamonds <- diamonds %>% mutate(SE = ifelse(color=="I", FALSE, TRUE))
ggplot(diamonds, aes(depth, price, colour=SE)) +
stat_smooth(method="glm", se = SE, formula=y~x,
alpha=0.2, size=1, aes(fill=cut)) +
facet_grid(.~ color)
您可以通過以下方式手動實現所需的目標:
library(ggplot2)
library(gridExtra)
colors <- unique(diamonds$color)
do.call(grid.arrange, lapply(colors, function(color) {
ggplot(diamonds[diamonds$color == color,], aes(depth, price)) +
stat_smooth(method="glm", se = (color != "I"), formula=y~x,
alpha=0.2, size=1, aes(fill=cut)) +
scale_x_continuous(limits=c(40, 80)) +
scale_y_continuous(limits=c(0,10000)) -> gg
if (color != colors[length(colors)]) gg + theme(legend.position = "none") else gg
}))
並使用諸如< 為組合的ggplots添加通用圖例 >之類的方法進行駭客破解,以使非圖例的通用圖例保持一致。
保持這個單獨的賬單很長。 您還可以編寫stat_smooth/StatSmooth
的自定義版本:
stat_smooth2 <- 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,
...
)
)
}
StatSmooth2 <- ggproto("StatSmooth", Stat,
setup_params = function(data, params) {
if (identical(params$method, "auto")) {
# Use loess for small datasets, gam with a cubic regression basis for
# larger. Based on size of the _largest_ group to avoid bad memory
# behaviour of loess
max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE)))
if (max_group < 1000) {
params$method <- "loess"
} else {
params$method <- "gam"
params$formula <- y ~ s(x, bs = "cs")
}
message("`geom_smooth()` using method = '", params$method,
"' and formula '", deparse(params$formula), "'")
}
if (identical(params$method, "gam")) {
params$method <- mgcv::gam
}
params
},
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) {
# Not enough data to perform fit
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)
}
}
# Special case span because it's the most commonly used model argument
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))
model <- do.call(method, c(base.args, method.args))
se <- data$secol[1] != "I"
ggplot2:::predictdf(model, xseq, se, level)
},
required_aes = c("x", "y", "secol")
)
然后執行您想要的操作:
library(ggplot2)
ggplot(diamonds, aes(depth, price)) +
stat_smooth2(method="glm", formula=y~x,
alpha=0.2, size=1, aes(fill=cut, secol = color)) + # << NOTE secol
facet_grid(.~ color)
這使:
這比竊聽傳說中的雜物要少得多。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.