Last issue

Included this week:

  • Central Bank Benchmark Rates
  • Unemployment
  • Commencements vs Completions, follow on from last week
  • Oil, follow on from last month

Rates

The following selected benchmark rates were the most representative up to date series from the FEDs database, note they are not exacly the same but illustrative of the interest rate hikes in the United Kingdom, the United States and the Euro Area.

The latest 0.75% for each of the banks can be seen below.

FEDFUNDS<-fredr(series_id = "EFFR",
              observation_start = as.Date("2010-01-01"),
              observation_end = as.Date("2022-11-04"))
FEDFUNDS$Benchmark <- "Federal Funds Effective Rate"

SONIA<-fredr(series_id = "IUDSOIA",
              observation_start = as.Date("2010-01-01"),
              observation_end = as.Date("2022-11-03"))
SONIA$Benchmark <- "SONIA Rate"

ECBDFR<-fredr(series_id = "ECBDFR",
              observation_start = as.Date("2010-01-01"),
              observation_end = as.Date("2022-11-07"))
ECBDFR$Benchmark <- "ECB Deposit Facility Rate"

RATES <- rbind(FEDFUNDS,SONIA,ECBDFR)

RATES %>%
  ggplot(aes(x=date,y=value,group=Benchmark,colour=Benchmark))+
  geom_line(size=1.15,alpha=0.7)+
  geom_hline(yintercept = 0,linetype="dotted")+
  theme_bw()+
  theme(legend.position = "bottom")+
  ggtitle("Selected Benchmark Rates - ECB, FED & BOE")+
  scale_color_manual(values=c("navy","blue","darkred"))+
  ylab("%")
The Sterling Overnight Index Average (SONIA) is the interest rate applied to bank transactions in the British Sterling Market during off hours, this closely tracks the Official Bank Rate for the BOE which I could not put my hands on in the St. Louis FRED database.

The Sterling Overnight Index Average (SONIA) is the interest rate applied to bank transactions in the British Sterling Market during off hours, this closely tracks the Official Bank Rate for the BOE which I could not put my hands on in the St. Louis FRED database.

Unemployment

MUM01 <- cso_get_data("MUM01")
MUM01 <- MUM01 %>%
  pivot_longer(!1:3, names_to = "yearm")

MUM01 <- MUM01 %>%
  filter(Statistic == "Seasonally Adjusted Monthly Unemployment Rate")%>%
  filter(Sex == "Both sexes") %>%
  filter(Age.Group == "15 - 74 years" | Age.Group == "25 - 74 years")
MUM01<- MUM01 %>%
  separate(yearm, c("Year", "Month"), sep=" ")
MUM01$Year <- as.integer(MUM01$Year)
MUM01$Date <- as.Date(paste(paste(MUM01$Month, sep = " ", "1"),sep = " ",MUM01$Year),"%B %d %Y")

MUM01_Max <- MUM01 %>%
  group_by(Age.Group)%>%
  slice(which.max(Date))
MUM01_Max$lab <- paste(MUM01_Max$Month, ":", MUM01_Max$value)

MUM01_16 <- MUM01 %>%
  filter(Year >= "2016")
MUM01_21 <- MUM01 %>%
  filter(Year >= "2021")
MUM01_YTD <- MUM01 %>%
  filter(Year >= "2022")

Fig.Unemp.1 <- ggplot(data=MUM01, aes(x=Date, y=value, group = Age.Group, colour=Age.Group))+
  geom_line(linejoin="mitre", linetype = 1,alpha = 0.5)+
  scale_colour_manual(values=c("navy","red"))+
  theme_bw()+
  labs(subtitle = "January 1998 to date",
       y=NULL,
       x=NULL)+  theme(legend.position = "none")

Fig.Unemp.2 <- ggplot(data=MUM01_16, aes(x=Date, y=value, group = Age.Group, colour=Age.Group))+
  geom_line(linejoin="mitre",size = 1.25, linetype = 1,alpha = 0.5)+
  scale_colour_manual(values=c("navy","red"))+
  geom_text_repel(aes(label=value),data = MUM01_16, size = 2.75,colour="black",max.overlaps = 4,alpha=0.5)+
  geom_text(aes(label=lab,colour=Age.Group),data = MUM01_Max, size = 3.25,hjust=1,vjust=2, fontface = "bold")+
  theme_bw()+
  labs(title = "Unemployment" ,
       subtitle = "2016 to date",
       y="Unemployment Rate",
       x="Month")+
  theme(legend.position = "bottom")

Fig.Unemp.3 <- ggplot(data=MUM01_21, aes(x=Date, y=value, group = Age.Group, colour=Age.Group))+
  geom_line(linejoin="mitre", linetype = 1,alpha = 0.5)+
  scale_colour_manual(values=c("navy","red"))+
  theme_bw()+
  labs(subtitle = "January 2021 to date",
       y=NULL,
       x=NULL)+  theme(legend.position = "none")

Fig.Unemp.4 <- ggplot(data=MUM01_YTD, aes(x=Date, y=value, group = Age.Group, colour=Age.Group))+
  geom_line(linejoin="mitre", linetype = 1,alpha = 0.5)+
  scale_colour_manual(values=c("navy","red"))+
  theme_bw()+
  labs(subtitle = "Year to date",
       y=NULL,
       x=NULL)+  theme(legend.position = "none")

Fig.Unemp.RightFacet<- Fig.Unemp.1 + Fig.Unemp.3 + Fig.Unemp.4 + plot_layout(nrow=3)

Fig.Unemp.2 + Fig.Unemp.RightFacet+ plot_layout(ncol=2,widths = c(2,1))
Headline unemployment stable at 4.4% nearing historic lows

Headline unemployment stable at 4.4% nearing historic lows 

LRM13 <- cso_get_data("LRM13")

LRM13 <- LRM13 %>%
  pivot_longer(!1:4, names_to = "yearm")

LRM13<- LRM13 %>%
  separate(yearm, c("Year", "Month"), sep=" ")
LRM13$Year <- as.integer(LRM13$Year)
LRM13$Date <- as.Date(paste(paste(LRM13$Month, sep = " ", "1"),sep = " ",LRM13$Year),"%B %d %Y")

# LRM13.1 <- LRM13 %>%
#   filter(Last.Held.Occupation == "All broad occupational groups")%>%
#   filter(Sex == "Both sexes") %>%
#   filter(Age.Group == "All ages")

LRM13.2 <- LRM13 %>%
  filter(Last.Held.Occupation != "All broad occupational groups")%>%
  filter(Sex == "Both sexes") %>%
  filter(Age.Group == "All ages")

LRM13.2_Max <- LRM13.2 %>%
  group_by(Last.Held.Occupation)%>%
  slice(which.max(Date))
LRM13.2_Max$lab = paste(LRM13.2_Max$Month, ":", LRM13.2_Max$value)

LRM13.2_16 <- LRM13.2 %>%
  filter(Date>="2016-01-01")

options(scipen = 999)
LRM13.2_16 %>%
  ggplot(aes(x=Date,y=value,group=Last.Held.Occupation,colour=Last.Held.Occupation))+
  geom_line()+
  geom_text_repel(aes(label=value),max.overlaps=6,colour="black",alpha=0.6,size=2.5)+
  theme_bw()+
  theme(legend.position = "none")+
  ggtitle("Persons on the Live Register")+
  labs(subtitle="LRM13: By Last Held Occupation")+
  ylab("number")+
  geom_text_repel(data=LRM13.2_Max,aes(y=50000,label=lab),alpha=0.4)+
  facet_wrap(~Last.Held.Occupation,ncol=2)

Commencements vs Completions

Following on from last week the trend line for completions versus commencement notices for the GDA.

# Load & clean completions 
NDQ05 <- cso_get_data("NDQ05")
NDQ05 <- NDQ05 %>%
  pivot_longer(!1:2,names_to = "year_qtr")
NDQ05$Year_Q <- as.yearqtr(NDQ05$year_qtr)
NDQ05$Year <- year(NDQ05$Year_Q)

NDQ05 <- NDQ05 %>%
  filter(Local.Authority!="Ireland")
levels(NDQ05$Local.Authority)[match("Dún Laoghaire Rathdown County Council",levels(NDQ05$Local.Authority))] <- "Dún Laoghaire Rathdown County Council"
#NDQ05$Local.Authority[NDQ05$Local.Authority=="Dún Laoghaire Rathdown County Council"] <- "Dún Laoghaire Rathdown County Council"

# Load & clean commencements
HSM13 <- cso_get_data("HSM13")
HSM13 <- HSM13 %>%
  pivot_longer(!1:3,names_to = "year_month")
HSM13$Year <-substr(HSM13$year_month,1,4)
HSM13$Month <- sub(".* ", "", HSM13$year_month)
HSM13$Month_NR <- as.integer(factor(HSM13$Month, levels=month.name))
HSM13$Date <- as.yearmon(paste(HSM13$Year, HSM13$Month_NR), "%Y %m")
HSM13$Year_Q <- as.yearqtr(HSM13$Date)

HSM13.A <- HSM13 %>%
  filter(Residential.Units.Commenced=="Number of residential units")
HSM13.A.Q <- HSM13.A %>%
  group_by(STATISTIC,Local.Authority,Residential.Units.Commenced,Year_Q,Year) %>%
  summarise(value=sum(value,na.rm=TRUE))

# Load unifying format for LA fields and shapefile
GEO <- readxl::read_xlsx(path="C:\\Users\\charten\\OneDrive - Glenveagh Properties\\Research & Development\\1. Analysis\\GEO.UNIFY_NDQ.HSM.xlsx")
shp <- sf::read_sf("/Users/charten/OneDrive - Glenveagh Properties/Research & Development/1. Analysis/Administrative_Areas___OSi_National_Statutory_Boundaries.shp")

# Generate DF & Ratios
## Strip NDQ05 back to unique & unifying fields
NDQ05 <- merge(NDQ05,GEO,by.x="Local.Authority",by.y="Local.Authority.NDQ")
NDQ05 <- NDQ05 %>%
  filter(Year_Q >= "2014 Q1")

Data.NDQ <- NDQ05 %>%
  select(1,4:8)
Data.NDQ <- Data.NDQ %>%
  rename(completions=value)

Data.NDQ <- Data.NDQ %>%
  rename(L.A=Local.Authority) %>%
  rename(Local.Authority=Local.Authority.y)

## Strip NDQ05 back to unique & unifying fields
Data.HSM <- HSM13.A.Q %>%
  ungroup() %>%
  select(2,4,6) 
Data.HSM <- Data.HSM %>%
  rename(commencements=value)

## Merge
Data <- merge(Data.NDQ,Data.HSM,by=c("Local.Authority","Year_Q"))

### Total
Data.Tot <- Data %>%
  group_by(Local.Authority,ENGLISH) %>%
  summarise(completions=sum(completions,na.rm = TRUE),
            commencements=sum(commencements,na.rm = TRUE))

Data.Tot$CtoC <-round(Data.Tot$completions/Data.Tot$commencements,digits=2)

### Year
Data.Yr <- Data %>%
  group_by(Local.Authority,ENGLISH,Year) %>%
  summarise(completions=sum(completions,na.rm = TRUE),
            commencements=sum(commencements,na.rm = TRUE))

Data.Yr$CtoC <- round(Data.Yr$completions/Data.Yr$commencements,digits=2)

# Plot
Data.Yr %>%
  filter(grepl('LOUTH|MEATH|KILDARE|FINGAL|DUBLIN|RATHDOWN|WICKLOW', ENGLISH))%>%
  filter(ENGLISH != "WESTMEATH COUNTY COUNCIL") %>%
  filter(Year >= "2016")%>%
  ggplot(aes(x=Year,y=CtoC,group=ENGLISH,colour=ENGLISH))+
  geom_line(size=1.25,alpha=0.4)+
  geom_hline(yintercept = 1,linetype="dashed",size=0.7,alpha=0.7)+
  theme_bw()+
  theme(legend.position = "none")+
  ggtitle("Completions to Commencements Ratio - GDA")+
  ylab("ratio")+
  xlab(NULL)+
  facet_wrap(~ENGLISH,ncol=4)
Completions to Commencement Ratio - value above 1 show periods where there were more reaching completion than commencement notices issued

Completions to Commencement Ratio - value above 1 show periods where there were more reaching completion than commencement notices issued 

## 12 month moving average
Data$completions.sma12 <- round(SMA(Data$completions,n=4),digits=2)
Data$commencements.sma12 <- round(SMA(Data$commencements,n=4),digits=2)

Data %>%
  filter(grepl('LOUTH|MEATH|KILDARE|FINGAL|DUBLIN|RATHDOWN|WICKLOW', ENGLISH))%>%
  filter(ENGLISH != "WESTMEATH COUNTY COUNCIL") %>%
  ggplot(aes(x=Year_Q,group=L.A))+
  geom_line(aes(y=commencements.sma12),alpha=0.3,size=1.25,colour="#B54104")+
  geom_line(aes(y=completions.sma12),alpha=0.4,size=1.25,colour="#2CB504")+
  theme_bw()+theme(plot.title = element_text(face="bold"))+
  theme(legend.position = "bottom")+
  ggtitle("Commencement Notices vs Completions")+
  labs(subtitle="12 month moving average",caption="source: HSM13 | NDQ05")+
  ylab("number of units")+
  xlab("quarter")+facet_wrap(~Local.Authority,ncol=4)
Completions (Green Line) vs Commencements (Brown Line)

Completions (Green Line) vs Commencements (Brown Line)

Oil

# Load
## Oil
#BRENT <- getSymbols("BZ=F",src='yahoo',auto.assign=FALSE)
WTI <- getSymbols("CL=F",src='yahoo',auto.assign=FALSE)

#BRENT_AVG <- mean(BRENT$`BZ=F.Close`,na.rm=TRUE)
#BRENT_TAIL <- tail(BRENT,1)
#BRENT_CLOSE <- mean(BRENT_TAIL$`BZ=F.Close`,na.rm=TRUE)
WTI_AVG <- mean(WTI$`CL=F.Close`,na.rm=TRUE)
WTI_TAIL <- tail(WTI,1)
WTI_CLOSE <- mean(WTI_TAIL$`CL=F.Close`,na.rm=TRUE)

#BRENT.YTD <- BRENT %>%
 # subset(date(index(.))>= "2022-01-01")
WTI.YTD <- WTI %>%
  subset(date(index(.))>= "2022-01-01")

#BRENT.YTD_AVG <- mean(BRENT.YTD$`BZ=F.Close`,na.rm=TRUE)
#BRENT.YTD_TAIL <- tail(BRENT.YTD,1)
#BRENT.YTD_CLOSE <- mean(BRENT.YTD_TAIL$`BZ=F.Close`,na.rm=TRUE)
WTI.YTD_AVG <- mean(WTI.YTD$`CL=F.Close`,na.rm=TRUE)
WTI.YTD_TAIL <- tail(WTI.YTD,1)
WTI.YTD_CLOSE <- mean(WTI.YTD_TAIL$`CL=F.Close`,na.rm=TRUE)

# Run the past and present periods for a naive correlation
WTI.Past <- WTI %>%
  subset(date(index(.))>= "2007-01-01") %>%
  subset(date(index(.))<= "2008-12-31")
WTI.Pres <- WTI %>%
  subset(date(index(.))>= "2021-01-01")

WTI.Past <- data.frame(date=index(WTI.Past), coredata(WTI.Past))
WTI.Past$Period <- "Jan 07 to Dec 08"
WTI.Pres <- data.frame(date=index(WTI.Pres), coredata(WTI.Pres))
WTI.Pres$Period <- "Jan 21 to Date"

WTI.Past$day <- yday(WTI.Past$date)
WTI.Past$year <- format(WTI.Past$date,"%Y")
WTI.Past$a <- ifelse(WTI.Past$year == "2007",0,365)
WTI.Past$t <- WTI.Past$day+WTI.Past$a

WTI.Pres$day <- yday(WTI.Pres$date)
WTI.Pres$year <- format(WTI.Pres$date,"%Y")
WTI.Pres$a <- ifelse(WTI.Pres$year == "2021",0,365)
WTI.Pres$t <- WTI.Pres$day+WTI.Pres$a

WTI.Past_Pres <- rbind(WTI.Past,WTI.Pres)

arrows <- tibble(
  x1 = c(500,638),
  x2 = c(45,40)
  )

WTI.Past_Pres %>%
  ggplot(aes(x=t,y=CL.F.Close,group=Period))+
  geom_line(aes(colour=Period),size=1.25,alpha=0.7)+
  scale_colour_manual(values=c("#FF3B47","black"))+
  theme_bw()+
  theme(legend.position = "bottom")+
  ylab("USD per barrell")+xlab("t = days")+
  ggtitle("West Texas Intermediary (WTI)")+
  geom_vline(xintercept=641,size=0.25,alpha=0.9,linetype="dashed",colour="navy")+
  geom_vline(xintercept=561,size=0.25,alpha=0.9,linetype="dashed")+
  annotate("text", x = 550, y = 45, label = "OPEC Plus supply cut hits market",size=3,colour="navy")+
  annotate("text", x = 475, y = 60, label = "Biden visit to Saudi Arabia",size=3)
Update to graph produced last month, the aim was to show why OPEC may be cutting supply. Recall it can be naive to read too much into these correlations particularly in nominal terms, but I feel it is still informative

Update to graph produced last month, the aim was to show why OPEC may be cutting supply. Recall it can be naive to read too much into these correlations particularly in nominal terms, but I feel it is still informative