我的问题类似于this但那里的答案对我不起作用。基本上,我试图用“模糊”设计生成一个回归不连续图,该设计使用治疗组和对照组的所有数据,但只绘制治疗组和对照组“范围”内的回归线。
下面,我模拟了一些数据并生成了带有基本图形的模糊 RD 图。我希望用 ggplot2 复制这个情节。请注意,其中最重要的部分是浅蓝色回归线使用所有蓝色点进行拟合,而桃色回归线使用所有红色点进行拟合,尽管仅绘制在个人预期的范围内接受治疗。那是我很难在 ggplot 中复制的部分。
我想转向 ggplot,因为我想使用分面在参与者嵌套的各个单元中生成相同的图。在下面的代码中,我展示了一个使用 geom_smooth
的非示例。当组内没有模糊性时,它可以正常工作,否则就会失败。如果我可以将 geom_smooth
限制在特定范围内,我想我已经准备好了。感谢您提供任何帮助。
模拟数据
library(MASS)
mu <- c(0, 0)
sigma <- matrix(c(1, 0.7, 0.7, 1), ncol = 2)
set.seed(100)
d <- as.data.frame(mvrnorm(1e3, mu, sigma))
# Create treatment variable
d$treat <- ifelse(d$V1 <= 0, 1, 0)
# Introduce fuzziness
d$treat[d$treat == 1][sample(100)] <- 0
d$treat[d$treat == 0][sample(100)] <- 1
# Treatment effect
d$V2[d$treat == 1] <- d$V2[d$treat == 1] + 0.5
# Add grouping factor
d$group <- gl(9, 1e3/9)
用基数生成回归不连续图
library(RColorBrewer)
pal <- brewer.pal(5, "RdBu")
color <- d$treat
color[color == 0] <- pal[1]
color[color == 1] <- pal[5]
plot(V2 ~ V1,
data = d,
col = color,
bty = "n")
abline(v = 0, col = "gray", lwd = 3, lty = 2)
# Fit model
m <- lm(V2 ~ V1 + treat, data = d)
# predicted achievement for treatment group
pred_treat <- predict(m,
newdata = data.frame(V1 = seq(-3, 0, 0.1),
treat = 1))
# predicted achievement for control group
pred_no_treat <- predict(m,
newdata = data.frame(V1 = seq(0, 4, 0.1),
treat = 0))
# Add predicted achievement lines
lines(seq(-3, 0, 0.1), pred_treat, col = pal[4], lwd = 3)
lines(seq(0, 4, 0.1), pred_no_treat, col = pal[2], lwd = 3)
# Add legend
legend("bottomright",
legend = c("Treatment", "Control"),
lty = 1,
lwd = 2,
col = c(pal[4], pal[2]),
box.lwd = 0)
ggplot 的非示例
d$treat <- factor(d$treat, labels = c("Control", "Treatment"))
library(ggplot2)
ggplot(d, aes(V1, V2, group = treat)) +
geom_point(aes(color = treat)) +
geom_smooth(method = "lm", aes(color = treat)) +
facet_wrap(~group)
请注意第 1 组和第 2 组的回归线超出了处理范围。
最佳答案
可能有一种更优雅的方式来使用 geom_smooth
制作线条,但它可以与 geom_segment
一起破解。如果愿意,可以在绘图调用之外修改 data.frames。
ggplot(d, aes(x = V1, y = V2, color = factor(treat, labels = c('Control', 'Treatment')))) +
geom_point(shape = 21) +
scale_color_brewer(NULL, type = 'qual', palette = 6) +
geom_vline(aes(xintercept = 0), color = 'grey', size = 1, linetype = 'dashed') +
geom_segment(data = data.frame(t(predict(m, data.frame(V1 = c(-3, 0), treat = 1)))),
aes(x = -3, xend = 0, y = X1, yend = X2), color = pal[4], size = 1) +
geom_segment(data = data.frame(t(predict(m, data.frame(V1 = c(0, 4), treat = 0)))),
aes(x = 0, xend = 4, y = X1, yend = X2), color = pal[2], size = 1)
另一个选项是geom_path
:
df <- data.frame(V1 = c(-3, 0, 0, 4), treat = c(1, 1, 0, 0))
df <- cbind(df, V2 = predict(m, df))
ggplot(d, aes(x = V1, y = V2, color = factor(treat, labels = c('Control', 'Treatment')))) +
geom_point(shape = 21) +
geom_vline(aes(xintercept = 0), color = 'grey', size = 1, linetype = 'dashed') +
scale_color_brewer(NULL, type = 'qual', palette = 6) +
geom_path(data = df, size = 1)
对于带有面的编辑,如果我正确理解你想要什么,你可以使用 lapply
为每个组计算一个模型并为每个组进行预测。在这里,我使用 dplyr::bind_rows
而不是 do.call(rbind, ...)
来插入 .id
参数来自列表元素名称的组号,尽管还有其他方法可以做同样的事情。
df <- data.frame(V1 = c(-3, 0, 0, 4), treat = c('Treatment', 'Treatment', 'Control', 'Control'))
m_list <- lapply(split(d, d$group), function(x){lm(V2 ~ V1 + treat, data = x)})
df <- dplyr::bind_rows(lapply(m_list, function(x){cbind(df, V2 = predict(x, df))}), .id = 'group')
ggplot(d, aes(x = V1, y = V2, color = treat)) +
geom_point(shape = 21) +
geom_vline(aes(xintercept = 0), color = 'grey', size = 1, linetype = 'dashed') +
geom_path(data = df, size = 1) +
scale_color_brewer(NULL, type = 'qual', palette = 6) +
facet_wrap(~group)
关于r - 使用 ggplot2 生成 "fuzzy"RD 图,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/39884721/