ipums2_new_maps.Rmd

---
title: "The Geography of Unemployment in the U.S. in 2020–2021"
author: "Elena Stolpovsky"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
  html_document:
 #   toc: true
 #   toc_depth: 5
    code_folding: hide
bibliography: references.bib
link-citations: true
nocite: | 
   @tourism2020, @reno2020, @Stolpovsky12021, @ipums2020, hawaiitourism2021
---


<base target="_top"/>


```{r setup, include=FALSE}
knitr::opts_chunk$set(message = FALSE,
                      warning = FALSE)
options(scipen = 999, digits = 2)

```

[<font size="4">EconBlog</font>](https://elenas70.github.io/econblog/)
[<font size="4">`r icons::fontawesome("github")`</font>](https://github.com/elenas70/us_labor_market_and_COVID)
[<font size="4">`r icons::fontawesome("linkedin")`</font>](https://www.linkedin.com/in/estolpovsky/)

```{r include=FALSE}
# memory.limit(10000000)
# library(ipumsr)
# ddi <- read_ipums_ddi("cps_00018.xml")
# d <- read_ipums_micro(ddi)
```

```{r}
# library(sjlabelled) #package to remove data labels. Labels slow down analysis
# library(tidyverse)
# library(kableExtra)
# library(formattable)
# 
# d <- d %>%
#   remove_all_labels() %>% filter(EMPSTAT != 1) %>% #excluding military personnel
#   select(-CPSID,-CPSIDP) %>% mutate(
#     famid = SERIAL + MONTH / 10,
#     #family is is unique for each family record.
#     id = SERIAL + MONTH / 10 + PERNUM / 1000,
#     #id is unique for each individual record
#     sex = ifelse(SEX == 1, "Men", "Women"),
#     married_spouse_present = (MARST == 1) * 1,
#     married = (MARST %in% c(1, 2)) * 1,
#     unemployed = (EMPSTAT %in% c(20, 21, 22)) * 1,
#     employed = (EMPSTAT %in% c(1, 10, 12)),
#     retired = (EMPSTAT == 36) * 1,
#     lfp = (LABFORCE == 2) * 1,
#     age16plus = (AGE > 15) * 1,
#     workingage = (AGE < 63 &
#                     AGE > 17) * 1,
#     year_month = YEAR * 100 + MONTH,
#     period_num = (YEAR %% 2020) * 12 + MONTH
#   ) %>% select(YEAR,
#                MONTH,
#                STATEFIP,
#                WTFINL,
#                age16plus,
#                workingage,
#                sex,
#                lfp,
#                unemployed,
#                period_num)
```

### The Impact of the COVID Pandemic on U.S Unemployment

The COVID pandemic brought high and persistent unemployment throughout the U.S. All states have been impacted, with unemployment more than doubling during April–May 2020 even for moderately impacted states, such as Nebraska and Wyoming. The states heavily dependent on tourism and entertainment, Nevada and Hawaii, had some of the highest peak unemployment, at 30% in Nevada and 22% in Hawaii in April 2020. These states were also among the slowest to recover, with unemployment rates over 8% in March 2021.

Another group of states with high peak unemployment and slow recovery were states with large urban centers and high population density, such as California, New York, and New Jersey. Unemployment levels in each state were also affected by local development of the pandemic, state economic policies and seasonal fluctuations in unemployment rates. 


### Data and Methodology

The data come from the [Current Population Survey](https://cps.ipums.org/cps/) (CPS)— a monthly survey administered by the Census Bureau and used by the Bureau of Labor Statistics to calculate the official unemployment statistics. The sample consists of CPS monthly core employment data for January 2020–March 2021. Each monthly sample includes individual and household weights, which allow inferences about the population from the samples. I describe the use of weights in the calculation of population unemployment rates in the [fist part of the analysis of the labor market impact of COVID](https://rpubs.com/elenas70/labor_market_effect_of_COVID).



```{r}
# library(srvyr)
# 
# tab <-
#   d %>% as_survey(weights = c(WTFINL)) %>% #represent data as a survey with sampling weights
#   filter(age16plus == 1, lfp == 1) %>% #exclude individuals under 16. Choose the labor force as the base for unemployment rates
#   group_by(period_num, STATEFIP) %>% summarize(
#     year = YEAR[1],
#     month_num = MONTH[1],
#     month = month.abb[MONTH[1]],
#     period = paste(month.name[MONTH], YEAR)[1],
#     unemployment_rate = survey_mean(unemployed)
#   ) %>% #standard errors are the standard errors of the sample mean that account for the uncertainty of each observation (weights away from 1 mean that the observations deviation from the mean increases the uncertainty, increasing se).
#   #The variance attains its maximum value, when all weights except one are zero. Its minimum value is found when all weights are equal (i.e., unweighted mean), in which case it degenerates into the standard error of the mean, squared.https://en.wikipedia.org/wiki/Weighted_arithmetic_mean
#   ungroup()
# 
# tab[, 7:8] <-
#   lapply(tab[, 7:8], percent, 1)#format all columns except year_month as percentages
```


### Unemployment Rates by State, January 2020–March 2021

The maps and the table below show monthly unemployment rates by state starting January 2020. In most states unemployment peaked in April–May 2020 and declined until October or November 2020. December 2020–February 2021 saw no statistically significant reduction, and some increases in unemployment rates in the high-population states of California, Texas, Florida, New York, Pennsylvania and Illinois. March 2021 brought a reduction in unemployment in most states. The unemployment rate for the U.S as a whole was 6.2% in March 2021, compared to 4.6% in March 2020, or 3.8% in February 2020, before the pandemic started to affect the economy [-@Stolpovsky12021].

The states in the central U.S., in particular, the Northern Central states, had a smaller spike in unemployment and quicker recovery. Coastal states, states with large metropolitan areas and states dependent on tourism had a more dramatic and prolonged impact.

Non-coastal Northwestern states, North and South Dakota, Minnesota, Nebraska, and Wyoming, had unemployment rates below 10% during peak unemployment months, and returned to 3-5% unemployment rates in March 2021. California, New York, and New Jersey had unemployment rates above 10% throughout most of 2020 and were still experiencing high unemployment rates, 8-9%, in March 2021.

Some of the states impacted the most were the states with a high share of workers in entertainment, tourism and food service. Nevada, with 16% of GDP from tourism, had the highest peak in unemployment, 30% in April 2020. The industries particularly hit by COVID in Nevada were food and beverage and tourism ([2020](#references)). Hawaii had an unemployment rate of 22% in April, and has been the slowest state to recover, with unemployment rate at 11% in January 2021. Unemployment in Hawaii was 8% in March 2021, reflecting the fact that tourist activity in Hawaii was still substantially below its level before the pandemic ([2021](#references)).



```{r}
# library(urbnmapr) #package to look up state name by FIPS
# library(maps)#package for creating state maps with ggplot
# 
# states <- states %>% mutate(state_fips = as.integer(state_fips))
# 
# state_lookup <-
#   states %>% filter(!duplicated(states$state_fips)) %>% select(state_fips, state_name)
# 
# tab <-
#   full_join(tab, state_lookup, by = c("STATEFIP" = "state_fips")) %>%
#   select(
#     period_num,
#     period,
#     year,
#     month_num,
#     month,
#     state_name,
#     unemployment_rate,
#     unemployment_rate_se
#   )
# 
# save(tab, file = "tab.RData")
# 
# mapdata <- map_data("state")  %>%
#   mutate(region = str_to_title(region)) %>% mutate(state_name = str_replace(region, "District Of Columbia", "District of Columbia")) %>% select(long, lat, group, state_name)
# 
# mapdata <-
#   left_join(mapdata, tab, by = "state_name")
# save(mapdata, file = "mapdata.RData")

```

```{r}
library(tidyverse)
library(plotly)
library(ggplot2)
library(ggthemes)
load("tab.RData")
load("mapdata.RData")

mid <-
  mean(tab[!(tab$state_name %in% c("Alaska","Hawaii")),]$unemployment_rate) #unemployment midpoint used to determine the color scheme

period_names <- unique(tab$period)
period_labeller <- function(variable, value) {
  return(period_names[value])
}

p <- ggplot(data = mapdata,
            aes(
              x = long,
              y = lat,
              group = group,
              fill = unemployment_rate,
              text = state_name
            )) +

  facet_wrap(period_num ~ .,  ncol = 2, labeller = period_labeller) +
  geom_polygon(color = "gray50", size = 0.1) +
  coord_map(projection = "albers",
            lat0 = 39,
            lat1 = 45) +
  scale_fill_gradient2(
    midpoint = mid,
    low = "purple",
    mid = "white",
    high = "orangered",
    space = "Lab",
    labels = scales::percent_format()
  ) +
  labs(title = "", fill = NULL) +
  theme_map()



ggplotly(p,  height = 800,
         width = 800)

```
*Source: Current Population Survey: https://cps.ipums.org*

### Unemployment Rates and Standard Errors for January 2020–March 2021


The table below includes unemployment rates in January 2020–March 2021 for 51 U.S. states.

```{r}
load("tab.RData")
library(DT)

tab <- tab %>% mutate(
  year = as.integer(year),
  month_num = as.integer(month_num),
  unemployment_rate = round(as.numeric(unemployment_rate), 4),
  "unemployment_rate_se" = round(as.numeric(unemployment_rate_se), 4)
) %>% select(-period_num,-period)

DT::datatable(
  tab,
  colnames = c(
    "Year",
    "Month Number",
    "Month",
    "State",
    "Unemployment Rate",
    "Standard Error"
  ),
  filter = "top",
  
  extensions = 'Buttons',
  
  options = list(dom = 'Blfrtip',
                 buttons = c('copy', 'csv', 'excel'))
) %>% formatPercentage(c("unemployment_rate", "unemployment_rate_se"), 2)

```

<a href="#top">Back to top</a>

### References {#references}