library(ipumsr,quietly = T)
library(dplyr,quietly = T)
library(car,quietly = T)
library(zoo,quietly = T)
library(ggplot2,quietly = T)
library(questionr,quietly = T)
library(tidyquant,quietly = T)
library(fpp,quietly = T)
library(survey,quietly = T)
library(forecast)
library(questionr)
TX Mother Data
Texas Working Moms Data
I pulled monthly cps data from ipums, 2013-2023. (Excluded asec supplemental data)
<-read_ipums_ddi("C:/Users/rayo-garza/Documents/R2024/cps_00060.xml")
ddi<-read_ipums_micro(ddi) cpsdat
Use of data from IPUMS CPS is subject to conditions including that users should
cite the data appropriately. Use command `ipums_conditions()` for more details.
<-zap_labels(cpsdat)
cpsdat
# str(cpsdat)
Working Moms in Labor Force by Age Group of Child
#----------------Here I tried with using momrule as filter. Then I redid with Nchild. more straightforward
# cpsdat_tx <- cpsdat %>%
# filter(MOMRULE != 0, SEX==2)
# cpsdat_tx <- cpsdat_tx %>%
# mutate(age_group = case_when(
# YNGCH == 99 ~ NA_character_,
# YNGCH < 3 ~ 'Under 3 Years',
# YNGCH >= 3 & YNGCH < 6 ~ 'Under 6 Years',
# YNGCH >= 6 & YNGCH < 18 ~ '6-17 Years',
# TRUE ~ NA_character_
# )) %>%
# filter(!is.na(age_group))
<- cpsdat %>%
cpsdat_tx filter(NCHILD > 0, SEX == 2) %>%
mutate(age_group = case_when(
== 99 ~ NA_character_,
YNGCH < 3 ~ 'Under 3 Years',
YNGCH >= 3 & YNGCH < 6 ~ 'Under 6 Years',
YNGCH >= 6 & YNGCH < 18 ~ '6-17 Years',
YNGCH TRUE ~ NA_character_
%>%
)) filter(!is.na(age_group))
<- cpsdat_tx %>%
lfp_by_age_group group_by(YEAR, MONTH, age_group) %>%
summarise(participation_rate = wtd.mean(LABFORCE == 2, weights = WTFINL, na.rm = TRUE)) %>%
ungroup()
`summarise()` has grouped output by 'YEAR', 'MONTH'. You can override using the
`.groups` argument.
Visualization
ggplot(lfp_by_age_group, aes(x = as.Date(paste(YEAR, MONTH, 1, sep = "-")), y = participation_rate, color = age_group)) +
geom_line(size = 1.2) +
scale_color_manual(values = c("blue", "darkorange", "red", "gray")) +
labs(title = "Women's Labor Force Participation Rates by Age of Youngest Child",
subtitle = "Texas Mothers, 2013-2023",
x = "Date",
y = "Participation Rate",
color = "Age of Youngest Child") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10),
axis.text = element_text(size = 10),
axis.title = element_text(size = 12))
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
library(ggplot2)
library(scales)
Warning: package 'scales' was built under R version 4.2.3
ggplot(lfp_by_age_group, aes(x = as.Date(paste(YEAR, MONTH, 1, sep = "-")), y = participation_rate, color = age_group)) +
geom_line(size = 1.2) +
scale_color_manual(values = c("blue", "darkorange", "red", "gray")) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + # Change y-axis to percentage
labs(title = "Women's Labor Force Participation Rates by Age of Youngest Child",
subtitle = "Texas Mothers, 2013-2023",
x = "Date",
y = "Participation Rate",
color = "Age of Youngest Child") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10),
axis.text = element_text(size = 10),
axis.title = element_text(size = 12))
How Many Working Moms in TX?
<- cpsdat_tx %>%
working_mothers filter(LABFORCE == 2, NCHILD > 0)
<- working_mothers %>%
working_mothers_per_year group_by(YEAR) %>%
summarise(
total_working_mothers = sum(WTFINL, na.rm = TRUE)
)
print(working_mothers_per_year)
# A tibble: 11 × 2
YEAR total_working_mothers
<dbl> <dbl>
1 2013 26649791.
2 2014 27543339.
3 2015 26698478.
4 2016 27218158.
5 2017 26890814.
6 2018 27110072.
7 2019 27027442.
8 2020 27105982.
9 2021 28069421.
10 2022 29012096.
11 2023 29298648.
# write_xlsx(working_mothers_per_year, "working_mothers_per_year.xlsx")
Seasonally adjusted unemp analysis for ALL TX women
Draw from CSparks Analysis here:https://rpubs.com/corey_sparks/603291
<- cpsdat_tx %>%
cps_unemp filter(EMPSTAT < 30) %>%
mutate(emp = recode(EMPSTAT, "1 = 'af'; 10 = 'curr work'; 12 = 'recent no job'; 20:22 = 'unemp'"),
curremp = ifelse(emp == 'curr work', 1, 0),
month = as.Date(as.yearmon(paste(YEAR, MONTH, sep="/"), format = "%Y/%m")))
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `emp = recode(EMPSTAT, "1 = 'af'; 10 = 'curr work'; 12 = 'recent
no job'; 20:22 = 'unemp'")`.
Caused by warning in `recode()`:
! NAs introduced by coercion
<- cps_unemp %>%
unemployment_rate group_by(month) %>%
summarise(unemprate = 1 - wtd.mean(curremp, weights = WTFINL, na.rm = TRUE)) %>%
arrange(month)
<- ts(unemployment_rate$unemprate, start = c(2013, 1), frequency = 12)
unemp_ts <- decompose(unemp_ts, type = "additive")
adjust1 <- unemp_ts - adjust1$seasonal
adjusted_unemp
$seasonally_adjusted <- as.numeric(adjusted_unemp) unemployment_rate
ggplot(unemployment_rate, aes(x = month, y = seasonally_adjusted)) +
geom_line() +
labs(title = "Seasonally Adjusted Unemployment Rate of Texas Mothers",
subtitle = "2013-2023",
x = "Month",
y = "Seasonally Adjusted Unemployment Rate",
caption = "Source: IPUMS CPS Monthly Data") +
theme_minimal()
# library(writexl)
# write_xlsx(unemployment_rate, "unemployment_rate.xlsx")
# write_xlsx(lfp_by_age_group, "lfp_by_age_group.xlsx")
Seasonally adjusted unemp for Moms
<- cpsdat %>%
cpsdat_tx_moms filter(NCHILD > 0, SEX == 2) %>%
mutate(age_group = case_when(
== 99 ~ NA_character_,
YNGCH < 3 ~ 'Under 3 Years',
YNGCH >= 3 & YNGCH < 6 ~ 'Under 6 Years',
YNGCH >= 6 & YNGCH < 18 ~ '6-17 Years',
YNGCH TRUE ~ NA_character_
%>%
)) filter(!is.na(age_group))
# Analysis for unemployment rates for working moms
<- cpsdat_tx_moms %>%
cpsdat_tx_moms1 filter(EMPSTAT < 30) %>%
mutate(
emp = recode(EMPSTAT,
"1 = 'af';
10 = 'curr work';
12 = 'recent no job';
20:22 = 'unemp'"),
curremp = ifelse(emp == 'curr work', 1, 0),
month = as.Date(as.yearmon(paste(YEAR, MONTH, sep = "/"), format = "%Y/%m"))
)
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `emp = recode(EMPSTAT, "1 = 'af'; \n 10 = 'curr work'; \n 12 =
'recent no job'; \n 20:22 = 'unemp'")`.
Caused by warning in `recode()`:
! NAs introduced by coercion
<- cpsdat_tx_moms1 %>%
cpsdat_tx_moms1 group_by(month) %>%
summarise(
unemprate = 1 - wtd.mean(curremp, weights = WTFINL, na.rm = TRUE)
%>%
) arrange(month)
<- ts(cpsdat_tx_moms1$unemprate, start = c(2013, 1), frequency = 12)
unemp_ts <- decompose(unemp_ts, type = "additive")
adjust1 <- unemp_ts - adjust1$seasonal
adjusted_unemp $seasonally_adjusted <- as.numeric(adjusted_unemp)
cpsdat_tx_moms1
ggplot(cpsdat_tx_moms1, aes(x = month, y = seasonally_adjusted)) +
geom_line() +
labs(title = "Seasonally Adjusted Unemployment Rate of Texas Mothers",
subtitle = "2013-2023",
x = "Month",
y = "Seasonally Adjusted Unemployment Rate",
caption = "Source: IPUMS CPS Monthly Data") +
theme_minimal()