3D annimation about Measles in USA

By Datapleth.io | October 17, 2019

In a previous post, we published some data vizualisations (heat map and maps) inspired by an article of The Wall Street Journal about the impact of measles vaccine in the USA. We are now going to present an alternative visualization based on 3D plots.

Such plots are not always the best for data vizualisation but they are still interesting, especially when they are annimated.

We will use rayshader to generate the 3D plots associated with rayshading option to improve rendering.

Preparation

We reuse the data set prepared in previous post. It’s a dataset containing the incidence of measles in mainland USA from 1900 to 2000. We also load the necessary libraries, especially the rayshader package.

library(knitr)
library(kableExtra) # for table rendering
library(glue)
library(curl)
library(slippymath)
library(purrr)
library(png)
library(dplyr)
library(ggplot2)
library(plotly)
library(ggthemes)
library(data.table)
library(xml2)
library(rvest)
library(maps)
library(rayshader)

load("./data/measles_usa_mainland.Rda")
dt <- measles_usa_mainland


mypal <- c("#e7f0fa", #lighter than light blue
           "#c9e2f6", #light blue
           "#95cbee", #blue
           "#0099dc", #darker blue
           "#4ab04a", #green
           "#ffd73e", #yellow
           "#eec73a", #mustard
           "#e29421", #dark khaki (?)
           "#f05336", #orange red
           "#ce472e") #red

To create the incidence map, we reuse the functions developped previously with some minor adaptations. This function creates a ggplot2 map of the USA.

plotMeasleMap <- function(year_filter = 1950){
    
    # load United States state map data
    usa_states <- map_data("state")
    usa_states$region <- toupper(usa_states$region)
    
    
    merged_states <- merge(
        x = usa_states
        , y = dt[ year == year_filter & !(state %in% c("HAWAII", "ALASKA"))]
        , by.x = "region"
        , by.y = "state_name"
        , all.x = TRUE
        , all.y = TRUE
    )
    
    p <- ggplot()
    p <- p + geom_polygon(
        data = merged_states
        , aes(x = long, y = lat, group = group, fill = incidence)
        , color="white"
        , size = 0.2
    ) +
        theme_tufte() + coord_map() +
        scale_fill_gradientn(
            colours = mypal
            , values=c(0, 0.01, 0.02, 0.03, 0.09, 0.1, .15, .25, .4, .5, 1)
            , limits=c(0, 4000)
            , na.value=rgb(246, 246, 246, max=255)
            , labels=c("0k", "1k", "2k", "3k", "4k")
            , guide = guide_colourbar(
                ticks=T
                , nbin=50
                , barheight=.3
                , label=T
                , title.position = "bottom"
                , title.hjust = 0.5
                #, barwidth= 0.2
            )
        ) +
        ggtitle(year_filter) +
        theme(
            axis.title = element_blank()
            , axis.text = element_blank()
            , axis.ticks = element_blank()
            , legend.position = 'top'
            , plot.title = element_text(vjust = -10)
        )
    p
}

3D map

Then we can generate a 3D plot usine rayshader package. It’s pretty easy to use, a 3D plot is generated from the ggplot object. We just have to set-up initial zomm factor, rotation angles and windows size.

We obtain and interactive plot, and rgl object which can be saved as a widget. One can zoom or rotate the plot. In this example we focus on the year 1957.

rayshader::plot_gg(
    plotMeasleMap(1957)
    , zoom = 0.42
    , theta = 20
    , phi = 40
    , windowsize = c(200,160)
    , multicore = TRUE
)
s <- rgl::scene3d()
rgl::rgl.close()
rgl::rglwidget(s)