cps analysis covid

library(ipumsr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(car)

## Loading required package: carData

## 
## Attaching package: 'car'

## The following object is masked from 'package:dplyr':
## 
##     recode

library(zoo)

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(ggplot2)
library(questionr)
library(tidyquant)

## Loading required package: lubridate

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:dplyr':
## 
##     intersect, setdiff, union

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

## Loading required package: PerformanceAnalytics

## Loading required package: xts

## 
## Attaching package: 'xts'

## The following objects are masked from 'package:dplyr':
## 
##     first, last

## 
## Attaching package: 'PerformanceAnalytics'

## The following object is masked from 'package:graphics':
## 
##     legend

## Loading required package: quantmod

## Loading required package: TTR

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## Version 0.4-0 included new data defaults. See ?getSymbols.

## ══ Need to Learn tidyquant? ══════════════════════════════════════════════
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>

library(fpp)

## Loading required package: forecast

## Loading required package: fma

## Loading required package: expsmooth

## Loading required package: lmtest

## Loading required package: tseries

ddi<-read_ipums_ddi("/media/corey/extra/cps_00024.xml")
cpsdat<-read_ipums_micro(ddi)

## 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.

cpsdat<-zap_labels(cpsdat)

stfips<-data.frame(stfip=unique(tidycensus::fips_codes$state_code), stname=unique(tidycensus::fips_codes$state_name))

cpsdat<-merge(cpsdat, stfips, by.x="STATEFIP", by.y= "stfip")

cpsdat2<-cpsdat%>%
  filter(YEAR >2009,AGE>18& AGE<65, EMPSTAT<30)%>%
  mutate(emp = Recode(EMPSTAT, recodes = "0 = NA; 1='af'; 10='curr work'; 12 = 'recent no job'; 20:22='unemp'"))%>%
  mutate( curremp = ifelse(emp =='curr work' , 1, 0))

cpsdat2$month<- as.Date(as.yearmon(paste(cpsdat2$YEAR,cpsdat2$MONTH, sep="/"), format = "%Y/%m"))


out<-cpsdat2%>%
  group_by(month)%>%
  summarise(emprate =1- wtd.mean(curremp,weights = WTFINL, na.rm=T))%>%
  arrange( month)%>%
  ungroup()

#test<-as.list(tapply(out$emprate, out$stname, FUN = ts, start = c(2017,1), end = c(2020, 3), frequency = 12))
ts1<-ts(out$emprate, start = c(2017,1), end = c(2020, 4), frequency = 12)

#lapply(test, decompose, type="add")

adjust1<-decompose(ts1,type =  "add")
adjust2<-ts1 - adjust1$seasonal

test<-data.frame(month = unique(out$month), unemprate = adjust2)

ggplot(data=test, aes(month, unemprate))+geom_line()+labs(title = "Seasonally Adjusted Unemployment Rate",
       subtitle = "Jan 2017 to April 2020",
       caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
       x = "Month",
       y = "Unemployment Rate")+theme_minimal()

## Don't know how to automatically pick scale for object of type ts. Defaulting to continuous.

ggsave(filename="~/emprate.png", height=10, width=12)

## Don't know how to automatically pick scale for object of type ts. Defaulting to continuous.