Graying of White Evangelicals

birth_rate_whites.R

white <- gss %>% filter(race ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("Entire White Sample"))

whiteevan <- gss %>% filter(race ==1) %>% 
  filter(evangelical ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Evangelicals"))


whiteml <- gss %>% filter(race ==1) %>% 
  filter(mainline ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Mainline"))

whitecath <- gss %>% filter(race ==1) %>% 
  filter(catholic ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Catholic"))

graph <- bind_rows(white, whiteevan, whiteml, whitecath)

pd <- position_dodge(0.2)

graph %>% 
  ggplot(., aes(x=year, y=mean, group = group, color = group)) + geom_point() + geom_line(size = 1.25) +
  geom_errorbar(aes(ymin=lower, ymax = upper), width = .1, position = pd, size = 1.25) +
  long_rb() +
  labs(x= "Year", y = "Mean Age", title = "The Aging of White America", caption = "Data: GSS 1972-2016")

ggsave(file="white_age_compare.png", type = "cairo-png", width = 18, height = 15)


white <- gss %>% filter(race ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(childs, na.rm = TRUE),
            sd = sd(childs, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("Entire White Sample"))

whiteevan <- gss %>% filter(race ==1) %>% 
  filter(evangelical ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(childs, na.rm = TRUE),
            sd = sd(childs, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Evangelicals"))


whiteml <- gss %>% filter(race ==1) %>% 
  filter(mainline ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(childs, na.rm = TRUE),
            sd = sd(childs, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Mainline"))

whitecath <- gss %>% filter(race ==1) %>% 
  filter(catholic ==1) %>% 
  group_by(year) %>% 
  summarise(mean = mean(childs, na.rm = TRUE),
            sd = sd(childs, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("White Catholic"))

graph <- bind_rows(white, whiteevan, whiteml, whitecath)

pd <- position_dodge(0.2)

graph %>% 
  ggplot(., aes(x=year, y=mean, group = group, color = group)) + geom_point() + geom_smooth(size = 1.25) +
  # geom_ribbon(aes(ymin=lower, ymax = upper, color = group)) +
  long_rb() +
  labs(x= "Year", y = "Mean # of Children", title = "White Birth Rates in the United States", caption = "Data: GSS 1972-2016")

ggsave(file="white_birthrate_compare.png", type = "cairo-png", width = 18, height = 15)


age <- cces16 %>% 
  filter(evangelical ==1) %>% 
  mutate(age = 2016 -birthyr) %>% 
  group_by(race) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("Evangelicals"))

age <- age %>% 
  mutate(race = recode(race, "1 = 'White'; 2 = 'Black'; 3 = 'Hispanic'; 4 = 'Asian'; 5 = 'Native American'; 6 = 'Mixed Race'; 7 = 'Other'; 8 = 'Middle Eastern'"))


age2 <- cces16 %>% 
  # filter(evangelical ==1) %>% 
  mutate(age = 2016 -birthyr) %>% 
  group_by(race) %>% 
  summarise(mean = mean(age, na.rm = TRUE),
            sd = sd(age, na.rm = TRUE), 
            n = n()) %>% 
  mutate(se = sd/sqrt(n),
         lower = mean - qt(1 - (0.05 /2),  n -1) * se,
         upper = mean + qt(1 - (0.05 /2),  n -1) * se) %>% 
  mutate(group = c("Entire Sample"))

age2 <- age2 %>% 
  mutate(race = recode(race, "1 = 'White'; 2 = 'Black'; 3 = 'Hispanic'; 4 = 'Asian'; 5 = 'Native American'; 6 = 'Mixed Race'; 7 = 'Other'; 8 = 'Middle Eastern'"))

age3 <- bind_rows(age, age2)



age3 %>% 
  ggplot(., aes(x=reorder(race, -mean), y = mean, fill = group)) +  geom_col(color = "black", position = "dodge")+
  geom_errorbar(aes(ymin = lower, ymax=upper), size = 1.5,  width = .25, position=position_dodge(.9), color = "azure4") +
  bar_rb() +
  labs(x= "Race", y = "Mean Age", title = "Comparing the Age of Evangelicals to the Population", caption = "Data: CCES 2016") + 
  scale_fill_manual(values=c("seagreen4","dodgerblue3" ))

ggsave(file="evangelicals_by_race.png", type = "cairo-png", width = 15, height = 10)