Data from: https://aaronclauset.github.io/parental-leave/
plp <- read_tsv("parental_leave_policies.tsv") %>%
select(university_name, short_name, is_private, census_region, paid_leave_weeks_woman, paid_leave_weeks_man) %>%
mutate(university_name = str_replace_all(university_name, ",", "-- "),
university_name = str_squish(university_name),
is_private = as.factor(is_private),
is_private = fct_recode(is_private, "private" = "1",
"public" = "0"))
psych_rank <- read_csv("psych_rankings.csv", quote = "") %>%
mutate(university_name_merge = case_when(is.na(university_name2) ~ university_name,
TRUE ~ university_name2)) %>%
mutate(university_name_merge = str_replace_all(university_name_merge, "\"", "")) %>%
select(university_name_merge, psych_ranking_us_world_report)
all_df <- right_join(plp, psych_rank,
by = c("university_name" = "university_name_merge")) %>% drop_na()
all_df %>%
select(university_name, is_private, contains("paid")) %>%
gather("measure", "amount", -1:-2) %>%
mutate(measure = fct_recode(measure, "women" = "paid_leave_weeks_woman",
"men" = "paid_leave_weeks_man"),
measure = fct_relevel(measure, "women", "men")) %>%
group_by(measure, is_private) %>%
tidyboot_mean(column = amount) %>%
ggplot(aes(x = measure, y = mean, fill= measure)) +
geom_bar(stat = "identity") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper)) +
ylab("N weeks paid leave")+
xlab("Gender") +
facet_wrap(~is_private) +
theme_classic() +
theme(legend.position = "none")
all_df %>%
select(university_name, census_region, contains("paid")) %>%
gather("measure", "amount", -1:-2) %>%
mutate(measure = fct_recode(measure, "women" = "paid_leave_weeks_woman", "men" = "paid_leave_weeks_man"),
census_region = fct_relevel(census_region, "West", "Midwest", "South", "Northeast"),
measure = fct_relevel(measure, "women", "men")) %>%
group_by(measure, census_region) %>%
tidyboot_mean(column = amount) %>%
ggplot(aes(x = census_region, y = mean, fill= measure, group = measure)) +
geom_bar(stat = "identity", position="dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper), position = position_dodge(width = 0.9)) +
ylab("N weeks paid leave")+
xlab("Gender") +
theme_classic() +
theme(legend.position = "none")
all_df %>%
select(university_name,short_name, psych_ranking_us_world_report, contains("paid")) %>%
gather("measure", "amount", -1:-3) %>%
mutate(measure = fct_recode(measure, "women" = "paid_leave_weeks_woman", "men" = "paid_leave_weeks_man"),
measure = fct_relevel(measure, "women", "men")) %>%
ggplot(aes(x = psych_ranking_us_world_report, y = amount, group = measure)) +
facet_wrap(~measure )+
geom_point() +
geom_smooth(method = "lm", alpha = .2, aes(color = measure)) +
ggrepel::geom_text_repel(aes(label = short_name), size = 2) +
theme_minimal() +
theme(legend.position = "none",
strip.text.x = element_text(size = 16)) +
ylab("N weeks paid leave") +
xlab("US News and World Report Psychology Phd Program Ranking")