LET’S PIXELATE AMERICA. This morning I happened across a fun blog post on how to generate Pixel maps with R via R weekly.

The basic code is so easy, all you need is ggplot2 (which I get from the tidyverse).

library(tidyverse)
## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr
## Conflicts with tidy packages ----------------------------------------------
## filter(): dplyr, stats
## lag():    dplyr, stats
ggplot(map_data("state"), aes(round(long, 0),round(lat,0), 
                              group=group, fill = as.factor(group))) +
  geom_polygon() +
  guides(fill=FALSE) +
  coord_map() +
  theme_void()
## 
## Attaching package: 'maps'
## The following object is masked from 'package:purrr':
## 
##     map

We can modify our dark theme and generate a dark background. Then we’ll animate it to get:

pmms after dark

Using this code:

library(ggthemes)
library(animation)
library(tweenr)
library(extrafont)
library(gridExtra)
library(tidyr)  # for map function

 #  Function for use with tweenr
  myf<-function (d=6){
    d.out<-map.df
    d.out$lat<-round(d.out$lat,d) # round lat and lon
    d.out$long<-round(d.out$long,d)
    d.out %>% map_if(is.character, as.factor) %>% as.data.frame -> d.out
    return(d.out)
  }

 #pick some points to interpolate
  my.list2<-lapply(c(8,0,8),myf)  
  #use tweenr to interploate
  tf <- tween_states(my.list2,tweenlength= 1,
                     statelength=3, ease=rep('cubic-in-out',2),nframes=70)
  tf<-data.table(tf) #convert output into data table
  

N<-max(tf$.frame)  
oopt = ani.options(interval = 0.05)
saveGIF({for (i in 1:max(tf$.frame)) {
  g<-
    ggplot(filter(tf,.frame==i), 
           aes(long,lat, group=group, fill = as.factor(group))) +
    geom_polygon() +
    guides(fill=FALSE) +
    coord_map() + theme_void(base_family = "Courier New")+
    labs(title="Let's Pixelate America",
         caption="@lenkiefer \nbased on code from:         http://colinfay.me/rstats-create-a-pixel-map-with-r/",
        subtitle="Pixel Map" )+
    # Dark styling:
    theme(panel.background = element_rect(fill = " gray10", color  =  NA),  
          plot.background = element_rect(color = " gray10", fill = " gray10"),  
          plot.title = element_text(size = base_size*1.5,face="bold", 
                                    color = "white",hjust=0,lineheight=1.25,
                                    margin=margin(2,2,2,2)),  
            plot.subtitle = element_text(size = base_size*1, 
                                         color = "white",hjust=0, 
                                         margin=margin(2,2,2,2)),  
            plot.caption = element_text(size = base_size*0.75, 
                                        color = "white",hjust=0),  
            plot.margin = unit(rep(1, 4), "lines"))+
      # Keep zoom constant by fixing lat/long
      scale_x_continuous(limits=c(-130,-60))+
      scale_y_continuous(limits=c(20,55))
    print(g)
    print(paste(i,"out of",N))
    ani.pause()
    }
},movie.name="pixel map dark.gif",ani.width = 650, ani.height = 400)

A practical use for this?

This is fun, but is there any practical use? Maybe.

When I construct data visualizations I like to use a “squint test” where I squint my eyes and simulate a lower resolution visualization. If I can still get the main point through squinted eyes, then the visualization passes the test. Let’s try that with some real data.

We’ll plot a state map showing annual house price appreciation as measured by the FHFA purchase-only house price index. These plots are the modified versions of the ones from this post I shared last year.

#load some libraries
library(ggthemes)
library(scales)
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
library(rgeos)
## rgeos version: 0.3-23, (SVN revision 546)
##  GEOS runtime version: 3.5.0-CAPI-1.9.0 r4084 
##  Linking to sp version: 1.2-5 
##  Polygon checking: TRUE
library(maptools)
## Loading required package: sp
## Checking rgeos availability: TRUE
library(albersusa)
library(ggalt)
library(viridis)
## Loading required package: viridisLite
library(data.table) # for data manipulation
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
## The following object is masked from 'package:purrr':
## 
##     transpose
#read in data available as a text file from the FHFA website:
fhfa.data<-fread("http://www.fhfa.gov/DataTools/Downloads/Documents/HPI/HPI_PO_state.txt")
#create annual house price growth in the SA index:
fhfa.data<-fhfa.data[,hpa12:=index_sa/shift(index_sa,4)-1,by=state]
fhfa.data<-fhfa.data[,iso_3166_2:=state]  #rename state to match usa_composite
fhfa.data<-fhfa.data[,date:=as.Date(ISOdate(yr,qtr*3,1))] #make a date (don't need it here)
fhfa.data<-fhfa.data[,mylabel:=paste0("Q",qtr,":",yr)]  #create date label for plot
#do map stuff
states<-usa_composite()
smap<-fortify(states,region="fips_state")
states@data <- left_join(states@data, fhfa.data, by = "iso_3166_2")
states@data$id<-states@data$fips_state
smap2<-left_join(smap,states@data,by="id")

#make plots:

ggplot(filter(smap2,qtr==4 & yr>=2005), 
             aes(long,lat, group=group, fill = hpa12)) +
      geom_polygon()+
      theme_map( base_size = 12) +facet_wrap(~yr,ncol=3)+
  theme(plot.title=element_text( size = 16, margin=margin(b=10))) +
  theme(plot.subtitle=element_text(size = 14, margin=margin(b=-20))) +
  theme(plot.caption=element_text(size = 9, margin=margin(t=-15))) +
  labs(title="",subtitle="" ) +
  scale_fill_viridis(name = "", discrete=F,option="D",end=0.95,
                     direction=-1,limits=c(-0.35,0.35),label=percent)+
  theme(legend.position = "top", 
        plot.caption=element_text(hjust=0,                                                                  vjust=1,margin=margin(t=10)))+
  labs(title=paste0("Four quarter house price percent change (Q4/Q4 %)"),
       caption="@lenkiefer Source: FHFA Purchase-Only House Price Index (SA)")

This map seems to do okay on the squint test. The extreme declines of 2008 and 2009 are clearly seen in the maps. But let’s use the pixelation trick to generate a pixelated version:

ggplot(filter(smap2,qtr==4 & yr>=2005), 
             aes(round(long/3,0)*3,round(lat/3,0)*3, group=group, fill = hpa12)) +
      geom_polygon()+
      theme_map( base_size = 12) +facet_wrap(~yr,ncol=3)+
  theme(plot.title=element_text( size = 16, margin=margin(b=10))) +
  theme(plot.subtitle=element_text(size = 14, margin=margin(b=-20))) +
  theme(plot.caption=element_text(size = 9, margin=margin(t=-15))) +
  labs(title="",subtitle="" ) +
  scale_fill_viridis(name = "", discrete=F,option="D",end=0.95,
                     direction=-1,limits=c(-0.35,0.35),label=percent)+
  theme(legend.position = "top", 
        plot.caption=element_text(hjust=0,                                                                  vjust=1,margin=margin(t=10)))+
  labs(title=paste0("Four quarter house price percent change (Q4/Q4 %)"),
       caption="@lenkiefer Source: FHFA Purchase-Only House Price Index (SA)")

Okay, so even with our simulated squint, the key patterns still seem visible.