library(flexdashboard)
library(tidyverse)
library(tidyquant)
library(viridis)
library(scales)
library(tibbletime)
library(data.table)
library(rlang)
library(ggridges)
library(ggbeeswarm)
library(bea.R)
library(ggthemes)
library(lubridate)
library(data.table)
library(fredr)
library(gganimate)
library(gifski)
library(tweenr)
library(plotly)
library(directlabels)
library(quantmod)
library(rvest)
library(bsplus)
library(crosstalk)
library(sqldf)
library(highcharter)
library(glue)
library(htmltools)
library(DT)
library(tidyquant)
library(dplyr)
library(tidyr)codes_names_tbl <- dplyr::tribble(
~ symbol, ~ better_names,
"NPPTTL", "ADP Estimate",
"PAYEMS", "Nonfarm Employment",
"USCONS", "Construction",
"USTRADE", "Retail/Trade",
"USPBS", "Professional and Business Services",
"MANEMP", "Manufacturing",
"USFIRE", "Financial",
"USMINE", "Mining",
"USEHS", "Health Care",
"USWTRADE", "Wholesale Trade",
"USTPU", "Transportation",
"USINFO", "Information Systems",
"USLAH", "Leisure",
"USGOVT", "Government",
"USSERV", "Other Services"
)
fred_empl_data <-
tidyquant::tq_get(codes_names_tbl$symbol,
get = "economic.data",
from = "2007-01-01")
library(dplyr)
fred_empl_data <-
fred_empl_data %>%
left_join(codes_names_tbl,
by = "symbol" ) %>%
dplyr::select(better_names, everything(), -symbol) %>%
rename(employees = price, sector = better_names)
empl_monthly_change <-
fred_empl_data %>%
group_by(sector) %>%
mutate(monthly_change = employees - lag(employees, 1), yearly_change=employees - lag(employees,12) , yearly_percent_change = (employees/lag(employees,12)-1)*100) %>%
na.omit()
total_employ_hc <-
empl_monthly_change %>%
filter(sector == "Nonfarm Employment") %>%
mutate(color_of_bars = ifelse(monthly_change > 0, "#6495ed", "#ffe6ea"))emp_by_sector_recent_month <-
empl_monthly_change %>%
filter(date == (last(date))) %>%
filter(sector != "ADP Estimate") %>%
arrange(desc(monthly_change)) %>%
mutate(color_of_bars = if_else(monthly_change > 0, "#6495ed", "#ffe6ea"), color_of_bars2 = if_else(yearly_change > 0, "#6495ed", "#ffe6ea") )
last_month <- lubridate::month(last(empl_monthly_change$date),
label = TRUE,
abbr = FALSE)
d.list2 <- max(emp_by_sector_recent_month$date)
emp_by_sector_recent_month2 <- emp_by_sector_recent_month %>% arrange(desc(yearly_change))
emp_by_sector_recent_month3 <- emp_by_sector_recent_month[-1,]
most_month <- emp_by_sector_recent_month3[1,c(1,4)]
emp_by_sector_recent_month4 <- emp_by_sector_recent_month2[-1,]
most_year <- emp_by_sector_recent_month4[1,c(1,5,6)]tickers<- c("PAYEMS", # nonfarm payroll employment
"UNRATE", # unemployment rate
"CIVPART", # civilian labor force pariticipation rate
"EMRATIO", # employment-to-population ratio
"NROU" ) # estimate of natural rate of unemployment from U.S. Congressional Budget Office
mynames <- c("Nonfarm Payroll Employment",
"Unemploymen Rate",
"Labor Force Participation Rate",
"Employment-to-Population Ratio",
"Natural Rate of Unemployment")
mytickers<- data.frame(symbol=tickers,varname=mynames, stringsAsFactors =FALSE)
# download data via FRED
df<-tidyquant::tq_get(tickers, # get selected symbols
get="economic.data", # use FRED
from="1948-01-01") # go from 1954 forward
df <- left_join(df, mytickers, by="symbol")
df[,c(1:3)] %>%
spread(symbol,price) -> df2
# Convert quarterly naturla rate (NROU) data to monthly data by "filling down" using na.locf
df2 %>%
mutate(NROU2=na.locf(NROU,na.rm=F)) %>%
mutate(UGAP2=UNRATE-NROU2,
dj=c(NA,diff(PAYEMS)),
# create indicators for shaded plot
up=ifelse(UNRATE>NROU2,UNRATE,NROU2),
down=ifelse(UNRATE<NROU2,UNRATE,NROU2)) -> df2
# Set up recession indicators
recessions.df = read.table(textConnection(
"Peak, Trough
1948-11-01, 1949-10-01
1953-07-01, 1954-05-01
1957-08-01, 1958-04-01
1960-04-01, 1961-02-01
1969-12-01, 1970-11-01
1973-11-01, 1975-03-01
1980-01-01, 1980-07-01
1981-07-01, 1982-11-01
1990-07-01, 1991-03-01
2001-03-01, 2001-11-01
2007-12-01, 2009-06-01"), sep=',',
colClasses=c('Date', 'Date'), header=TRUE)
df2 <- df2 %>% arrange(desc(date))
df3 <- df2
colnames(df3)[1] <- "Date"
colnames(df3)[2] <- "Civilian LFPR"
colnames(df3)[3] <- "Emp to Pop Ratio"
colnames(df3)[4] <- "Natural Rate"
colnames(df3)[5] <- "Nonfarm Payrolls"
colnames(df3)[6] <- "Unemp Rate"
colnames(df3)[9] <- "Jobs Added (monthly)"
df3 <- df3[,-c(7,8,10,11)]dfs<-fread("https://download.bls.gov/pub/time.series/ln/ln.series")
codes<-dfs[grepl("Participation Rate", series_title) & # use regular expression
ages_code==33 & # only ags 25 to 54
periodicity_code =="M" & # only monthly frequence
seasonal=="S" # only Seasonally adjusted
]
codes$var <- c("All","Men","Women")
codes <- codes[,c(1,4,42)]
# get all data (large file)
df.all<-fread("https://download.bls.gov/pub/time.series/ln/ln.data.1.AllData")
# filter data
dfp<-df.all[series_id %in% codes$series_id,]
#create date variable
dfp[,month:=as.numeric(substr(dfp$period,2,3))]
dfp$date<- as.Date(ISOdate(dfp$year,dfp$month,1) ) #set up date variable
dfp$v<-as.numeric(dfp$value)
# join on variable names, drop unused variables, convert to data.table
left_join(dfp, codes, by="series_id") %>% data.table() -> dfp
dfp <- dfp[,c(1,7,8,9,10)]Jobs Friday
Most recent report on Nonfarm employment from the Bureau of Labor Statistics
Jake Dubbert
The US added 128,000 jobs in October, to 1.5194510^{5},000 total nonfarm employees. This was an increase of 2093,000 year-over-year, or a 1.3967114% increase. The largest gains were in the Leisure sector, with a monthly increase of 61,000 jobs. Meanwhile, the Health Care sector had the largest gains year-over-year, with 635,000 jobs added for a 2.6662748% gain over October of last year.
highcharter::hchart(total_employ_hc,
type = "column",
pointWidth = 5,
hcaes(x = date,
y = monthly_change,
color = color_of_bars),
name = "monthly change") %>%
hc_title(text = "Monthly Employment Change") %>%
hc_xAxis(type = "datetime") %>%
hc_yAxis(title = list(text = "monthly change (thousands)")) %>%
hc_exporting(enabled = TRUE)Employment Change by Sector
datatable(emp_by_sector_recent_month[,c(2,1,3,4,5,6)]%>% arrange(desc(date)),filter = 'none',extensions = "Buttons",options=list(pageLength=25,searching=T,dom="Bfrtip", buttons=c("copy", "csv", "excel","pdf")),
colnames=c("Date","Sector", "Total Employees", "Monthly Change ('000)", "Yearly Change ('000)", "YoY Change (%)"),
caption=htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
htmltools::strong('Nonfarm Employment as of', as.character((d.list2),format="%b-%Y")),
htmltools::br(),htmltools::em("Source: U.S. Bureau of Labor Statistics" )))hchart(emp_by_sector_recent_month,
type = "bar",
pointWidth = 20,
hcaes(x = sector,
y = monthly_change,
color = color_of_bars),
showInLegend = FALSE) %>%
hc_title(text = paste(last_month, "Employment Change Month-over-Month", sep = " ")) %>%
hc_xAxis(categories = emp_by_sector_recent_month$sector) %>%
hc_yAxis(title = list(text = "Monthly Change (thousands)")) %>%
hc_exporting(enabled = TRUE)hchart(emp_by_sector_recent_month2,
type = "bar",
pointWidth = 20,
hcaes(x = sector,
y = yearly_change,
color = color_of_bars2),
showInLegend = FALSE) %>%
hc_title(text = paste(last_month, "Employment Change YoY", sep = " ")) %>%
hc_xAxis(categories = emp_by_sector_recent_month2$sector) %>%
hc_yAxis(title = list(text = "Yearly Change (thousands)")) %>%
hc_add_theme(hc_theme_economist()) %>%
hc_exporting(enabled = TRUE)ggplot(data=filter(df2,!is.na(NROU2)),aes(x=date,y=UNRATE))+
geom_rect(data=recessions.df, inherit.aes=F, aes(xmin=Peak, xmax=Trough, ymin=-Inf, ymax=+Inf), fill='darkgray', alpha=0.5) +
geom_line(color="black")+
geom_line(linetype=2,aes(y=NROU2))+
geom_ribbon(aes(ymin=UNRATE,ymax=down),fill="#d73027",alpha=0.5)+
geom_ribbon(aes(ymin=UNRATE,ymax=up),fill="#4575b4",alpha=0.5) +
scale_x_date(date_breaks="5 years",date_labels="%Y")+
scale_y_continuous(sec.axis=dup_axis())+
theme_minimal(base_size=8)+
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="Percent",
title="U.S. Unemployment Rate vs Natural Rate of Unemployment",
subtitle="Solid line Unemployment Rate, dotted line Long-term Natural Rate of Unemployment",
caption="Data Source: U.S. Bureau of Labor Statistics, U.S. Congressional Budget Office,shaded bars NBER Recessions\nNatural Rate of Unemployment (Long-Term) retrieved from FRED, Federal Reserve Bank of St. Louis; https://fred.stlouisfed.org/series/NROU")+
geom_rug(aes(color=ifelse(UNRATE<=NROU2,"Below or Equal","Above")),sides="b")+
scale_color_manual(values=c("#d73027","#4575b4"),name="Unemployment Rate Above/Below Natural Rate ")
ggplot(data=df2, aes(x=date,y=UNRATE,label=UNRATE))+
geom_rect(data=recessions.df, inherit.aes=F, aes(xmin=Peak, xmax=Trough, ymin=-Inf, ymax=+Inf), fill='darkgray', alpha=0.5) +
geom_line(size=1.05)+theme_minimal()+
geom_point(data=filter(df2,date==max(df2$date)),size=2,alpha=0.75)+
geom_text(data=filter(df2,date==max(df2$date)),fontface="bold",size=4,nudge_y=.5)+
scale_x_date(date_breaks="1 years",date_labels="%Y")+
scale_y_continuous(sec.axis=dup_axis())+
theme(legend.position="none",
plot.caption=element_text(hjust=0),
plot.subtitle=element_text(face="italic"),
plot.title=element_text(size=16,face="bold"))+
labs(x="",y="",title="US Unemployment Rate (%)",
caption="Source: U.S. Bureau of Labor Statistics, shaded bars NBER Recessions")+
coord_cartesian(xlim=as.Date(c("2000-01-01","2020-01-01")),ylim=c(0,12))+
theme_fivethirtyeight()
ggplot(data=df2, aes(x=date,y=EMRATIO,label=EMRATIO))+
geom_rect(data=recessions.df, inherit.aes=F, aes(xmin=Peak, xmax=Trough, ymin=-Inf, ymax=+Inf), fill='darkgray', alpha=0.5) +
geom_line(size=1.05)+theme_minimal()+
geom_point(data=filter(df2,date==max(df2$date)),size=2,alpha=0.75)+
geom_text(data=filter(df2,date==max(df2$date)),fontface="bold",size=4,nudge_y=.25)+
scale_x_date(date_breaks="1 years",date_labels="%Y")+
scale_y_continuous(sec.axis=dup_axis())+
theme(legend.position="none",
plot.caption=element_text(hjust=0),
plot.subtitle=element_text(face="italic"),
plot.title=element_text(size=16,face="bold"))+
labs(x="",y="",title="Employment-to-Population Ratio ",
subtitle="in percentage points (seasonally adjusted)",
caption="Source: U.S. Bureau of Labor Statistics, shaded bars NBER Recessions\nEmployment-Population Ratio [EMRATIO], retrieved from FRED, Federal Reserve Bank of St. Louis;\nhttps://fred.stlouisfed.org/series/EMRATIO")+
coord_cartesian(xlim=as.Date(c("2000-01-01","2020-01-01")),ylim=c(58,65))+
theme_economist()
ggplot(data=dfp, aes(x=date,y=v,color=var, label=var))+
geom_rect(data=recessions.df, inherit.aes=F, aes(xmin=Peak, xmax=Trough, ymin=-Inf, ymax=+Inf), fill='darkgray', alpha=0.5) +
geom_line(size=1.05)+theme_minimal()+
geom_point(data=filter(dfp,date==max(dfp$date)),size=2,alpha=0.75)+
geom_text(data=filter(dfp,date==max(dfp$date)),fontface="bold",size=4,nudge_y=1)+
scale_x_date(date_breaks="1 years",date_labels="%Y")+
scale_y_continuous(sec.axis=dup_axis())+
theme(legend.position="none",
plot.caption=element_text(hjust=0),
plot.subtitle=element_text(face="italic"),
plot.title=element_text(size=16,face="bold"))+
labs(x="",y="",title="Labor Force Participation Rate: Prime Working Age (25-54)",
subtitle="in percentage points (seasonally adjusted)",
caption="Source: U.S. Bureau of Labor Statistics, shaded bars NBER Recessions")+
coord_cartesian(xlim=as.Date(c("2000-01-01","2020-01-01")),ylim=c(70,95))