State unemployment rate dataviz

An update to a remix of a remix

A couple years ago I posted R code for a remix of a remix of a US state unemployment rate chart.

Post Working on a workout. Some of the images were lost in a blog transition. We’ll update below.

Here’s an updated version:

And another remix focusing just on April 2020 (latest data).

R code

######################
## Load Libraries ##
######################
library(data.table)
library(quantmod)
library(tidyverse)
library(geofacet)


# Download data big file
ur.data<-fread("http://download.bls.gov/pub/time.series/la/la.data.1.CurrentS")

# Download series ids

ur.series<-fread("http://download.bls.gov/pub/time.series/la/la.series")

# We'll subset data
ur.list<-ur.series[area_type_code =="A" &   #get states
                     measure_code == "3"  &   #get unemployment rate
                     seasonal == "S",         #get seasonally adjusted data
                   c("series_id","area_code","series_title"),
                   with=F]

## Get state names and area crosswalk
ur.area<-fread("http://download.bls.gov/pub/time.series/la/la.area",
               col.names=
                 c("area_type_code","area_code","area_text","display_level",
                   "selectable","sort_sequence"))                   

# merge data
ur.dt<-merge(ur.data,ur.list,by="series_id",all.y=T)

#create data variable
ur.dt[,month:=as.numeric(substr(ur.dt$period,2,3))]
ur.dt$date<- as.Date(ISOdate(ur.dt$year,ur.dt$month,1) ) #set up date variable
ur.dt<-merge(ur.dt,ur.area[,c("area_text","area_code"),with=F],by="area_code")


# Load national unemployment rate using quantmod and FRED database

# helpful reference https://jeffreybreen.wordpress.com/tag/quantmod/
unrate = getSymbols('UNRATE',src='FRED', auto.assign=F) 
unrate.df = data.frame(date=time(unrate), coredata(unrate) )

# Drop some columns
ur.dt2<-ur.dt[,c("date","area_text","value"),with=F][,value:=as.numeric(value)]

## rename variables
ur.dt2<-dplyr::rename(ur.dt2, state=area_text)
ur.dt2<-dplyr::rename(ur.dt2, ur=value)

# merge national unemploymnent 
ur.dt2<-merge(ur.dt2,unrate.df,by="date")
ur.dt2<-dplyr::rename(ur.dt2, ur.us=UNRATE)  #rename UNRATE to ur.us

# create variables for use in ribbon chart
ur.dt2[,up:=ifelse(ur>ur.us,ur,ur.us)]
ur.dt2[,down:=ifelse(ur<ur.us,ur,ur.us)]

# drop D.C. and Puerto Rico (so we can have 50 plots in small multiple)
ur.plot<-ur.dt2[! state %in% c("Puerto Rico","District of Columbia")]


# Get list of states:
st.list<-unique(ur.plot$state)

# used in original post for animation, not needed here, too lazy to undo
ur.plot.us<-copy(ur.plot)[state=="Alabama"]
ur.plot.us[,state:="United States"]
ur.plot.us[,ur:=ur.us]
ur.plot.us[,up:=ur.us]
ur.plot.us[,down:=ur.us]
ur.plot2<-rbind(ur.plot,ur.plot.us)

# State geo facet plot  ----

g1<-
  ggplot(data=ur.plot2,aes(x=date,y=ur))+
  geom_line(color="black")+
  geom_line(linetype=2,aes(y=ur.us))+
  geom_ribbon(aes(ymin=ur,ymax=down),fill="#d73027",alpha=0.5)+
  geom_ribbon(aes(ymin=ur,ymax=up),fill="#4575b4",alpha=0.5)+
  #facet_wrap(~state,ncol=10,scales="free_x")+
  facet_geo(~state)+
  scale_y_continuous(limits=c(0,20))+
  theme_minimal()+
  theme(legend.position="top",
        plot.caption=element_text(hjust=0),
        plot.subtitle=element_text(face="italic"),
        plot.title=element_text(size=16,face="bold"))+
  labs(x="",y="",
       title="The state of U.S. jobs - Working out @hrbmstr's workout of @stiles' Viz",
       subtitle="Solid line is state unemployment rate, dotted line is U.S. average unemployment rate\nRed (blue) indicates the state level is higher (lower) than the national average",
       caption="@lenkiefer Data Source: U.S. Bureau of Labor Statistics\nViz based on https://rud.is/b/2017/01/18/workout-wednesday-redux-2017-week-3/,\nitself based on http://thedailyviz.com/2016/12/14/four-decades-of-state-unemployment-rates-in-small-multiples-part-2/")+
  geom_rug(aes(color=ifelse(ur>ur.us,"Worse","Same or Better")),sides="b")+
  scale_color_manual(values=c("#4575b4","#d73027"),name="Better or worse than U.S.")

g1


# Static chart ----

g2 <-
  ggplot(data=filter(ur.plot,date==max(date)) %>%
           mutate(statef=fct_reorder(state,ur)), 
         aes(x=ur,y=statef,
             color=ur>ur.us,
             label=round(ur,1)))+
  geom_vline(aes(xintercept=ur.us),linetype=2)+
  geom_point()+
  geom_segment(linetype=2, aes(yend=statef,xend=ur.us))+
  geom_point(shape=21,fill="white", aes(x=ur.us))+
  geom_text(show.legend=FALSE, aes(hjust=ifelse(ur>ur.us,0,1)))+
  scale_x_continuous(breaks=c(5,10,14.7,20,25),
                     labels=c("5","10","14.7 (U.S.)", "20","25"))+
  scale_color_manual(values=c("#4575b4","#d73027"),
                     labels=c("State < US","State > US"),
                     name="Better or worse than U.S.")+
  theme_minimal()+
  theme(legend.position="top",
        plot.caption=element_text(hjust=0),
        plot.subtitle=element_text(face="italic"),
        plot.title=element_text(size=16,face="bold"))+
  labs(x="Unemployment Rate (%)",
       y="",
       title="State Unemployment Rate in April 2020",
       subtitle="open circle is U.S. average unemployment rate\nRed (blue) indicates the state level is higher (lower) than the national average",
       caption="@lenkiefer Data Source: U.S. Bureau of Labor Statistics")

g2