RDD图使用带过渡区的ggplot将线延伸到截止点

Question

考虑以下关于劳动力参与率和年龄的数据框架。在65岁时，我们有领取养老金的年龄，我们对劳动力供应在领取养老金之前和之后的反应感兴趣。因此，我们也可以绘制一个图，不考虑养老金资格年龄周围的点，因为它可能会引起一些噪音。

df<-data.frame( c(63, 63.5, 64, 64.5, 65, 65.5, 66, 66.5, 67), c(0.8, 0.7, 0.65, 0.5 , 0.5, 0.5, 0.15, 0.1 ,0))

colnames(df)<-c("age", "labor_force_participation")

df$pensionbreak<-cut(df$age,
                     breaks = c(-Inf, 64.4,65.5,Inf),
                     labels = c("prior pension", "transition area", "after pension"))

#Plot the graph without taking into account the transition area
p  + 
  geom_smooth(
    data = subset(df, pensionbreak != "transition area"),
    method = "lm", se = TRUE
  ) +
  xlab("age") + 
  ylab("fraction of males working") + 
  labs(color = "Retirement") + 
  theme_bw()

在绘制这张图时，我没有考虑过渡区域，但现在我想将曲线图的线条延伸到截止点(即65岁)。更准确地说，我希望我的代码行如下图所示。有人知道我如何在R中做到这一点吗?我感谢任何人的帮助。

​

​

Answer 1

你可以这样做--虽然不是很优雅，但是很有效:)

require(tidyverse)
require(modelr)

# This is your subsetting
df_train <- df %>% filter(pensionbreak != "transition area")
df_predict <- tibble(age = 65, labor_force_participation = 0.5)

my_predictor <- function(x, pred, formula) {
  mod <- lm(formula, data = x)
  # This returns two types
  # type 1 is the predicted data
  # type 2 is the original data 
  bind_rows(pred, x) %>% 
    add_predictions(mod, var = "labor_force_participation") %>% 
    bind_rows(x, .id = "type")
}

# This applies the above function on your data - seperated by 
# the pensionbreak groups of data
dat <- df_train %>% 
  nest(data = c(age, labor_force_participation)) %>% 
  mutate(data_pred = map(data, my_predictor, df_predict, labor_force_participation ~ age)) %>% 
  unnest(data_pred) 

ggplot() +
  # Using type == 1 (predictions) for the line
  geom_line(data = dat %>% filter(type == 1),
            aes(x = age, y = labor_force_participation, col = pensionbreak),
            linetype = "dashed") +
  # Using type == 2 (original data) for the confidence area
  geom_smooth(data = dat %>% filter(type == 2),
              aes(x = age, y = labor_force_participation, col = pensionbreak),
              method = "lm") +
  xlab("age") + 
  ylab("fraction of males working") + 
  labs(color = "Retirement") + 
  theme_bw()

​

​