google_trends_UI.Rmd

---
title: "Predicting Initial Unemployment Insurance Claims Using Google Trends"
author: "Paul Goldsmith-Pinkham + Aaron Sojourner"
date: "4/3/2020"
output:
  html_document:
    df_print: paged
---

<style type="text/css">
.main-container {
  max-width: 800px;
  margin-left: auto;
  margin-right: auto;
}
</style>

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# if (!require("devtools")) install.packages("devtools")
# devtools::install_github("paulgp/gtrendsR")

#install.packages("RApiDatetime")

library(gtrendsR)
library(tidyverse)
library(ggrepel)
library(RApiDatetime)
library(lubridate)
library(zoo)
library(knitr)
library(kableExtra)
library(readxl)
library(janitor)
library(RColorBrewer)
library(data.table)

lm_eqn = function(m) {

  l <- list(a = format(coef(m)[1], digits = 2),
      b = format(abs(coef(m)[2]), digits = 2),
      r2 = format(summary(m)$r.squared, digits = 3));


    eq <- substitute(~~italic(R)^2~"="~r2,l)
    eq <- substitute(~~italic(R)^2~"="~r2,l)    

  as.character(as.expression(eq));                 
}

pull_data = function(loc, time_window, panel=FALSE) {
  if (panel==TRUE) {
    geo = c("US-CA",loc)
    res_post = gtrends(keyword=c("file for unemployment"),  geo = geo,
                       time = time_window, onlyInterest = TRUE)
    state_data = res_post$interest_over_time %>%
      mutate(hits = as.numeric(hits)) %>%
      mutate(hits = replace_na(hits, 0))
    cutoff = dim(res_post$interest_over_time)[1]/length(geo)
    CA_max = state_data %>% filter(row_number() <= cutoff)
    ## We do the filter thing to drop the comparison state out.
    state_data = state_data %>% filter(row_number() > cutoff) %>%
      group_by(geo) %>%
      mutate(max_geo = max(hits),
             scale = max_geo / max(CA_max$hits),
             hits = scale*hits)
    return(list(state_data = state_data))
  }
  else {
    geo = loc
    res_post = gtrends(keyword=c("file for unemployment"),  geo = geo,
                       time = time_window, onlyInterest = TRUE)
    state_data = res_post$interest_over_time %>%
      mutate(hits = as.numeric(hits))
    return(list(state_data = state_data))    
  }
}

```

```{r load-data2, cache=TRUE, results='hide', show=FALSE, include=FALSE}
#Create geography
location_vec = tibble::enframe(name = NULL,c(state.abb, "DC")) %>% mutate(geo = "US") %>%   unite(location, geo, value, sep="-")
today_date = format.Date(today(), format="%Y-%m-%d")
# Loop multiple times and average, following Seth's paper
data_full = tibble()
for (j in seq(1,1)) {
panel_data = list()

for (i in seq(1,length(location_vec$location),4)) {
  if (i < 49) {
    panel_data[[i]] = pull_data(loc = location_vec$location[i:(i+3)], time_window=paste0(c("2020-2-01",today_date),collapse=" "), panel=TRUE)
  }
  else {
     panel_data[[i]] = pull_data(loc = location_vec$location[i:(i+2)], time_window=paste0(c("2020-2-01",today_date),collapse=" "), panel=TRUE)
  }
    # be polite
    Sys.sleep(.2)
}

panel_data_states = list()
for (i in seq(1,length(panel_data))) {
  panel_data_states[[i]] = panel_data[[i]]$state_data
}

# Parse data
data_states_short = bind_rows(panel_data_states) %>%
  mutate(location = substr(geo, 4,6)) %>%
  ungroup() %>%
  select(location, hits, date) %>%
  mutate(date = ymd(date)) %>%
  group_by(location, date) %>%
  arrange(location, date)

data_full = data_full %>% bind_rows(data_states_short)
Sys.sleep(10)
}
#
data_states_short = data_full %>% group_by(location, date) %>% summarize(hits = mean(hits))
## We do this b/c otherwise Google Trends API shuts us off  (already blocked for today)
data_states_short %>% write_csv("data/data_states_2020_02_01_2020_04_16a.csv")


data_states_short = read_csv("data/data_states_2020_02_01_2020_04_16a.csv")


```

```{r load-ntl-data, include=FALSE, cache=TRUE}
national_trend =  pull_data(loc = c("US"), time_window=paste0(c("2020-2-01", today_date), collapse= " "), panel=TRUE)
national_trend = national_trend$state_data %>% filter(geo == "US")  %>% 
  mutate(location = "USA") %>%
  ungroup() %>%
  select(date, hits, location) %>% mutate(date = date(date))

```

```{r, include=FALSE, message=FALSE, warning=FALSE}
### Calculate growth rate in Google Measures
data_states_short = data_states_short %>% group_by(location) %>%
  mutate( hits_ma = rollmean(x = hits, 7, align = "right", fill = NA))

weekly_data = data_states_short %>% mutate(dow = wday(date)) %>%
  mutate(week = epiweek(date)) %>% group_by(week, dow, location) %>%
  summarize(hits = mean(hits, na.rm= TRUE), date = max(date)) %>% filter(month(date) > 1)
weekly_data2 = data_states_short %>%
  mutate(week = epiweek(date)) %>% group_by(week, location) %>%
  summarize(hits = mean(hits, na.rm= TRUE), date = max(date)) %>% filter(month(date) > 1)
weekly_data3 = data_states_short %>% bind_rows(national_trend) %>%
  mutate(week = epiweek(date)) %>% group_by(week, location) %>%
  summarize(hits = mean(hits, na.rm= TRUE), date = max(date)) %>% filter(month(date) > 1)

growth_rate_weekly = weekly_data %>%
   filter(week >= 8 & week < 17 ) %>%
  select(location, hits = hits, week, date, dow) %>%
  mutate(late = case_when(week == 12 ~ "late",
                          week == 13 ~ "late_nyt",
                          week == 14 ~ "late_next",
                          week == 15 ~ "late_next2",
                          week == 16 ~ "late_next3",
                          TRUE ~ "early")) %>%
  group_by(location, late, dow) %>%
  summarize(hits = mean(hits, na.rm=TRUE)) %>%
  filter(!is.na(hits)) %>% spread(late, hits) %>%
  mutate(rate = late/(early+1),
         diff = late - early)

growth_rate_weekly2 = weekly_data2 %>%
  group_by(location) %>%
  filter(week >= 8 & week < 13) %>%
  select(location, hits = hits, week, date) %>%
  mutate(late = case_when(week == 12 ~ "late",
                          TRUE ~ "early")) %>%
  group_by(location, late) %>%
  summarize(hits = mean(hits, na.rm=TRUE)) %>%
  filter(!is.na(hits)) %>% spread(late, hits) %>%
  mutate(rate = late/(early+1),
         diff = late - early)

growth_rate_weekly3 = weekly_data3 %>%
   filter(week >= 8 & week <= 16 ) %>%
  select(location, hits = hits, week, date) %>%
  mutate(late = case_when(week == 12 ~ "late",
                          week == 13 ~ "late_nyt",
                          week == 14 ~ "late_next",
                          week == 15 ~ "late_next2",
                          week == 16 ~ "late_next3",
                          TRUE ~ "early")) %>%
  group_by(location, late) %>%
  summarize(hits = mean(hits, na.rm=TRUE)) %>%
  filter(!is.na(hits)) %>% spread(late, hits) %>%
  mutate(rate = late/(early+1),
         diff = late - early)

```

```{r, include=FALSE, message=FALSE, warning=FALSE}

## Load UI data
library(readxl)
UI_Claims_March21 <- read_excel("data/UI_Claims_March21.xlsx", skip = 1) %>%
  filter(!is.na(State)) %>% select(location = State, ui_growth = GrowthFactor, baseline_ui = `2/22-3/14`)
UI_Claims_March28 <- read_excel("data/UI_Claims_March28.xlsx", sheet = "Weekly_Summary", col_names = FALSE, skip = 4) %>%
  select(location = ...1, baseline_ui =...2, proj_ui_lastwk = ...4, proj_ui_thiswk =...5) %>%
  filter(!is.na(location))  %>%
  mutate(baseline_ui = as.numeric(baseline_ui),
         proj_ui_lastwk = as.numeric(proj_ui_lastwk),
         proj_ui_thiswk = as.numeric(proj_ui_thiswk))

### Load in Daily UI Data

daily_UI_Claims = tibble()
for (i in c(state.abb,"DC")) {
  daily_UI_Claims = daily_UI_Claims %>% bind_rows(
    read_excel("data/UI_Claims_March28.xlsx", sheet = i) %>%
      select(date, ui_claims_daily = reported_claims...2) %>%
      mutate(location = i))
}

daily_UI_Claims = daily_UI_Claims %>% filter(!is.na(ui_claims_daily)) %>%
  mutate(date = date(date))

### Load in true State Data

UI_Claims_March21_True <- read_excel("data/UI_20200326_states.xlsx") %>%
  left_join(tibble(STATE = state.name, location = state.abb)) %>%
  mutate(location = replace_na(location, "DC")) %>%
  select(location, Advance)

UI_Claims_March28_True <- read_excel("data/StateUIClaims03282020.xlsx", sheet = "Sheet1") %>%
  left_join(tibble(STATE = state.name, location = state.abb)) %>%
  select(location, `2 week total`, advance_0322, advance_0315, updated_0315) %>%
  mutate(location = replace_na(location, "DC"))

UI_Claims_April04_True <- read_excel("data/StateUIClaims_04052020.xlsx", sheet = "WE200404") %>%
  left_join(tibble(STATE = state.name, location = state.abb)) %>%
  select(location, advance_0404=Advance, updated_0322=`Prior Wk`) %>%
  mutate(location = replace_na(location, "DC"))


UI_Claims_April11_True <- read_excel("data/StateUIClaims_04112020.xlsx", sheet = "States") %>%
  left_join(tibble(STATE = state.name, location = state.abb)) %>%
  select(location, advance_0411=Advance, updated_0404=`Prior Wk`) %>%
  mutate(location = replace_na(location, "DC"))


UI_Claims_True = UI_Claims_March28_True %>% left_join(UI_Claims_April04_True) %>% left_join(UI_Claims_April11_True) %>% select(-`2 week total`)

## Read in Labor force data

lf_state <- read_excel("data/labor_force_state.xlsx", sheet = "Sheet1") %>%
  left_join(tibble(state = state.name, location = state.abb)) %>%
  mutate(location = replace_na(location, "DC")) %>%
  select(location, labor_force = lf_022020)

### Load in "report level" data
report_level_UI_data <- read_excel("data/report_level_UI_data_new.xlsx",
                                                        sheet = "zs") %>%
  mutate(date_start = date(date_start),
         date_end = date(date_end),
         article_date = janitor::excel_numeric_to_date(as.numeric(article_date))
         )

report_level_UI_data <- report_level_UI_data %>% bind_rows(read_excel("data/report_level_UI_data_new.xlsx",
                                                        sheet = "dp") %>%
  mutate(date_start = date(date_start),
         date_end = date(date_end),
         article_date = janitor::excel_numeric_to_date(as.numeric(article_date))
         ))

report_level_UI_data = report_level_UI_data %>% filter(!is.na(date_start) & !is.na(date_end)) %>%
  select(location = state, date_start, date_end, claims) %>%
  group_by(location, date_start, date_end) %>%
  summarize(claims = mean(claims))

report_level_UI_data_fill = report_level_UI_data %>% group_by(location) %>% mutate(report_id = row_number()) %>%
  mutate(num_days =1 + date_end - date_start ) %>%
  mutate(claims_avg = claims / as.numeric(num_days)) %>%
  select(-claims, -num_days) %>%
  gather(date_, date, -location, -claims_avg, -report_id) %>%
  select(-date_) %>%
  arrange(location, report_id, date) %>%
  group_by(location, report_id) %>%
  complete(date = seq.Date(from = min(date), to = max(date), by="day"), claims_avg) %>%
  group_by(location, report_id, date) %>%
  summarize(claims_avg = mean(claims_avg, na.rm=TRUE))

report_UI_GT_data = report_level_UI_data_fill %>%
  left_join(data_states_short) %>% group_by(location, report_id) %>%
  summarize(claims = mean(claims_avg), hits = mean(hits), week_end = max(date), week_start = min(date)) %>%
  left_join(growth_rate_weekly3 %>% select(location, early)) %>%
  mutate(hits_norm = hits - early) %>%
  left_join(UI_Claims_March21 %>% select(location, baseline_ui)) %>%
  mutate(ui_norm = claims / baseline_ui)

model_report_daily = lm(ui_norm ~ hits_norm, data =  report_UI_GT_data %>%
         filter(epiweek(week_end) <= 13), weight = baseline_ui)
model_report_daily_unweighted = lm(ui_norm ~ hits_norm, data =  report_UI_GT_data %>%
         filter(epiweek(week_end) <= 13))
```

```{r, include=FALSE, message=FALSE, warning=FALSE}

daily_predict_data = data_states_short %>%
  filter(epiweek(date) > 11 & epiweek(date) <= 16) %>%
  mutate(dow = wday(date)) %>%
  left_join(growth_rate_weekly %>%
              select(location, early, dow)) %>%
  left_join(UI_Claims_March28 %>%
              select(baseline_ui, location) %>%
              group_by(location) %>%
              filter(row_number() == n())) %>%
  mutate(hits_norm = hits - early) %>%
  mutate(ui_claims_report_daily_hat =
           baseline_ui*(
             ((hits_norm) * model_report_daily$coefficients[2]) +
               model_report_daily$coefficients[1])
         )


```



```{r, include=FALSE, message=FALSE, warning=FALSE}
se_report.fit = predict(model_report_daily, daily_predict_data %>%
  mutate(week = epiweek(date)), se.fit = TRUE)$se.fit

weekly_predict_data = daily_predict_data %>%
  mutate(week = epiweek(date))  %>%
  bind_cols(tibble(se_report = se_report.fit)) %>%
  mutate(se_report = se_report * baseline_ui) %>%
  left_join(report_level_UI_data_fill %>%
              group_by(location, date) %>%
              summarize(claims_avg = mean(claims_avg, na.rm = TRUE))) %>%
  mutate(combined_prediction_report =  ui_claims_report_daily_hat,
         combined_prediction_se_report = se_report) %>%
  select(location, date, hits, hits_norm,
         combined_prediction_report, combined_prediction_se_report, week) %>%
  group_by(location, week) %>%
  summarize(predicted_ui_report = sum(combined_prediction_report),
            predicted_ui_lb_report =  sum(combined_prediction_report) - 2*sum(combined_prediction_se_report),
            predicted_ui_ub_report =  sum(combined_prediction_report) + 2*sum(combined_prediction_se_report),
            first_date = first(date),
            last_date = last(date))%>%
  mutate(num_days = 1 + as.numeric((last_date- first_date)),
         predicted_ui_report = predicted_ui_report*(7/num_days),
         predicted_ui_lb_report = predicted_ui_lb_report*(7/num_days),
         predicted_ui_ub_report = predicted_ui_ub_report*(7/num_days))




```


```{r, echo=FALSE, warning=FALSE, message=FALSE}



report_output_text = weekly_predict_data %>%
  ungroup() %>% filter(week  > 11) %>%
  mutate(predicted_ui = predicted_ui_report/1e6,
         predicted_ui_lb = predicted_ui_lb_report/1e6,
         predicted_ui_ub = predicted_ui_ub_report/1e6) %>%
  mutate(predicted_ui_sa = case_when(week == 12 ~ predicted_ui/0.833,
                                     week == 13 ~ predicted_ui/0.876,
                                     week == 14 ~ predicted_ui*1.065,
                                     week == 15 ~ predicted_ui*1.0548,
                                     week == 16 ~ predicted_ui*1.037),
         predicted_ui_lb_sa = case_when(week == 12 ~ predicted_ui_lb/0.833,
                                     week == 13 ~ predicted_ui_lb/0.876,
                                     week == 14 ~ predicted_ui_lb*1.065,
                                     week == 15 ~ predicted_ui_lb*1.0548,
                                     week == 16 ~ predicted_ui_lb*1.037),
         predicted_ui_ub_sa = case_when(week == 12 ~ predicted_ui_ub/0.833,
                                     week == 13 ~ predicted_ui_ub/0.876,
                                     week == 14 ~ predicted_ui_ub*1.065,
                                     week == 15 ~ predicted_ui_ub*1.0548,
                                     week == 16 ~ predicted_ui_ub*1.037)) %>%
  select(week, predicted_ui, predicted_ui_lb, predicted_ui_ub,
         ends_with("sa")) %>%
  group_by(week) %>% summarize_all(sum)


options(knitr.kable.NA = "--")
report_output = weekly_predict_data %>% ungroup() %>% filter(week == 12 | week == 13) %>%
  select(location, week, predicted_ui = predicted_ui_report) %>%
  spread(week, predicted_ui) %>%
  left_join(UI_Claims_March21_True) %>%
  left_join(growth_rate_weekly3) %>%
  rename(State = location) %>%
  mutate(google_12 = late - early,
         google_13 = late_nyt - early) %>%
  select(State,  Advance, google_12, `12`,  google_13, `13`) %>%
  mutate(Total = `12` + `13`)
```


Many thanks to Dylan Piatt and Zach Swaziek for their help with this. Feedback always welcome at asojourn@umn.edu.


Data+code are available here: https://docs.google.com/spreadsheets/d/1RN1XJLIpU12QUwMpkF0DNiV8fkeqdHbWHta2sRfEZT4/edit#gid=651560 and https://github.com/paulgp/GoogleTrendsUINowcast

### Latest Results
  * We validate the model out-of-sample against official data released today. A model estimated only on outcome data prior to this week explains 92.9 percent share of variance in states’ reports for the week ending March 28 (84.3 percent in log scale).
  * Extrapolating Google Trends data from 3/29-3/31 forward to the end of the week, we project `r round(report_output_text$predicted_ui_sa[3], digits = 1)` million UI claims, seasonally adjusted, with confidence intervals of `r round(report_output_text$predicted_ui_lb_sa[3], digits = 1)` and `r round(report_output_text$predicted_ui_ub_sa[3], digits = 1)` million.


# Abstract

Understanding changes in national and state-level initial unemployment insurance (UI) claims has value to markets, policymakers, and economists. Initial claims measure the number of Americans filing new claims for UI benefits is one of the most-sensitive, high-frequency official statistics used to detect changes in the labor market. However, official federal data on UI claims comes out at a weekly interval and at a lag. While last week was a record-setting week, this week’s UI numbers doubled that record, with the largest rise in new unemployment claims in U.S. history, due to widespread quarantines. In advance of each week’s release, we constructed harmonized news-based measures of UI claims in a state over various sets of consecutive days. We also build a daily panel on the intensity of search interest for the term “file for unemployment” for each state on Google Trends. Changes in search intensity predict changes in initial claims. We forecast state and national UI claims using the estimated daily model. These models are new and partially validated.

# Introduction

Understanding changes in national and state-level initial unemployment insurance (UI) claims can have value to markets, policymakers, economists, journalists, and the public, especially in times of rapid change. Initial claims measure the number of Americans filing new claims for UI benefits is one of the most-sensitive, high-frequency official statistics used to detect changes in the labor market. However, official federal data on initial claims come out at a weekly interval and at a lag. The U.S. Department of Labor aggregates reports from state unemployment-insurance systems for weekly release of advance estimates on each Thursday, which covers the prior Sunday to Saturday week. They revise these estimates over the following week, so official estimates are released 18 days after each week starts and 12 days after it ends. Statistics on unemployment, employment to population ratios, and labor force participation come out monthly, usually two to three weeks after the reference period ends. To facilitate a more-current view of changes in the labor market, we aim to forecast official UI initial claims statistics.

Below, we describe a model we used to forecast initial claims nationally and by state for the week ending Saturday, March 28. The first (advance), official estimates was released this morning (4/2/2020). Last Thursday’s report of 3.3 million new claims in the week ending March 21 devastated the prior record since records started in 1967, due to widespread quarantines to try to flatten the curve of COVID-19 critical cases. This week’s estimate broke that record again with 6.6 million new claims filed.

Some state agencies reported partial information on new claims to the press, due the staggering growth in UI claims. The first part of our approach gathers and harmonizes the reported numbers across press reports to construct news report measures of UI claims in a state over various sets of consecutive days. The Data section provides more details.

The second part of our approach imputes states’ UI claims harnessing data from Google Trends. We construct a daily panel dataset of the intensity of search for the term “file for unemployment” for each state. We regress this measure on the set of day-states where we have constructed a growth rate in UI claims using news reports, and use this to forecast initial claims for all states based on the estimated daily model and the panel of Google trends data.


# Summary of Results

For the week ending March 21, the model yields initial national UI claims (seasonally adjusted)   of `r round(report_output_text$predicted_ui_sa[1], digits = 1)`. Our confidence intervals range from `r round(report_output_text$predicted_ui_lb_sa[1], digits = 1)`	to `r round(report_output_text$predicted_ui_ub_sa[1], digits = 1)` million. Relative to the advance estimates from the state, this number is high. Further below, we discuss reasons for this, mainly related to seemingly low UI numbers from states which had had news reports suggesting much higher numbers. This discrepancy is likely due to overwhelmed UI offices in these states.

For the week of 3/22-3/28, we use the estimated relationship from 3/15-3/21 between Google Trends interest and UI claims to predict initial claims. Our model implies a prediction of `r round(report_output_text$predicted_ui_sa[2], digits = 1)` million UI claims, seasonally adjusted, with a 95\% CI of `r round(report_output_text$predicted_ui_lb_sa[2], digits = 1)` million and `r round(report_output_text$predicted_ui_ub_sa[2], digits = 1)` million for the week of 3/22-3/28.

Extrapolating Google Trends data from 3/29-3/31 forward to the end of the week, we project `r round(report_output_text$predicted_ui_sa[3], digits = 1)` million UI claims, seasonally adjusted, with confidence intervals of `r round(report_output_text$predicted_ui_lb_sa[3], digits = 1)` and `r round(report_output_text$predicted_ui_ub_sa[3], digits = 1)` million.

<!-- ```{r, echo = FALSE} -->

<!-- ggplot(data = weekly_predict_data %>% -->
<!--          select(predicted_ui_report, location, week) %>% -->
<!--          spread(week, predicted_ui_report) %>% -->
<!--          left_join(UI_Claims_March28_True)) + -->
<!--   geom_text(aes(x = `13`/1000, y = `14`/1000, label=location))  + -->
<!--   labs(x = "Advance Estimates 3/22-3/28", -->
<!--        y = "Predicted Estimates 3/29-4/4", -->
<!--        title = "Which states are going to grow", -->
<!--        subtitle = "Time Period:  3/29-4/4", -->
<!--        color = "Prediction") + -->
<!--   theme_classic(base_size=15) + -->
<!--   scale_x_log10() + scale_y_log10() + -->
<!--   geom_abline(slope=1, intercept=0) -->

<!-- ``` -->

We predict large variation across states and the table in the Appendix describes, for each state, the estimated claims level based only on extrapolation from news reports, the Google Trends change and the forecast claims level based on the model combining news reports and Google Trends information. These state estimates are not seasonally adjusted.




# Data Sources


We are greatly helped by many states reporting various UI claims statistics over the course of recent weeks. We gather and harmonize the various reported numbers across articles to construct a dataset of “reports.” News articles report fact statements that tend to describe the number of claims for a given set of consecutive dates (from start date $S$ to end date $E$) based on information from state officials. For example, an article might say, the State received 10,394 claims on Monday and Tuesday. Since reports vary over what periods that they report data (some report over a 4 day span, some over a one day span), we reconcile these differences by using a “report-level” dataset, wherein each reported fact statement is treated as an observation. For each report, we construct the per-day average claim, and call that our claim measure $C$. We found reports for all 50 states and the District of Columbia and constructed report-level here: https://docs.google.com/spreadsheets/d/1RN1XJLIpU12QUwMpkF0DNiV8fkeqdHbWHta2sRfEZT4/edit#gid=651560

For estimation, we then link this to the average of the daily Google Trends data for that particular spell.


## Google Trends

We pull data from http://www.google.com/trends, a Google product that aggregates search volume by geography. Many papers have used this previously as measures of activity -- one example is Stephens-Davidowitz (2014).

The data is unusually reported. To quote Google:

> Search results are normalized to the time and location of a query by the following process: Each data point is divided by the total searches of the geography and time range it represents to compare relative popularity. Otherwise, places with the most search volume would always be ranked highest. The resulting numbers are then scaled on a range of 0 to 100 based on a topic’s proportion to all searches on all topics.

More specifically, to quote Seth Stephens-Davidowitz:

> It (Google Trends) takes the percent of all searches that use that term; then divides by the highest number. So if 1 percent of searches include coronavirus in City A and 0.5 percent of searches include coronavirus in City B, city B will have a number half as high as City A.

We pull a dataset of all fifty states (as well as Washington DC and the national trend ("USA")), collecting an index of the relative search volume for "file for unemployment." A crucial feature of the Google Trends API is it is only possible to compare five locations per search. To elide this issue, we pull data for California plus four states, and continuously renormalize each state by $\max{Index_{s}}/\max{Index_{CA}}$. This way, all states are relative to California (and now some of the index measures will be larger than 100.), and comparisons can be made both across time and geographies.

We pull data for all states, as well as the national trend, from February 1st to April 18th (the latest that the data is currently available). We plot the relative indices for select states below, and see that similar to the UI growth in our news data, there is also substantial differences across states in the growth of the search term. Additionally, the weekend effect is quite noticeable, with far more search activity on the Monday after a weekend and the Friday before.


```{r, fig.height = 8, fig.width=10, echo=FALSE, warning=FALSE, message=FALSE}
gg_color_hue <- function(n) {
  hues = seq(15, 375, length=n+1)
  hcl(h=hues, l=65, c=100)[1:n]
}
state_labels = data_states_short %>%
  arrange(location, date) %>%
  group_by(location) %>%
  filter(!is.na(hits)) %>%
  filter(row_number() == n())



plot_data_ntl = national_trend %>% mutate(date = date(date)) %>%
  filter(date >= ymd("2020-02-22") & date <= ymd("2020-04-20")) %>%
  mutate(location = "USA") %>%
  bind_rows(data_states_short %>% filter(date >= ymd("2020-02-22")) %>%
              filter(location %in% c("NY", "CA", "OH", "PA", "MI", "FL", "AZ")))

plot_data_ntl$location <- relevel(as.factor(plot_data_ntl$location), "USA")
dates = plot_data_ntl %>% select(date) %>% unique()
sats <- which( wday(dates$date)==7)
suns <- which(wday(dates$date)==1)

plot_data_ntl %>% write_csv("data/plot_data_ntl.csv")
ggplot() +
  geom_line(data = plot_data_ntl, aes(y = hits, x = date(date), color= as.factor(location))) +
  scale_x_date(date_breaks = "7 days", date_labels = "%m-%d") +
  geom_text_repel(data = plot_data_ntl %>% group_by(location) %>% filter(row_number() == n()),
                  aes(y = hits, x = date, label = location, color=location), segment.alpha = 0.5,
                  nudge_x = 1.5, show.legend=FALSE) +
  geom_rect(aes(xmin=dates$date[sats[1]], xmax=dates$date[suns[1]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
  geom_rect(aes(xmin=dates$date[sats[2]], xmax=dates$date[suns[2]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
  geom_rect(aes(xmin=dates$date[sats[3]], xmax=dates$date[suns[3]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
  geom_rect(aes(xmin=dates$date[sats[4]], xmax=dates$date[suns[4]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
  geom_rect(aes(xmin=dates$date[sats[5]], xmax=dates$date[suns[5]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
    geom_rect(aes(xmin=dates$date[sats[6]], xmax=dates$date[suns[6]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
      geom_rect(aes(xmin=dates$date[sats[7]], xmax=dates$date[suns[7]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
      geom_rect(aes(xmin=dates$date[sats[8]], xmax=dates$date[suns[8]],
                  ymin=-Inf, ymax=Inf),
            fill='grey', alpha=0.25) +
  theme_classic(base_size=15) +
  scale_color_manual(values = c(  "black", gg_color_hue(7)))+
  labs(x = "Date",
       y = "",
       title="Daily Google search intensity  for 'File for unemployment'",
       subtitle = "From 2020-2-22 to 2020-4-18, highlighting national trend and select states",
       caption = "Weekends shaded",
       color = "Search Regions"
  )
ggsave("plot_data_ntl.pdf")

growth_rate_weekly3 %>% select(location, early, late, late_nyt) %>%
  rename(baseline = early, week0315 = late, week0322 = late_nyt) %>% write_csv("growth_rate_weekly.csv")

```


# Estimation
Finally, we consider the relationship between these two measures. For the purposes of estimation, we focus on estimating only with reports that ended by 3/21. That way we are able to use news and official reports for the week of 3/22-3/28 as validation for our empirical model, as we discuss at the end.

With the claims reports as data points, we construct a growth measure, relative to each state’s average of initial claims in the four prior weeks, ending Saturdays 2/22-3/14. We consider the change in the Google Trends index between the 3/15-3/21 week and the day of the week average from the last four weeks (2/22-3/14). We then plot these two measures to consider how correlated the change in Google Trends search intensity is with UI growth.


```{r, fig.height = 8, echo=FALSE, warning=FALSE, message=FALSE}


# ggplot(data = daily_plot_data %>% filter(epiweek(date) > 11) %>%
#          mutate(week_str = case_when(epiweek(date) == 12 ~ "3/15-3/21",
#                                      epiweek(date) == 13 ~ "3/22-3/28")) %>%
#          filter(!is.na(hits))) +
#   geom_point(aes(y = ui_claims_daily/baseline_ui, x = hits - early,
#                  size = baseline_ui, color = as.factor(week_str))) +
#   geom_smooth(aes(y = ui_claims_daily/baseline_ui, x = hits - early, weight = baseline_ui), method = "lm") +
#   theme_classic(base_size=15) +
#   theme(
#   strip.background = element_blank(),
#   #strip.text.x = element_blank()
#   strip.text = element_text(size=10)
#   ) +
#   labs(x = "Google Search Intensity",
#        y = "Growth in UI Filings relative to Baseline",
#        title="Comparing daily Google search intensity for 'File for unemployment' vs. UI Claims",
#        subtitle = "From 2020-3-15 to 2020-3-23, for reporting states. Index normalizes by baseline period.",
#        size = "Baseline UI Claims",
#        color = "UI Reporting Week"
#   )

ggplot(data = report_UI_GT_data %>%
         filter(epiweek(week_start) > 11 & epiweek(week_end) <= 12) %>%
         filter(!is.na(hits)) %>%
         mutate(num_days = 1 + as.numeric(week_end - week_start)) %>%
         mutate(high_freq = num_days < 3)) +
  geom_point(aes(y = ui_norm, x = hits_norm,
                 size = baseline_ui)) +
  geom_smooth(aes(y = ui_norm, x = hits_norm, weight = baseline_ui), method = "lm") +
  theme_classic(base_size=15) +
  theme(
  strip.background = element_blank(),
  #strip.text.x = element_blank()
  strip.text = element_text(size=10)
  ) +
  labs(x = "Change in Google Search Intensity",
       y = "Growth in UI Filings",
       title="Daily Google search intensity vs. UI Claims",
       subtitle = "From 2020-3-15 to 2020-3-22",
       caption = "Growth in UI claims from news reports",
       size = "Baseline UI Claims",
       color = "UI Reporting Week"
  )
```

```{r, echo=FALSE, warning=FALSE}
a = summary(model_report_daily, robust=TRUE)
a

```

We find a strong relationship between the two variables, with an adjusted $R^{2}$ of `r round(a$adj.r.squared, digits = 4)` when we weight observations by the states' baseline UI claims.  We use this estimated model and observed Google Trends changes to predict unemployment claims for the states lacking news-based estimates.


Finally, we want to forecast the single statistic of weekly national initial claims. We do this in a very simple way, predicting the level of UI growth based on our model and the daily Google trends data, and then converting into predicted UI claims numbers. We sum these predicted measures across states for each week. For seasonally-adjusted numbers, we then scale up 3/15-3/21 by 0.833, and 3/22-3/28 by 0.876, per U.S. DOL practice.

For the week of 3/15-3/21, we predicted `r round(report_output_text$predicted_ui_sa[1], digits = 1)` million UI claims, with a 95\% CI of `r round(report_output_text$predicted_ui_lb_sa[1], digits = 1)` million and `r round(report_output_text$predicted_ui_ub_sa[1], digits = 1)` million for the week of 3/15-3/21.

For the week of 3/22-3/28, the figure of Google Trends interest above shows that Sunday, March 22, the first day that will be included in the report, was 500 percent higher than the prior Sunday and Monday 250 percent higher than the prior Monday. Google Trends interest continued to be high throughout the week, suggesting that significant new UI activity. Combining this information with our model implies a prediction of `r round(report_output_text$predicted_ui_sa[2], digits = 1)` million UI claims, with a 95\% CI of `r round(report_output_text$predicted_ui_lb_sa[2], digits = 1)` million and `r round(report_output_text$predicted_ui_ub_sa[2], digits = 1)` million for the week of 3/22-3/28.

We additionally report the non-seasonally adjusted numbers below as well.



```{r, echo=FALSE, warning=FALSE, message=FALSE}

weekly_predict_data  %>%  ungroup() %>%
  mutate(week_str = case_when(week == 12 ~ "3/15-3/21",
                              week == 13 ~ "3/22-3/28",
                              week == 14 ~ "3/29-4/4",
                              week == 15 ~ "4/5-4/11",
                              week == 16 ~ "4/12-4/18")) %>%
  group_by(week_str) %>%
  mutate(predicted_ui_report = predicted_ui_report/1e6,
         predicted_ui_lb_report = predicted_ui_lb_report/1e6,
         predicted_ui_ub_report = predicted_ui_ub_report/1e6) %>%
mutate(predicted_ui_report_sa = case_when(week == 12 ~ predicted_ui_report/0.833,
                                     week == 13 ~ predicted_ui_report/0.876,
                                     week == 14 ~ predicted_ui_report*1.065,
                                     week == 15 ~ predicted_ui_report*1.0548,
                                     week == 16 ~ predicted_ui_report*1.037),
       
         predicted_ui_lb_report_sa = case_when(week == 12 ~ predicted_ui_lb_report/0.833,
                                     week == 13 ~ predicted_ui_lb_report/0.876,
                                     week == 14 ~ predicted_ui_lb_report*1.065,
                                     week == 15 ~ predicted_ui_lb_report*1.0548,
                                     week == 16 ~ predicted_ui_lb_report*1.037),
         predicted_ui_ub_report_sa = case_when(week == 12 ~ predicted_ui_ub_report/0.833,
                                     week == 13 ~ predicted_ui_ub_report/0.876,
                                     week == 14 ~ predicted_ui_ub_report*1.065,
                                     week == 15 ~ predicted_ui_ub_report*1.0548,
                                     week == 16 ~ predicted_ui_ub_report*1.037)) %>%
  select(week_str, week, ends_with("report"), ends_with("sa")) %>%
  summarize_all(sum) %>%
  arrange(week) %>% select(-week)%>%
  kable(digits = 1, format.args = list(big.mark = ",", scientific = FALSE),
        col.names = c("Week", "Predicted UI Claims (millions)",
                                  "Lower Bound",
                                  "Upper Bound",
                      "Predicted UI Claims (millions)",
                                  "Lower Bound",
                                  "Upper Bound")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F) %>%
  add_header_above(c(" " = 2, "95% Confidence Interval" = 2, " " = 1, "95% Confidence Interval" = 2)) %>%
  add_header_above(c(" " = 1, "Not Seasonally Adjusted" = 3, "Seasonally Adjusted" = 3))
```

# Model evaluation / validation

Based on the advance reports from the states, we can evaluate how we did in our forecasts. We're able to do this in two ways -- comparing our estimates to the advance estimates, and using a hold-out sample.

## The Week of 3/15-3/21

For the week of 3/15-3/21, there are initial advance reports of UI claims at the state level that reported on March 26. We compare the model's predictions for that week relative to the advance numbers, and find that for many states the model did quite well. However, for certain states, particularly California and New York, it was substantially over. This discrepancy may be due to overwhelm of  UI administrative systems in those states.

```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% ungroup() %>%
  filter(week == 12) %>%
  select(-week) %>%
  left_join(UI_Claims_March21_True) %>%
  select(`State` = location,
         Advance,
         `Predicted UI Claims` = predicted_ui_report,
         `Lower Bound`=predicted_ui_lb_report,
         `Upper Bound`=predicted_ui_ub_report)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State)) +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/21",
       color = "Prediction") +
  theme_classic(base_size=15) +
  annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  geom_abline(slope=1, intercept=0)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State))  +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/21",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = 3, y = 300, hjust = 0, vjust = 1,
           label = lm_eqn(lm(log(`Predicted UI Claims`) ~ log(Advance), evaluation)), parse = TRUE)+
  scale_y_log10() +
  scale_x_log10() +
  geom_abline(slope=1, intercept=0)



```

We can also look at the *revised* numbers reported on April 2nd and see how we do relative to those:


```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% ungroup() %>%
  filter(week == 12) %>%
  select(-week) %>%
  left_join(UI_Claims_March28_True) %>%
  select(`State` = location,
         Advance = updated_0315,
         `Predicted UI Claims` = predicted_ui_report)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State)) +
  labs(x = "Updated Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Updated Estimates",
       subtitle = "Time Period:  3/15-3/21, reported 4/2",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  geom_abline(slope=1, intercept=0)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State))  +
  labs(x = "Updated Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Updated Estimates",
       subtitle = "Time Period:  3/15-3/21, reported 4/2",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = 3, y = 300, hjust = 0, vjust = 1,
           label = lm_eqn(lm(log(`Predicted UI Claims`) ~ log(Advance), evaluation)), parse = TRUE)+
  scale_y_log10() +
  scale_x_log10() +
  geom_abline(slope=1, intercept=0)



```

## The Week of 3/22-3/28

Since we only use the week of 3/15-3/21 to estimate the model, we can also use the news reports from 3/22-3/28 to assess how well the model does. This is our leave-out sample, and hence will give us a sense of how stable the relationship is.

```{r, echo=FALSE, warning=FALSE, message=FALSE}

## Validate with new report data in week 13/14
validation_data = daily_predict_data %>%
  select(location, date, ui_claims_report_daily_hat) %>%
  inner_join(report_level_UI_data_fill) %>%
  filter(epiweek(date) == 13) %>%
  group_by(report_id, location) %>%
  summarize(ui_claims_report_daily_hat = sum(ui_claims_report_daily_hat,
                                             na.rm = TRUE),
            claims = sum(claims_avg, na.rm = TRUE),
            num_days = n()) %>%
  inner_join(UI_Claims_March21 %>% select(location, baseline_ui)) %>%
  mutate(claims_norm = claims / baseline_ui, y_hat_norm = ui_claims_report_daily_hat / baseline_ui)


ggplot(data = validation_data) +
  geom_text(aes(x = claims/1000, y=ui_claims_report_daily_hat/1000, label = location)) +
  geom_abline(slope = 1, intercept = 0) +
    labs(x = "News Report Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to News Estimates",
       subtitle = "Time Period:  3/22-3/28",
       color = "Num. days in report") +
  theme_classic(base_size=15) +
    annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  # scale_y_log10() +
  # scale_x_log10() +
  geom_abline(slope=1, intercept=0)

a = summary(lm(data = validation_data, claims_norm ~ y_hat_norm),  robust=TRUE)
b = summary(lm(data = validation_data, claims_norm ~ y_hat_norm, weight = baseline_ui), robust=TRUE)

```
The model does remarkably well, with an adjusted $R^{2}$ of `r round(b$adj.r.squared, digits = 1)`.


The model does remarkably well, with an adjusted $R^{2}$ of `r round(b$adj.r.squared, digits = 4)`.

We can now also check how we did by comparing to advance estimates:

```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% ungroup() %>%
  filter(week == 13) %>%
  select(-week) %>%
  left_join(UI_Claims_March28_True) %>%
  select(`State` = location,
         Advance = advance_0322,
         `Predicted UI Claims` = predicted_ui_report)


ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State)) +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/22-3/28",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  geom_abline(slope=1, intercept=0)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State))  +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/22-3/28",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = 3, y = 500, hjust = 0, vjust = 1,
           label = lm_eqn(lm(log(`Predicted UI Claims`) ~ log(Advance), evaluation)), parse = TRUE)+
  scale_y_log10() +
  scale_x_log10() +
  geom_abline(slope=1, intercept=0)



```


## Combining the two weeks

Finally, to minimize the role of congestion concerns by averaging across weeks, we consider how the model did at predicting the sum of the advance estimates, i.e. the total of the two sets of advance estimates between 3/15-3/28.


```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% group_by(location) %>%
  filter(week == 12 | week == 13) %>%
  summarize(predicted_ui_report = sum(predicted_ui_report)) %>%
  left_join(UI_Claims_March28_True) %>%
  left_join(lf_state) %>%
  mutate(advance_sum = (advance_0322 + advance_0315)) %>%
  select(`State` = location,
         Advance = advance_sum,
         `Predicted UI Claims` = predicted_ui_report)  


ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State)) +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim s(thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/28",
       color = "Prediction") +
    annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  theme_classic(base_size=15) +
  geom_abline(slope=1, intercept=0)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State))  +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/28",
       color = "Prediction") +
  annotate("text", x = 10, y = 1000, hjust = 0, vjust = 1,
           label = lm_eqn(lm(log(`Predicted UI Claims`) ~ log(Advance), evaluation)), parse = TRUE)+
  theme_classic(base_size=15) +
  scale_y_log10() +
  scale_x_log10() +
  geom_abline(slope=1, intercept=0)

```

and scaled by labor force as of February 2020:

```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% group_by(location) %>%
  filter(week == 12 | week == 13) %>%
  summarize(predicted_ui_report = sum(predicted_ui_report)) %>%
  left_join(UI_Claims_March28_True) %>%
  left_join(lf_state) %>%
  mutate(advance_sum = (advance_0322 + advance_0315)/labor_force,
         predicted_ui_report = predicted_ui_report/labor_force) %>%
  select(`State` = location,
         Advance = advance_sum,
         `Predicted UI Claims` = predicted_ui_report, labor_force)

model_graph = summary(lm(data = evaluation, Advance ~ `Predicted UI Claims`))
ggplot(data = evaluation) +
  geom_text(aes(x = Advance, y = `Predicted UI Claims`, label=State)) +
  labs(x = "UI Claims as share of Feb 2020 Labor Force",
       y = "Predicted Estimate as share of Feb 2020 Labor Force",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/28",
       color = "Prediction") +
  annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation, weight=labor_force)), parse = TRUE)+
  theme_classic(base_size=15) +
  geom_abline(slope=1, intercept=0)

```


As a check, comparing to the advance + revised:

```{r, echo=FALSE, message=FALSE, warning=FALSE}
evaluation = weekly_predict_data %>% group_by(location) %>%
  filter(week == 12 | week == 13) %>%
  summarize(predicted_ui_report = sum(predicted_ui_report)) %>%
  left_join(UI_Claims_March28_True) %>%
  mutate(advance_sum = advance_0322 + updated_0315) %>%
  select(`State` = location,
         Advance = advance_sum,
         `Predicted UI Claims` = predicted_ui_report)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State)) +
  labs(x = "Advance + Revised Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim s(thousands)",
       title = "Comparing Model Predictions to Advance + Revised Estimates",
       subtitle = "Time Period:  3/15-3/28",
       color = "Prediction") +
    annotate("text", x = -Inf, y = Inf, hjust = 0, vjust = 1,
           label = lm_eqn(lm(`Predicted UI Claims` ~ Advance, evaluation)), parse = TRUE)+
  theme_classic(base_size=15) +
  geom_abline(slope=1, intercept=0)

ggplot(data = evaluation) +
  geom_text(aes(x = Advance/1000, y = `Predicted UI Claims`/1000, label=State))  +
  labs(x = "Advance Official Estimates (thousands)",
       y = "Predicted Estimate of UI Claim (thousands)",
       title = "Comparing Model Predictions to Advance Estimates",
       subtitle = "Time Period:  3/15-3/28",
       color = "Prediction") +
  theme_classic(base_size=15) +
    annotate("text", x = 10, y = 1000, hjust = 0, vjust = 1,
           label = lm_eqn(lm(log(`Predicted UI Claims`) ~ log(Advance), evaluation)), parse = TRUE)+
  scale_y_log10() +
  scale_x_log10() +
  geom_abline(slope=1, intercept=0)

```


# Appendix

## Latest Results
We predict large variation across states and the table below describes, for each state, the estimated claims level based only on extrapolation from news reports, the Google Trends change and the forecast claims level based on the model combining news reports and Google Trends information. These state estimates are not seasonally adjusted.

```{r, echo = FALSE, warning=FALSE, message=FALSE}

report_output %>% left_join(UI_Claims_March28_True %>% rename(State = location)) %>%
  mutate(`2 week total`  = advance_0322 + updated_0315) %>%
  select(State,
         google_12, advance_0315, updated_0315,
           `12`,  google_13, advance_0322,
         `13`,   `2 week total`,  Total ) %>%
  kable(digits = 0, format.args = list(big.mark = ",", scientific = FALSE),
         col.names = c("State",  "Google Trends Change from 2/22-3/14", "Advance Official UI Claims", "Revised Official UI Claims",  "Predicted UI Claims", "Google Trends Change from 2/22-3/14",  "Advance Official UI Claims", "Predicted UI Claims", "Revised + Advance Official UI Claims", "Predicted UI Claims")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F) %>%
  add_header_above(c(" " = 1, "Week 3/15-3/21" = 4, "Week 3/22-3/28" = 3, "Combined Weeks 3/15-3/28"=2)) %>%
  scroll_box(width = "1000px", height = "400px")

weekly_predict_data %>% ungroup() %>% filter(week == 12 | week == 13 | week == 14) %>%
  select(location, week, predicted_ui = predicted_ui_report) %>%
  spread(week, predicted_ui) %>%
  left_join(UI_Claims_March21_True) %>%
  left_join(growth_rate_weekly3) %>%
  rename(State = location) %>%
  mutate(google_12 = late - early,
         google_13 = late_nyt - early,
         google_14 = late_next - early) %>%
  select(State,  Advance, google_12, `12`,  google_13, `13`, google_14, `14`) %>%
  mutate(Total = `12` + `13`) %>%
  select(State, pred_total = Total, pred_0315 = `12`, pred_0322 =`13`, pred_0328 =`14`,
         google_0315 = google_12, google_0322 = google_13, google_0328 = google_14) %>%
  write_csv("data/state_predictions_weekly4042020.csv")
```



<!-- ```{r} -->
<!-- regions <- read_excel("data/regions.xlsx") -->
<!-- plot_data = growth_rate_weekly3 %>%  -->
<!--   mutate(late = late - early, -->
<!--          late_nyt = late_nyt - early, -->
<!--          late_next = late_next - early) %>% -->
<!--   select(location, `3/15-3/21`=late,  -->
<!--          `3/22-3/28` = late_nyt,  -->
<!--          `3/29-3/31` =late_next) %>%  -->
<!--   gather(time_period, val, -location)  %>% -->
<!--   inner_join(regions)  -->
<!-- plot_data$time_period <- fct_rev(plot_data$time_period ) -->
<!-- ggplot(data = plot_data) + geom_col(aes(y = val, x = reorder(location, -val), fill = as.factor(time_period)), position = "dodge") + coord_flip() + theme_classic(base_size = 16) + -->
<!--   labs(y = "Change in Google Trends from baseline", -->
<!--        x = "", -->
<!--        title = "Growth in search history relative to baseline (2/22-3/14)", -->
<!--        subtitle = "Searches for 'file for unemployment'", -->
<!--        fill = "Time Period" -->
<!--   ) + -->
<!--   theme(strip.background = element_blank()) + -->
<!--   facet_wrap(~bigregion, scales = "free_y") -->
<!-- ``` -->

<!-- plot_data = weekly_predict_data %>%  filter(location != "DC") %>%  -->
<!--   mutate(week_str = case_when(week == 12 ~ "3/15-3/21", -->
<!--                               week == 13 ~ "3/22-3/28", -->
<!--                               week == 14 ~ "3/29-4/4", -->
<!--                               week == 15 ~ "4/5-4/11")) %>% -->
<!--   left_join(lf_state) %>% mutate(share = predicted_ui_report/labor_force) %>% select(location, week_str, share, predicted_ui_report)  -->

<!--   plot_data %>% spread(week_str, predicted_ui_report) %>% write_csv("state_level_predictions.csv") -->


<!-- ggplot(data = plot_data %>% filter(week == 15)) + geom_col(aes(y = share, x = reorder(location, -share)))  + coord_flip() + theme_classic(base_size = 24) + theme(axis.text = element_text(size = 16)) labs(y = "Predicted Share of Labor Force Filed for UI", x="", title = "Predictions of Initial State UI claims for Week 4/5-4/11")  + scale_y_continuous(expand = c(0, 0)) -->

<!-- ggplot(data = plot_data %>% filter(week_str == "4/5-4/11")) + geom_bar(aes(y = share, x = reorder(location, -share), width=labor_force))  + coord_flip() + theme_classic(base_size = 24) + theme(axis.text = element_text(size = 16)) + labs(y = "Predicted Share of Labor Force Filed for UI", x="", title = "Predictions of Initial State UI claims for Week 4/5-4/11")  + scale_y_continuous(expand = c(0, 0)) -->

<!-- plot_data = plot_data %>%  filter(week_str == "4/5-4/11") %>% arrange(share) -->
<!-- plot_data$right <- cumsum(plot_data$labor_force) + 30*c(0:(nrow(plot_data)-1)) -->
<!-- plot_data$left <- plot_data$right - plot_data$labor_force  -->
<!-- ```{r} -->
<!-- sum(plot_data$labor_force) -->
<!-- ggplot(plot_data, aes(ymin = 0)) + -->
<!--   geom_rect(aes( -->
<!--     xmin = left / sum(plot_data$labor_force), -->
<!--     xmax = right / sum(plot_data$labor_force), -->
<!--     ymax = share -->
<!--   )) + -->
<!--   coord_flip() + -->
<!--   geom_text_repel(aes( -->
<!--     y = share , -->
<!--     x = (left / sum(plot_data$labor_force))  + (right - left) / (2 * sum(plot_data$labor_force)), -->
<!--     label = location, color=location -->
<!--   ), hjust = "left") + -->
<!--   theme_classic(base_size = 24) + -->
<!--   theme(axis.text = element_text(size = 16), -->
<!--         legend.position = "none") + -->
<!--   labs(y = "Predicted Share of Labor Force Filed for UI", -->
<!--        x = "State Share of Labor Force", -->
<!--        title = "Predictions of Initial State UI claims for Week 4/5-4/11") + -->
<!--   scale_y_continuous(expand = c(0, 0), limits = c(0, 0.12)) -->

<!-- ``` -->