# Experimenting with expanding axes

LET US EXPERIMENT A BIT WITH AXES. In this post I’m going to try out some data visualization ideas expanding on our earlier work with ticks marks (see post ticks out).

We’re going to make the following plot and some variations with R. As before, we’ll use data we used in our mortgage rate post to explore weekly average mortgage rates in the United States based on Freddie Mac’s Primary Mortgage Market Survey.

# The idea

The idea here is to have a minimal axis that expand with the data. This gives us a sense of how the data evolve relative to the minimum and maximum data.

Let’s start by making a static plot. Our data are stored in an excel spreadsheet called rates.xlsx with the data we want stored in the worksheet labeled rates.

########################
########################

library(data.table)
library(scales)
library(ggthemes)
library(tidyverse)
library(extrafont)

########################
########################

#for mor on these data see http://lenkiefer.com/2016/12/08/10-ways-to-visualize-rates

dt$date<-as.Date(dt$date, format="%m/%d/%Y")
dt<-data.table(dt)
dt$year<-year(dt$date) # create year variable

Next let’s draw a static graph:

#####################
#### Setup axes #####
#####################

# x axis limits
xlim<-as.numeric(c(min(dt$date),max(dt$date)))

# x axis breaks
xb<-xlim

# x axis labels
xlab<-c(min(dt$date),max(dt$date))

# Compute max and min rate
ylim<-c(min(dt$rate30),max(dt$rate30))

# Compute max and min rate, last rate
yb<-c(min(dt$rate30),tail(dt,1)$rate30,max(dt$rate30)) ##################### #### Make Graph #### ##################### ggplot(data=dt, aes(x=as.numeric(date),y=rate30,label=rate30))+ geom_line()+theme_bw()+ labs(x="", y="", title="30-year Fixed Mortgage Rate (%)", subtitle="weekly average rates", caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey")+ # modify theme theme(plot.title=element_text(size=18), plot.caption=element_text(hjust=0), panel.border = element_blank(), panel.grid.major = element_blank(), text=element_text(family="Palatino Linotype"), panel.grid.minor = element_blank(), axis.ticks.length=unit(0.25,"cm") ) + # add point at end geom_point(data=tail(dt,1),color="red",size=3,alpha=0.82)+ # create axes with line segments # y axis geom_segment(aes(x=-Inf,xend=-Inf,y=max(dt$rate30),yend=min(dt$rate30)))+ scale_y_continuous(limits=ylim, breaks=yb,position = "left" )+ # x axis scale_x_continuous(limits=xlim,breaks=xb,labels=xlab)+ geom_segment(aes(x=as.numeric(min(dt$date)), xend=as.numeric(max(dt$date)), y=-Inf,yend=-Inf),inherit.aes=FALSE) # Make an animation Let’s have some fun and make an animated version. For smooth animations we’ll use tweenr. See my earlier post about tweenr for an introduction to tweenr, and more examples here and here. We’ll have the axes expand as the data evolve. library(tweenr) library(animation) #subset to 2016 and later dt2<-dt[year(date)>2015] #create function for plotting: myfg<-function(dd){ g<- ggplot(data=dt2[date<=dd,], aes(x=as.numeric(date),y=rate30,label=rate30))+ geom_line()+theme_bw()+ labs(x="", y="", title="30-year Fixed Mortgage Rate (%)", subtitle="weekly average rates", caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey")+ theme(plot.title=element_text(size=18), plot.caption=element_text(hjust=0), panel.border = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), text=element_text(family="Palatino Linotype"), axis.ticks.length=unit(0.25,"cm"), # Ticks out! # padding for ticks axis.text.y = element_text(margin=unit(c(0.5,0.5,0.5,0.5), "cm")), axis.text.x = element_text(margin=unit(c(0.5,0.5,0.5,0.5), "cm")) ) return(g) } # list of dates dlist<-unique(dt2$date)
N<-length(dlist) #number of dates
oopt = ani.options(interval = 0.2)
saveGIF({for (i in 1:N) {
dd<-dlist[i]
# Set up limits and labels
xlim<-c(as.numeric(min(dt2$date)),as.numeric(dd)) xlim2<-c(as.numeric(min(dt2$date)),as.numeric(max(dt2$date))) xlab<-c(min(dt2$date),dd)
ylim2<-c(min(dt2$rate30),max(dt2$rate30))
dt3<-dt2[date<=dd]
ylim<-c(min(dt3$rate30),max(dt3$rate30))

g<-
myfg(dd) +
geom_segment(aes(x=-Inf,xend=-Inf,y=max(dt3$rate30),yend=min(dt3$rate30)))+
scale_y_continuous(limits=ylim2,breaks=c(ylim,dt2[date==dd]$rate30))+ geom_segment(data=d, aes(x=as.numeric(min(dt2$date)),
y=-Inf, xend=as.numeric(dd),
yend=-Inf),inherit.aes=FALSE)+
scale_x_continuous(limits=xlim2,breaks=xlim,labels=xlab)+
geom_point(color="red",size=3,alpha=0.82,
aes(x=as.numeric(dd),y=dt2[date==dd]$rate30))+ geom_rug(data=dt2[date==dd],sides="l",color="red", aes(y=rate30),size=1.1) print(g) print(paste(i,"out of",N)) ani.pause() } for (i2 in 1:10) { print(g) ani.pause() } },movie.name="rate_02_11_base_extend2_2017.gif",ani.width = 650, ani.height = 400) Running this code will create this animation: # An alternative Let’s try a modification. We’ll move the axis over to the right using postion="right" in the ggplot call. For smooth animations we’ll use tweenr. See my earlier post about tweenr for an introduction to tweenr, and more examples here and here. #subset data to be later than 2010: dt2<-dt[year(date)>2010] # Create a function to make axis myp<-function (in.dt, # Can set the limits, # or let data determine it by leaving xlim, ylim missing xlim, ylim){ in.dt<-data.table(in.dt) if (missing(xlim)) { # x axis limits xlim<-as.numeric(c(min(in.dt$date,na.rm=T),max(in.dt$date,na.rm=T))) } # x axis breaks xb<-as.numeric(c(min(in.dt$date,na.rm=T),max(in.dt$date,na.rm=T))) # x axis labels xlab<-c(min(in.dt$date,na.rm=T),max(in.dt$date,na.rm=T)) if (missing(ylim)) { # Compute max and min rate ylim<-c(min(in.dt$rate30,na.rm=T),max(in.dt$rate30,na.rm=T)) } # Compute max and min rate, last rate yb<-c(min(in.dt$rate30,na.rm=T),tail(in.dt,1)$rate30,max(in.dt$rate30,na.rm=T))

#####################
####  Make Graph ####
#####################
g<-
ggplot(data=in.dt, aes(x=as.numeric(date),y=rate30,label=rate30))+
geom_line()+theme_bw()+
labs(x="", y="",
title="30-year Fixed Mortgage Rate (%)",
subtitle="weekly average rates",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey")+
theme(plot.title=element_text(size=18),
plot.caption=element_text(hjust=0),
panel.border = element_blank(),
panel.grid.major = element_blank(),
text=element_text(family="Palatino Linotype"),
panel.grid.minor = element_blank(),
axis.ticks.length=unit(0.25,"cm")) +
geom_point(data=tail(in.dt[rate30>0,],1),color="red",size=3,alpha=0.82)+
geom_segment(aes(x=Inf,xend=Inf,y=max(yb),yend=min(yb)))+
scale_y_continuous(limits=ylim,breaks=yb,
position = "right",labels=round(yb,2) )+
scale_x_continuous(limits=xlim,breaks=xb,labels=xlab)+
geom_segment(aes(x=min(xb), xend=max(xb),
y=-Inf,yend=-Inf),inherit.aes=FALSE)
return(g)
}

#  Function for use with tweenr
myf<-function (dd){
d.out<-copy(dt2)
d.max<-max(d.out[date<=dd]$date,na.rm=T) r.max<-d.out[date==d.max]$rate30
d.out[date>dd,rate30:=r.max]  # if date beyond dd set to r.max
d.out[date>dd,date:=d.max]    # if date beyond dd set to d.max
d.out %>% map_if(is.character, as.factor) %>% as.data.frame -> d.out
return(d.out)
}

# Set limits for  axis
xlim<-c(as.numeric(min(dt2$date)),as.numeric(max(dt2$date)))
ylim<-c(as.numeric(min(dt2$rate30)),as.numeric(max(dt2$rate30)))

# Compute the first date by year with: dt2[,min(date),by=year]$V1 my.list2<-lapply(c(min(dt2$date),dt2[,min(date),by=year]$V1,max(dt2$date) ),myf)

#use tweenr to interploate
tf <- tween_states(my.list2,tweenlength= 3,
statelength=1, ease=rep('cubic-in-out',2),nframes=60)
tf<-data.table(unique(tf)) #convert output into data table

#Animate plot
oopt = ani.options(interval = 0.1)
saveGIF({for (i in 1:max(tf\$.frame)) { #loop over frames
g<-
myp(tf[.frame==i],xlim=xlim,ylim=ylim)
print(g)
ani.pause()
print(i)}
},movie.name="tween pmms base v2 feb 11 2017.gif",ani.width = 500, ani.height = 400)

Running this will generate: