Disclaimer: This project is not affiliated, associated, authorized, endorsed by, or in any way officially connected with DC 311, or any of its subsidiaries or its affiliates. The official DC 311 website can be found here
This project breaks down DC Service Calls (311) in 2022. This is an ongoing project that I will utilize to learn more about R and Data Visualizations. Please follow along or check back from time to time to see the progress.
The data was extracted from the Open Data DC website. There is a treasure trove of data that you can shift through to use for your own project or download the data here if you want to follow along.
311 City Service Requests are made directly on the official DC 311 website where residents can submit a request, check the status explore, maps, find resources for residents, businesses and visitors. The data used in this project is provided by the Office of Unified Communications, which collects detailed information on 311 Service calls. The data dictionary can be found here
This is a great data set that you can use to better your data analysis and visualization skills as it contains 25 attributes that make up the data set. You can explore service order dates tied to request resolution to mapping out where the Service Calls are located using Latitude and Longitude coordinates the analysis that can be done on this data set is endless.
The below visualizations are dynamic so as the data set is updated with new information so will the visualizations.
Lets get started…
Load Libraries
Load packages - you may need to install packages using the install.packages() function. Make sure you put the package name in quotes like install.packages(“tidyverse”), you will only have to do this once.
library(tidyverse)
library(lubridate)
library(readxl)
library(showtext)
library(ggtext)
library(glue)
library(patchwork)
library(highcharter)Load the data
Data set is located at:Dataset
Dataset about page located here:About
I typically use the janitor package whenever I read in a data set. it cleans up the column headings by making them all lower case and placing an underscore between spaces.
service_calls_2022 <- read_csv("https://raw.githubusercontent.com/Barnes7599/DCServiceRequests311/main/DC_service_calls.csv") %>%
janitor::clean_names()Add design elements
I typically will add in design elements upfront so that I know what fonts and colors I will be using in the visualizations. We will use the showtext package to read in goggle fonts.
# Assign color variables
col1 <- "#E1DABF"
col2 <- "#3C6075"
# Adding Google Fonts
font_add_google(family = "patua-one", "Patua One")
font_add_google(family = "montserrat", "Montserrat")
# function used to tell the code below use the above fonts
showtext_auto()Add date variables
At this point I believe that I want to do a heatmap type visualizations so that we can capture the time and day service calls are expected more often. In order to do that we need to use the lubridate package which should help us wrangle the date time groups in the data set.
df_2022 <- service_calls_2022 %>%
# I want to scope down the dataframe so I will only select columns that I am interested in for the heatmap
select(organizationacronym, servicecodedescription, serviceorderdate, serviceduedate, resolutiondate,
# Rename the column serviceorderstatus to status
status = serviceorderstatus
) %>%
# Need to fix an error in the dataset
mutate(
status = case_when(
status == "In Progress" ~ "In-Progress",
TRUE ~ status
),
# Converting to date and time data type
serviceorderdate = ymd_hms(serviceorderdate),
serviceduedate = ymd_hms(serviceduedate),
resolutiondate = ymd_hms(resolutiondate),
# Need to determine the difference in days between the service order data and when the service request was resolved
daystoresolve = as.double(difftime(
resolutiondate,
serviceorderdate
),
units = "days"
),
# Need to determine the difference in days between the service due date and when it was resolved to see later if there is a coorelation between the service request and the time it takes to resolve the service ticket
dayspastdue = as.double(difftime(
resolutiondate,
serviceduedate
),
units = "days"
),
# Capture the abbreviation for each day in the week
dayorderdate = wday(serviceorderdate, label = TRUE, abbr = TRUE),
# Pulling out the hour in the time group
hourorderdate = hour(serviceorderdate)
)Building Heatmaps
Why heatmaps? One because they are fun…and humans have limitations to the amount of information that we can process and pay attention to at the same time. For example, it is challenging for anyone to perform mental math, while at the same time interpreting textual information. However, humans are very efficient at identifying differences in certain types of visual characteristics, such as color, size, shape and orientation. By definition, heatmap visualization or heatmap data visualization is a method of graphically representing numerical data where the value of each data point is indicated using colors.
Our brains process sensory input quickly and automatically, before we are paying conscious attention. This type of processing is called pre-attentive processing.1 For visual processing there are certain attributes that the human visual system processes in this fast-automatic way. These attributes are known as pre-attentive attributes.2 We notice and process these attributes before we concentrate and focus on them. When pre-attentive attributes are used strategically in visualizations, viewers process that information very quickly. Pre-attentive attributes help avoid the mind-numbing work of concentrating and consciously interpreting information, which most people either do not want to do or have no time to do.
Heatmaps are crucial to visualize behavior data so that decision makers can identify the potential problem areas, best practices or visitor interaction
# Creating helper functions so that I can use the glue() package to capture the max and min dates when the data set is updated.
max_date_2022 <- service_calls_2022 %>%
select(serviceorderdate) %>%
separate(col = serviceorderdate, into = c("date", "time"), sep = " ") %>%
select(-time) %>%
mutate(date = ymd(date)) %>%
arrange(desc(date)) %>%
head(1) %>%
mutate(date = as.character(date))
min_date_2022 <- service_calls_2022 %>%
select(serviceorderdate) %>%
separate(col = serviceorderdate, into = c("date", "time"), sep = " ") %>%
select(-time) %>%
mutate(date = ymd(date)) %>%
head(1) %>%
mutate(date = as.character(date))
caption <- glue("Data source: https://opendata.dc.gov/ | Dates: ({min_date_2022} to {max_date_2022})")
heatmap_day_hour_2022 <- df_2022 %>%
select(dayorderdate, hourorderdate) %>%
mutate(dayorderdate = fct_rev(dayorderdate)) %>%
group_by(dayorderdate, hourorderdate) %>%
summarise(N = n(), .groups = "drop") %>%
as_tibble() %>%
ggplot(aes(hourorderdate, dayorderdate, fill = N)) +
geom_tile(color = "white", na.rm = TRUE) +
scale_fill_gradient(low = col1, high = col2) +
guides(fill = guide_legend(title = "Number of Service Calls")) +
labs(
title = "DC Service Calls (311) in 2022 by Day and Hour",
caption = caption,
y = NULL,
x = NULL
) +
theme_classic() +
theme(
text = element_text(
family = "montserrat",
size = 16
),
plot.title = element_markdown(
family = "patua-one",
size = 20,
margin = margin(b = 15)
),
plot.subtitle = element_markdown(margin = margin(b = 10)),
plot.title.position = "plot",
plot.caption.position = "plot",
plot.caption = element_text(
hjust = 0,
margin = margin(t = 15)
),
axis.line.y = element_blank(),
axis.text = element_text(size = 14),
axis.title.x = element_text(margin = margin(t = 10)),
axis.ticks = element_blank(),
# axis.line.x = element_line(),
# axis.line.x.bottom = element_blank(),
legend.position = "bottom",
plot.margin = margin(t = 10, r = 20, b = 10, l = 20)
)
heatmap_day_hour_2022
As you can see the heatmap shows the day of week and the time of day when the service center receives the majority of calls. The blue represents the busiest times for the call center. A manger could use this to help shape their staffing requirements at the call center.
We can also change the colors and make the heatmap interactive with just a few lines of code using the highcharter package. Check it out!
library(highcharter)
h2 <- df_2022 %>%
select(dayorderdate, hourorderdate) %>%
mutate(dayorderdate = fct_rev(dayorderdate)) %>%
group_by(dayorderdate, hourorderdate) %>%
summarise(N = n(), .groups = "drop") %>%
as_tibble()
fntltp <- JS("function(){
return 'Hour: ' + this.point.x + ' ' +
'Day: ' + this.series.yAxis.categories[this.point.y] + ': ' +
Highcharts.numberFormat(this.point.value, 0);
}")
hchart(
h2,
type = "heatmap",
hcaes(
x = hourorderdate,
y = dayorderdate,
value = N
)
) %>%
hc_colorAxis(
stops = color_stops(10, viridisLite::inferno(10, direction = -1))
) %>%
hc_title(
text = "Number of DC Service Calls (311) in 2022 by Day and Hour"
# style = list(fontFamily = "patua-one")
) %>%
hc_subtitle(
text = "Interactivity is cool!",
style = list(fontsize = "20px")
) %>%
hc_tooltip(
formatter = fntltp
) %>%
hc_xAxis(
title = list(text = ""),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_yAxis(
title = list(text = ""),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_legend(
layout = "vertical",
verticalAlign = "middle",
align = "right",
valueDecimals = 0
) %>%
hc_size(height = 400) %>%
hc_chart(
style = list(fontFamily = "montserrat")
) %>%
hc_caption(
text = caption
) %>%
hc_credits(
text = "Chart created using R and highcharter",
href = "http://jkunst.com/highcharter",
enabled = TRUE
) %>%
hc_exporting(
enabled = TRUE,
formAttributes=list(target="_blank"),
filename="heatmap")I think it would be interesting to explore the type of service requested by hour of the day. This could be beneficial for the departments to know when their service is typically being requested throughout the day. I need to create some helper functions so that I can include some dynamic titles.
# Creating helper functions so that I can use the glue() package to capture the the top 3 services requested
topservicereq <- df_2022 %>%
select(servicecode = servicecodedescription) %>%
group_by(servicecode) %>%
summarise(N = n(), .groups = "drop") %>%
top_n(3) %>%
pull(servicecode)
req1 <- topservicereq[[1]]
req2 <- topservicereq[[2]]
req3 <- topservicereq[[3]]
# Creating the heatmap
heatmap_description <- df_2022 %>%
select(servicecode = servicecodedescription) %>%
group_by(servicecode) %>%
summarise(N = n(), .groups = "drop") %>%
# After grouping the service codes and counting the calls for a service we simply show only those service calls
# that occurred greater than 100 times
filter(N > 100) %>%
select(servicecode) %>%
left_join(df_2022 %>%
select(
servicecode = servicecodedescription,
hourorderdate
) %>%
group_by(servicecode, hourorderdate) %>%
summarise(N = n(), .groups = "drop"),
by = "servicecode"
) %>%
mutate(servicecode = as_factor(servicecode) %>% fct_reorder(N)) %>%
ggplot(aes(hourorderdate, servicecode, fill = N)) +
geom_tile(color = "white", na.rm = TRUE) +
scale_fill_gradient(low = col1, high = col2) +
guides(fill = guide_legend(title = "Number of Service Calls")) +
labs(
title = "DC Service Calls (311) 2022 by Service Description",
subtitle = glue("Top 3 services requested: {req1}, {req2}, and {req3}"),
caption = caption,
y = NULL,
x = NULL
) +
theme_classic() +
theme(
text = element_text(
family = "montserrat",
size = 16
),
plot.title = element_text(
family = "patua-one",
size = 20,
margin = margin(b = 5)
),
plot.subtitle = element_text(margin = margin(b = 20)),
plot.title.position = "plot",
plot.caption.position = "plot",
plot.caption = element_text(
hjust = 0,
margin = margin(t = 15)
),
axis.line.y = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)),
axis.text = element_text(size = 14),
axis.ticks = element_blank(),
# axis.line.x = element_line(),
# axis.line.x.bottom = element_blank(),
legend.position = "bottom",
plot.margin = margin(t = 10, r = 20, b = 10, l = 20)
)
heatmap_description
We can also use an interactive bar chart to plot to see what are the most requested services.
subtitle_interactive <- glue("Top 3 services requested: {req1}, {req2}, and {req3}")
df_2022 %>%
count(servicecodedescription, sort = TRUE) %>%
top_n(n = 10) %>%
hchart(
type = "bar",
hcaes(
x = servicecodedescription,
y = n
),
color = col2
) %>%
hc_title(
text = "
<p style='text-align:left;'>
<b>Top 20 Services Requested</b>
<br>
</p>
",
align = "left",
useHTML = TRUE
) %>%
hc_xAxis(
title = list(text = ""),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_subtitle(
text = subtitle_interactive,
align = "left"
) %>%
hc_yAxis(
title = list(text = "Number of Requests"),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_chart(
style = list(fontFamily = "montserrat")
) %>%
hc_caption(
text = caption
) %>%
hc_size(height = 700) %>%
hc_credits(
text = "Chart created using R and highcharter",
href = "http://jkunst.com/highcharter",
enabled = TRUE
)For more information on highcharter: highchart cheatsheet| another cheatsheet| highchartr documentation| highchart for R users
Next, let’s take a look at the status of service requests so far in 2022.
Status of Service Requests
status_bar_capation <- glue("Status of Service Requests as of {max_date_2022}")
df_2022 %>%
count(status, sort = TRUE) %>%
hchart(
type = "bar",
hcaes(
x = status,
y = n
),
color = col2
) %>%
hc_title(
text = "
<p style='text-align:left;'>
<b>Status of Service Tickets</b>
<br>
</p>
",
align = "left",
useHTML = TRUE
) %>%
hc_xAxis(
title = list(text = ""),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_subtitle(
text = status_bar_capation,
align = "left"
) %>%
hc_yAxis(
title = list(text = "Number of Service Tickets"),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_chart(
style = list(fontFamily = "montserrat")
) %>%
hc_caption(
text = caption
) %>%
hc_size(height = 700) %>%
hc_credits(
text = "Chart created using R and highcharter",
href = "http://jkunst.com/highcharter",
enabled = TRUE
)This seems ok, but do we really care about the service calls that have been Canceled, Closed (Transferred) or Open (Duplicates)? I do not believe it gives us any information that we can make possible decisions on. I think making a stacked bar chart of the tickets that are Open or In-Progress may be a neat may to visualizes the information so that when we can measure progress on closing requests. Plus, I think it would be fun if we made the title and subtitle dynamic by including the number of service calls and a breakdown of what percent is Open vs In-Progress.
Open and In-Progress
open_inprogress <- df_2022 %>%
filter(status %in% c("Open", "In-Progress")) %>%
count() %>%
pull()
open <- df_2022 %>%
filter(status %in% c("Open", "In-Progress")) %>%
count(status) %>%
# We need to add a column to show the proportion
mutate(prop = n / sum(n)) %>%
select(status, prop) %>%
filter(status == "Open") %>%
pull() %>%
scales::percent()
in_progress <- df_2022 %>%
filter(status %in% c("Open", "In-Progress")) %>%
count(status) %>%
# We need to add a column to show the proportion
mutate(prop = n / sum(n)) %>%
select(status, prop) %>%
filter(status == "In-Progress") %>%
pull() %>%
scales::percent()
num_service_calls_7_days_ago <- df_2022 %>%
filter(serviceorderdate <= Sys.Date() - 7, status %in% c("Open", "In-Progress")) %>%
count() %>%
pull()
num_service_calls_7_days_ago_df <- df_2022 %>%
filter(serviceorderdate <= Sys.Date() - 7, status %in% c("Open", "In-Progress")) %>%
count()
status_bar_count <- df_2022 %>%
filter(status %in% c("Open", "In-Progress")) %>%
count(status) %>%
# We need to add a column to show the proportion
mutate(prop = n / sum(n)) %>%
mutate(status = status %>% as_factor() %>% fct_reorder(n)) %>%
arrange(desc(n)) %>%
ggplot(aes(
x = 1, y = n,
fill = status
)) +
geom_bar(stat = "identity") +
coord_flip() +
geom_hline(yintercept = 0) +
# geom_hline(yintercept = num_service_calls_7_days_ago) +
scale_fill_manual(
values = c(col1, col2),
breaks = c("Open", "In-Progress")
) +
labs(
title = glue("{open_inprogress} DC Service Calls (311) remain Open or In-progess since 1 Jan 2022"),
subtitle = glue("of which {open} are Open and {in_progress} are In-Progess"),
caption = caption,
y = NULL,
x = "Number of service calls"
) +
theme_classic() +
theme(
text = element_text(
family = "montserrat",
size = 16
),
plot.title = element_textbox_simple(
family = "patua-one",
size = 20,
margin = margin(b = 5)
),
plot.subtitle = element_markdown(margin = margin(b = 20)),
plot.title.position = "plot",
plot.caption.position = "plot",
plot.caption = element_text(
hjust = 0,
margin = margin(t = 15)
),
axis.line.y = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title = element_blank(),
axis.text.y = element_blank(),
# axis.text.x = element_blank(),
# axis.line.x = element_blank(),
axis.text = element_text(size = 14),
axis.ticks = element_blank(),
# axis.line.x = element_line(),
# axis.line.x.bottom = element_blank(),
legend.position = "top",
legend.margin = margin(t = 10),
plot.margin = margin(t = 10, r = 20, b = 10, l = 20)
)
status_bar_count
This looks better and one can easy see were we are in terms of servicing the open requests. Lets dive into Open and In-Progress on their own. I think it would be beneficial to measure progess against how many Open or In-Progress tickets aganist 7-days ago. By using the glue() package and some helper code we can easily show whether or not the current count of service requests is more or less than 7-days ago. We can even play with coloring the Title some.
Open Service Requests
count_open_now <- df_2022 %>%
filter(status %in% c("Open")) %>%
count() %>%
pull()
count_open_7 <- df_2022 %>%
filter(serviceorderdate <= Sys.Date() - 7, status %in% c("Open")) %>%
count() %>%
pull()
open_diff <- count_open_now - count_open_7
open_diff_text <- case_when(
count_open_now > count_open_7 ~ "increase",
count_open_now < count_open_7 ~ "decrease",
TRUE ~ "same"
)
open_requests <- df_2022 %>%
filter(status %in% c("Open")) %>%
count() %>%
ggplot(aes(x = 1, y = n)) +
geom_bar(
stat = "identity",
fill = col1,
show.legend = FALSE
) +
coord_flip() +
geom_hline(yintercept = 0) +
geom_hline(yintercept = count_open_7) +
annotate("text",
x = 1,
y = count_open_7 - 50,
hjust = 1,
color = col2,
size = 5,
label = glue("{count_open_7}\n7-days ago")
) +
labs(
title = glue("{count_open_now} DC Service Calls (311) remain <span style='color: #E1DABF'>Open</span> since 1 Jan 2022"),
subtitle = glue("That is an {open_diff_text} of {open_diff} from 7-days ago"),
caption = caption,
y = NULL,
x = "Number of service calls"
) +
theme_classic() +
theme(
text = element_text(
family = "montserrat",
size = 16
),
plot.title = element_textbox_simple(
family = "patua-one",
size = 20,
margin = margin(b = 5)
),
plot.subtitle = element_markdown(margin = margin(b = 20)),
plot.title.position = "plot",
plot.caption.position = "plot",
plot.caption = element_text(
hjust = 0,
margin = margin(t = 15)
),
axis.line.y = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title = element_blank(),
axis.text.y = element_blank(),
# axis.text.x = element_blank(),
# axis.line.x = element_blank(),
axis.text = element_text(size = 14),
axis.ticks = element_blank(),
# axis.line.x = element_line(),
# axis.line.x.bottom = element_blank(),
legend.position = "top",
legend.margin = margin(t = 10, b = -10),
plot.margin = margin(t = 10, r = 20, b = 10, l = 20)
)
open_requests
In-Progress Service Requests
count_inprogress_now <- df_2022 %>%
filter(status %in% c("In-Progress")) %>%
count() %>%
pull()
count_inprogress_7 <- df_2022 %>%
filter(serviceorderdate <= Sys.Date() - 7, status %in% c("In-Progress")) %>%
count() %>%
pull()
inprogress_diff <- count_inprogress_now - count_inprogress_7
inprogress_diff_text <- case_when(
count_inprogress_now > count_inprogress_7 ~ "increase",
count_inprogress_now < count_inprogress_7 ~ "decrease",
TRUE ~ "same"
)
inprogress_requests <- df_2022 %>%
filter(status %in% c("In-Progress")) %>%
count() %>%
ggplot(aes(x = 1, y = n)) +
geom_bar(
stat = "identity",
fill = col2,
show.legend = FALSE
) +
coord_flip() +
geom_hline(yintercept = 0) +
geom_hline(yintercept = count_inprogress_7) +
annotate("text",
x = 1,
y = count_inprogress_7 - 50,
hjust = 1,
color = col1,
size = 5,
label = glue("{count_inprogress_7}\n7-days ago")
) +
labs(
title = glue("{count_inprogress_now} DC Service Calls (311) remain <span style='color: #3C6075'>In-Progress</span> since 1 Jan 2022"),
subtitle = glue("That is an {inprogress_diff_text} of {inprogress_diff} from 7-days ago"),
caption = caption,
y = NULL,
x = "Number of service calls"
) +
theme_classic() +
theme(
text = element_text(
family = "montserrat",
size = 16
),
plot.title = element_textbox_simple(
family = "patua-one",
size = 20,
margin = margin(b = 5)
),
plot.subtitle = element_markdown(margin = margin(b = 20)),
plot.title.position = "plot",
plot.caption.position = "plot",
plot.caption = element_text(
hjust = 0,
margin = margin(t = 15)
),
axis.line.y = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title = element_blank(),
axis.text.y = element_blank(),
# axis.text.x = element_blank(),
# axis.line.x = element_blank(),
axis.text = element_text(size = 14),
axis.ticks = element_blank(),
# axis.line.x = element_line(),
# axis.line.x.bottom = element_blank(),
legend.position = "top",
legend.margin = margin(t = 10, b = -10),
plot.margin = margin(t = 10, r = 20, b = 10, l = 20)
)
inprogress_requests
Now let’s focus on if service requests are Open or In-Progress are any of them past due? We can capture the average days past due by grouping the service code description and summarizing the data by the mean days to resolve and mean days past due (days to resolve and days past due where columns we added when we wrangled the data frame)
Days Service Request Past Due
pastdue_bar_caption <- glue("Past Due Status as of {max_date_2022}")
df_2022 %>%
select(servicecodedescription, status, daystoresolve, dayspastdue) %>%
filter(status == "Closed") %>%
# filter(servicecodedescription %in% c("Trash Collection - Missed", "Illegal Dumping", "Bulk Collection")) %>%
drop_na() %>%
mutate(countpastdue = if_else(dayspastdue > 0, "Past Due", "On Time")) %>%
filter(countpastdue == "Past Due") %>%
select(servicecodedescription, dayspastdue) %>%
group_by(servicecodedescription) %>%
summarise(
avgpastdue = mean(dayspastdue),
.groups = "drop"
) %>%
top_n(10) %>%
arrange(desc(avgpastdue)) %>%
hchart(
type = "bar",
hcaes(
x = servicecodedescription,
y = avgpastdue
),
color = col2
) %>%
hc_title(
text = "
<p style='text-align:left;'>
<b>Top 10 Service Requests Average Days Past Due</b>
<br>
</p>
",
align = "left",
useHTML = TRUE
) %>%
hc_xAxis(
title = list(text = ""),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_subtitle(
text = pastdue_bar_caption,
align = "left"
) %>%
hc_yAxis(
title = list(text = "Average Days Past Due for Selected Service"),
labels = list(style = list(fontSize = "16px"))
) %>%
hc_chart(
style = list(fontFamily = "montserrat")
) %>%
hc_caption(
text = caption
) %>%
hc_size(height = 700) %>%
hc_credits(
text = "Chart created using R and highcharter",
href = "http://jkunst.com/highcharter",
enabled = TRUE
)Maps
Using the DC Service Call (311) data we can use the latitude and longitude information that is provided for the location of the request to visualize the data using maps. Lets subset the data set to focus on Illegal Dumping Service Calls.
mapdata <- service_calls_2022 %>%
filter(servicecodedescription == "Illegal Dumping") %>%
select(
lat = latitude,
lon = longitude,
ward,
zip = zipcode
) %>%
group_by(ward,zip) %>%
add_count(lat, lon, zip, ward) %>%
tibble()Very basic map visualization using highcharter package
hcmap("countries/us/us-dc-all",
showInLegend = FALSE
) %>%
hc_title(text = "Washington DC") %>%
hc_subtitle(text = "DC Service Requests 311 for Illegal Dumping") %>%
hc_add_series(
data = mapdata,
type = "mappoint",
name = " Illegal Dumping",
showInLegend = FALSE,
maxSize = "2",
tooltip = list(
pointFormat = "Zip: {point.zip} | Ward: {point.ward} <br>
({point.lat:,.2f}, {point.lon:,.2f})"
)
) %>%
hc_mapNavigation(enabled = FALSE)Map Types
Typically any mapping package has multiple map backgrounds. Here are the types of backgrounds when using ggmap. Types of maps backgrounds: watercolor, toner-lite, terrain-labels, terrain-lines,toner, toner-2011, toner-background,toner-hybrid,toner-lines. More information can be found at R Graph Gallery
library(choroplethrMaps)
library(choroplethr)
library(ggmap)
library(mapproj)
register_google(Sys.getenv("register_google"))
dc <- geocode("Washington, DC")
dc_map_toner_lite <- get_map(dc,
zoom = 12,
maptype = "toner-lite"
)
ggmap(dc_map_toner_lite,
base_layer =
ggplot(
data = mapdata,
aes(x = lon, y = lat)
)
) +
geom_point(
color = col2,
size = 1.3,
# alpha = 0.5
) +
theme_void() +
labs(
title = "DC Service Call Requests for Illegal Dumping",
caption = caption
) +
theme(
plot.title = element_text(margin = margin(b = 20)),
plot.caption = element_text(margin = margin(t = 20))
) 
You can create small multiple maps using the facet wrap function.
parking_map <- service_calls_2022 %>%
filter(servicecodedescription %in% c("Out of State Parking Violation (ROSA)", "Parking Enforcement", "Residential Parking Permit Violation" )) %>%
select(
servicecodedescription,
lat = latitude,
lon = longitude,
ward,
zip = zipcode
) %>%
tibble()
dc_map_terrian_lines <- get_map(dc,
zoom = 12,
maptype = "toner",
source = "stamen"
)
ggmap(dc_map_terrian_lines,
base_layer =
ggplot(
data = parking_map,
aes(x = lon, y = lat)
)
) +
geom_point(
color = col2,
size = .8,
# alpha = 0.5
) +
facet_wrap(~servicecodedescription) +
tidyquant::theme_tq() +
labs(
title = "DC Service Call Requests for Parking Violations",
caption = caption,
y = NULL,
x = NULL
) +
theme(
plot.margin = margin(l=20,r=20),
plot.title = element_text(margin = margin(b = 20)),
plot.caption = element_text(margin = margin(t = 20)),
axis.ticks = element_blank(),
axis.text = element_blank()
) 
You can also use color gradient to show occurrences, as you can see there is more parking enforcement service requests to the north and southeast of the city.
parking_map_2 <- service_calls_2022 %>%
filter(servicecodedescription == "Parking Enforcement") %>%
select(
servicecodedescription,
lat = latitude,
lon = longitude,
ward,
zip = zipcode
) %>%
group_by(servicecodedescription, ward) %>%
add_count(servicecodedescription, ward)
dc_map <- get_map(dc,
zoom = 12,
maptype = "toner-lines"
)
ggmap(dc_map,
base_layer =
ggplot(
data = parking_map_2,
aes(x = lon,
y = lat,
color = n)
)) +
geom_point(size=1.3) +
scale_color_gradient(low = col1, high = col2) +
scale_alpha(range = c(0, 0.75), guide = "none") +
tidyquant::theme_tq() +
labs(
title = "DC Service Call Requests for Parking Enforcement",
caption = caption,
y = NULL,
x = NULL
) +
theme(
plot.margin = margin(l=20,r=20),
plot.title = element_text(margin = margin(b = 20)),
plot.caption = element_text(margin = margin(t = 20)),
axis.ticks = element_blank(),
axis.text = element_blank()
) 
A work by Jason Barnes
barnes7599@gmail.com
Shotout to pimp my rmd to learn more: Pimp-my-rmd
This work is licensed under a Creative Commons Attribution-NonCommercial 4.0 International License.