27 December 2016

THOUGH 2016 IS NOT OVER YET I want to get a jump on my 2017 resolution: make better tables.

I’ve been re-reading this paper on the Rudiments of Numeracy by A. S. C. Ehrenberg published in the Journal of the Royal Statistical Society in 1977. Though the paper is nearly 40 years old, it still offers some valuable insights.

This little post makes a simple table displaying monthly averages for 30-year fixed mortgage rates. I use the htmlTable package for R to make the table.

Data

The data I’m going to use are estimates of weekly U.S. average 30-year fixed mortgage rates from the Primary Mortgage Market Survey from Freddie Mac. These data can be easily downloaded from the St. Louis Fred database here.

I have the data saved in a simple text file with a column for data, the mortgage rate, and helper columns week, month, and year, where week is the week number starting with the first week of the year.

Code for table

Now we’ll load the data, do some data manipulations and make our table. We’re going to add some additional styling to the table.

# load libraries
library(tidyverse,quietly=T)
library(xtable,quietly=T)
library(data.table,quietly=T)
library(htmlTable,quietly=T)

# load data on weekly mortgage rates:
pmms30yr <- fread("data/pmms30yr.txt")
pmms30yr$date<-as.Date(pmms30yr$date, format="%m/%d/%Y")

# create month name variable "mname"
pmms30yr[,mname:=as.character(date,format="%b")]

#Compute averages by year/month
pm<-pmms30yr[,list(rate=round(mean(rate,na.rm=T),2)),by=c("year","mname")]

# "spread" rates over month in a wide data frame and coerce to data.frame
pms<-data.frame(spread(pm,mname,rate))

# drop year column
pms2 <- pms[,-1]

# use the first column (year) as rownames 
rownames(pms2) <- pms[,1]

# reorder the columns to by month (Jan, Feb, etc) instead of alphabetically (Apr, Aug, etc.)
pms2<-pms2[,unique(pmms30yr[year>1971]$mname)]

# Compute annual averages
pm.a<-pmms30yr[,list(Avg=round(mean(rate,na.rm=T),2)),by=c("year")]

# Add annual averages to data
pm3<-cbind(pms2,pm.a[,2,with=F])
pm3<-format(pm3,digits=3)

# Apply conditiional formatting to 2016 December and Annual averages to reflect fact that
# data is incomplete for those dates

my.format<-function(x){paste0("<span style='color:darkgray; font-style:italic'>",x,"*</span>")}

# overwrite values with styling using <span> and CSS
pm3[46,12:13]<-lapply(pm3[46,12:13],my.format)

#replace 

#create htmlTable

htmlTable(
  caption= # use CSS styling for title
    "<span style='text-align: left; font-size:x-large; font-weight:bold'>30-year Fixed Mortgage Rates in Percentage Points</span>",pm3, 
  # right align numbers
  align="right",
  # apply zebra striping
  col.rgroup = c("none", "#F7F7F7"),
  # group columns by quarter
  cgroup = c("1st Quarter", "2nd Quarter","3rd Quarter","4th Quarter","Annual"),
  n.cgroup = c(3,3,3,3,1),
  # increase spacing for table
  css.cell = "padding-left: .5em; padding-right: .1em;",
  # group data by decade
  tspanner=c("1970s","1980s","1990s","2000s","2010s"),
  n.tspanner=c(9,rep(10,3),7),
  # add a footnote
  tfoot="Source: Primary Mortgage Market Survey, Average of weekly rates\nData through 12/27/2016, <span style='color:darkgray; font-style:italic'>*based on year-to-date values</span>"
          )
30-year Fixed Mortgage Rates in Percentage Points
1st Quarter  2nd Quarter  3rd Quarter  4th Quarter  Annual
Jan Feb Mar   Apr May Jun   Jul Aug Sep   Oct Nov Dec   Avg
1970s
1971 NA NA NA   7.31 7.42 7.53   7.60 7.70 7.69   7.63 7.55 7.48   7.54
1972 7.44 7.32 7.30   7.29 7.37 7.37   7.40 7.40 7.42   7.42 7.43 7.44   7.38
1973 7.44 7.44 7.46   7.54 7.65 7.73   8.05 8.50 8.81   8.77 8.58 8.54   8.04
1974 8.54 8.46 8.41   8.58 8.97 9.09   9.28 9.59 9.96   9.98 9.79 9.62   9.19
1975 9.43 9.11 8.90   8.82 8.91 8.89   8.89 8.94 9.13   9.22 9.14 9.10   9.05
1976 9.02 8.81 8.75   8.73 8.77 8.85   8.93 9.00 8.98   8.93 8.81 8.79   8.87
1977 8.72 8.67 8.69   8.75 8.83 8.86   8.94 8.94 8.90   8.92 8.92 8.96   8.85
1978 9.02 9.14 9.20   9.36 9.57 9.71   9.74 9.79 9.76   9.86 10.11 10.35   9.64
1979 10.39 10.41 10.43   10.50 10.69 11.04   11.09 11.09 11.30   11.64 12.83 12.90   11.20
1980s
1980 12.88 13.04 15.28   16.33 14.26 12.71   12.19 12.56 13.20   13.79 14.21 14.79   13.74
1981 14.90 15.13 15.40   15.58 16.40 16.70   16.83 17.29 18.16   18.45 17.82 16.95   16.64
1982 17.48 17.60 17.16   16.89 16.68 16.70   16.82 16.27 15.43   14.61 13.82 13.62   16.04
1983 13.25 13.04 12.80   12.78 12.63 12.87   13.42 13.81 13.73   13.54 13.44 13.42   13.24
1984 13.37 13.23 13.39   13.65 13.94 14.42   14.67 14.47 14.35   14.13 13.64 13.18   13.88
1985 13.07 12.92 13.17   13.20 12.91 12.21   12.03 12.19 12.19   12.13 11.78 11.26   12.43
1986 10.89 10.71 10.08   9.94 10.14 10.68   10.51 10.20 10.01   9.97 9.70 9.31   10.19
1987 9.20 9.08 9.04   9.83 10.60 10.54   10.28 10.33 10.89   11.26 10.65 10.64   10.21
1988 10.38 9.89 9.93   10.20 10.46 10.46   10.43 10.60 10.48   10.30 10.27 10.61   10.34
1989 10.73 10.64 11.03   11.05 10.77 10.20   9.88 9.98 10.13   9.95 9.77 9.74   10.32
1990s
1990 9.89 10.20 10.27   10.37 10.48 10.16   10.04 10.10 10.18   10.18 10.01 9.67   10.13
1991 9.64 9.37 9.50   9.49 9.47 9.62   9.57 9.24 9.01   8.86 8.71 8.50   9.25
1992 8.43 8.76 8.94   8.85 8.67 8.51   8.13 7.97 7.92   8.09 8.30 8.21   8.39
1993 7.99 7.68 7.50   7.47 7.46 7.42   7.21 7.11 6.92   6.83 7.16 7.17   7.31
1994 7.06 7.15 7.67   8.32 8.60 8.40   8.61 8.51 8.64   8.93 9.17 9.20   8.38
1995 9.15 8.83 8.46   8.32 7.96 7.57   7.61 7.86 7.64   7.47 7.38 7.20   7.93
1996 7.03 7.08 7.62   7.93 8.07 8.32   8.25 8.00 8.23   7.92 7.62 7.60   7.81
1997 7.82 7.65 7.90   8.14 7.94 7.69   7.50 7.48 7.43   7.29 7.21 7.10   7.60
1998 6.99 7.04 7.13   7.14 7.14 7.00   6.95 6.92 6.72   6.71 6.87 6.74   6.94
1999 6.79 6.81 7.04   6.92 7.14 7.55   7.63 7.94 7.82   7.85 7.74 7.91   7.44
2000s
2000 8.21 8.32 8.24   8.15 8.52 8.29   8.15 8.03 7.91   7.80 7.75 7.38   8.05
2001 7.03 7.05 6.95   7.08 7.14 7.16   7.13 6.95 6.82   6.62 6.66 7.06   6.97
2002 7.00 6.89 7.01   6.99 6.81 6.65   6.49 6.29 6.09   6.11 6.07 6.05   6.54
2003 5.92 5.84 5.75   5.81 5.48 5.23   5.63 6.26 6.15   5.95 5.93 5.88   5.83
2004 5.71 5.63 5.45   5.83 6.27 6.29   6.06 5.87 5.75   5.72 5.73 5.75   5.84
2005 5.71 5.63 5.93   5.86 5.72 5.58   5.70 5.82 5.77   6.07 6.33 6.27   5.87
2006 6.14 6.25 6.32   6.51 6.60 6.68   6.76 6.52 6.40   6.36 6.24 6.13   6.41
2007 6.22 6.29 6.16   6.18 6.26 6.66   6.70 6.57 6.38   6.38 6.21 6.09   6.34
2008 5.76 5.92 5.97   5.92 6.04 6.32   6.43 6.48 6.04   6.20 6.09 5.29   6.03
2009 5.05 5.13 5.00   4.81 4.86 5.42   5.22 5.19 5.06   4.95 4.88 4.93   5.04
2010s
2010 5.03 4.99 4.97   5.10 4.89 4.74   4.56 4.43 4.35   4.22 4.30 4.71   4.69
2011 4.75 4.95 4.84   4.84 4.64 4.51   4.54 4.27 4.11   4.07 3.99 3.96   4.45
2012 3.92 3.89 3.95   3.91 3.80 3.67   3.55 3.60 3.50   3.38 3.35 3.34   3.66
2013 3.41 3.53 3.56   3.45 3.54 4.07   4.37 4.46 4.49   4.19 4.25 4.46   3.98
2014 4.43 4.30 4.34   4.34 4.19 4.16   4.13 4.12 4.16   4.04 4.00 3.86   4.17
2015 3.67 3.71 3.77   3.67 3.84 3.98   4.05 3.91 3.89   3.80 3.94 3.96   3.85
2016 3.87 3.66 3.69   3.60 3.60 3.57   3.44 3.44 3.46   3.47 3.77 4.17*   3.64*
Source: Primary Mortgage Market Survey, Average of weekly rates
Data through 12/27/2016, *based on year-to-date values

Data tables are viz too

Data tables are a data visualization too. Artful tables can achieve as much or more than fancy statistical graphs. Check back in this space as I explore more ways to construct tables and deploy them together with other data visualization techniques I’ve been exploring here..