Interactive maps and tables in R

Code and tutorial prepared for the Toronto Data Workshop session on July 30, 2020. You can download the corresponding slide deck for this workshop here.

Since launching the Policing the Pandemic Mapping Project with Alexander McClelland, a lot of people have asked us how we built the interactive map and database. Well, here's how! For sake of this tutorial, I will assume you have RStudio installed on your computer. From there, simply install the five libraries (readr, leaflet, DT, dplyr, htmlwidgets) we'll be using, copy and paste the code below into your console, and the interactive map and table should render in your viewer. Good luck!

Step one:

Load in the necessary packages and data file

First load in necessary R libraries. We'll use readr to load in the .csv file. To build the map we'll use leafet. And to build the interactive table we'll use DT (plus dplyr for the arrange() function). You can download the data set I am using from my GitHub.

##---------------------------------
# Load in libraries
##---------------------------------

#load in necessary packages
library(readr) #to read in .csv file
library(leaflet) #to build interactive map
library(DT) #to build searchable table
library(dplyr) #to arrange dates in table (arrange())
library(htmlwidgets) #to convert map and table into HTML Widget objects and for JS() function

##---------------------------------
# Read in data 
##---------------------------------

ptp <- read_csv("https://raw.githubusercontent.com/alexlusco/Blog-Datasets/master/ppmp_data.csv")

Step two:

Build the interactive map

##---------------------------------
# BUILD INTERACTIVE MAP
##---------------------------------

#make new vector to manipulate for map
ptpmap <- ptp

#make URLs clickable links, titled by event description
ptpmap$event_url <- paste0("<b><a href='", ptpmap$event_url) %>%
  paste0("'>") %>%
  paste0(ptp$event_desc) %>%
  paste0("</a></b>")

#add headers to other data points
ptpmap$report_date <- paste0("<strong>Date: </strong>", ptpmap$report_month)
ptpmap$place <- paste0("<strong>Place: </strong>", ptpmap$place)
ptpmap$violation <- paste0("<strong>Violation: </strong>", ptpmap$violation)
ptpmap$acting_agency <- paste0("<strong>Acting agency: </strong>", ptpmap$acting_agency)
ptpmap$legislation <- paste0("<strong>Legislation: </strong>", ptpmap$legislation)
ptpmap$number_of_people <- paste0("<strong>Number of people: </strong>", ptpmap$number_of_people)

#jitter lat / long to prevent with point overlap
ptpmap$lat <- jitter(as.numeric(ptpmap$lat), factor = 0.01)
ptpmap$long <- jitter(as.numeric(ptpmap$long), factor = 0.01)

#subset
crim <- subset(ptpmap, offence_type == "criminal law offence")
emerg <- subset(ptpmap, offence_type == "emergency law offence")
health <- subset(ptpmap, offence_type == "public health law offence")
bylaw <- subset(ptpmap, offence_type == "municipal by-law offence")
mixed <- subset(ptpmap, offence_type == "mixed offence")

#set content of addmarker
crimcontent <- paste(sep = "<br/>",
                     crim$event_url,
                     crim$report_date,
                     crim$number_of_people,
                     crim$acting_agency,
                     crim$place,
                     crim$legislation)

emergcontent <- paste(sep = "<br/>",
                      emerg$event_url,
                      emerg$report_date,
                      emerg$number_of_people,
                      emerg$acting_agency,
                      emerg$place,
                      emerg$legislation)

healthcontent <- paste(sep = "<br/>",
                       health$event_url,
                       health$report_date,
                       health$number_of_people,
                       health$acting_agency,
                       health$place,
                       health$legislation)

bylawcontent <- paste(sep = "<br/>",
                      bylaw$event_url,
                      bylaw$report_date,
                      bylaw$number_of_people,
                      bylaw$acting_agency,
                      bylaw$place,
                      bylaw$legislation)

mixedcontent <- paste(sep = "<br/>",
                      mixed$event_url,
                      mixed$report_date,
                      mixed$number_of_people,
                      mixed$acting_agency,
                      mixed$place,
                      mixed$legislation)

#set colours by event type
pal <- colorFactor(
  palette = c("red", "blue", "#228B22", "purple", "#9b870c"),
  levels = c("criminal law offence", "emergency law offence", "public health law offence", "municipal by-law offence", "mixed offence")
)

#create interactive map
ptpmap <- ptpmap %>%
  leaflet() %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  addLayersControl(overlayGroups = c("Criminal law offence", "Emergency law offence",
                                     "Public health law offence",
                                     "Municipal by-law offence", "Mixed offence"),
                   options = layersControlOptions(collapsed = FALSE)) %>%
  addCircleMarkers(lng = crim$long, lat = crim$lat,
                   popup = crimcontent, color = "red",
                   fillOpacity = .75, stroke = T, group = "Criminal law offence",
                   clusterOptions = T) %>%
  addCircleMarkers(lng = emerg$long, lat = emerg$lat,
                   popup = emergcontent, color = "blue",
                   fillOpacity = .75, stroke = T, group = "Emergency law offence",
                   clusterOptions = T) %>%
  addCircleMarkers(lng = health$long, lat = health$lat,
                   popup = healthcontent, color = "#228B22",
                   fillOpacity = .75, stroke = T, group = "Public health law offence",
                   clusterOptions = T) %>%
  addCircleMarkers(lng = bylaw$long, lat = bylaw$lat,
                   popup = bylawcontent, color = "purple",
                   fillOpacity = .75, stroke = T, group = "Municipal by-law offence",
                   clusterOptions = T) %>%
  addCircleMarkers(lng = mixed$long, lat = mixed$lat,
                   popup = mixedcontent, color = "#9b870c",
                   fillOpacity = .75, stroke = T, group = "Mixed offence",
                   clusterOptions = T) %>%
  addLegend("bottomright", pal = (pal), values = ~offence_type,
            title = "LEGISLATION <br/>(cluster colours not reflected by legend)",
            labFormat = labelFormat(prefix = ""),
            opacity = 1
  )

The output should look something like this (without the custom map markers and cluster colouring).

Step three:

Build the interactive table

##---------------------------------
# BUILDING SEARCHABLE DATABASE
##---------------------------------

#make new vector to maniuplate for table
ptpdb <- ptp

#make urls in clickable links, titled by event description
ptp$event_url <- paste0("<b><a href='", ptp$event_url) %>%
  paste0("'>") %>%
  paste0(ptp$event_desc) %>%
  paste0("</a></b>")

#select variables that will go into table
myvars <- names(ptpdb) %in% c("place", "violation", "report_month", 
                            "acting_agency", "legislation", "event_url", 
                            "number_of_people", 
                            "known_demographic", "individual_business") 

#subset data using above variables
ptpdb <- ptpdb[myvars]

#sort by date
ptpdb <- ptpdb %>%
  arrange(report_month)

#make searchable table using library(DT)
ptpdb <- datatable(ptpdb, class = "display", escape = FALSE, options = list(
  initComplete = JS("function(settings, json) {
                    $(this.api().table().body()).css({
                    'background-color': '#F0350F',
                    'outline-color': '#F0350F',
                    'margin':'100px',
                    'color': 'black',
                    'text-align': 'left',
                    'font-family': 'Helvetica Neue',
                    'border-radius': '25px'
                    });
                    $(this.api().table().header()).css({
                    'background-color': '#FFFFFF',
                    'color': '#F0350F',
                    'outline-color': 'red',
                    'margin':'100px',
                    'text-align': 'center',
                    'font-family': 'Times New Roman',
                    'border-radius': '25px'
                    });
                    }
                    "),
  pageLength = 50
  ),
  caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: center; color:black;
    font-size:200% ;',''),
  filter=list(position = 'top')
  ) %>%
  formatStyle(
    'number_of_people',
    background = gsub(
      "value", "Math.abs(value)", styleColorBar(abs(ptpdb$number_of_people), '#F0350F'),
      fixed = TRUE),
    backgroundSize = '100% 80%',
    backgroundRepeat = 'no-repeat',
    backgroundPosition = 'center'
  )

The output should look like this.

Step four:

Save your map and table as HTML Widget objects, ready to be shared

##---------------------------------
# SAVE MAP AND DATABASE as HTML Widget objects
##---------------------------------

#export Widget object as HTML file, naming the file "index.html".

#UNCOMMENT TO RUN
#saveWidget(widget=ptpmap, file="<folderpath/index.html>", selfcontained = FALSE)
#saveWidget(widget=ptpdb, file="<folderpath/index.html>", selfcontained = FALSE)
Alex Luscombe
Alex Luscombe
PhD Candidate in Criminology

Related