library(sf)
library(bslib)
#> Warning: package 'bslib' was built under R version 4.3.1
library(dplyr)
library(arcgis)
library(plotly)
library(bsicons)
library(ggplot2)
library(leaflet)
{arcgis}
Building an interactive dashboard with ArcGIS hosted data
In this tutorial we will be recreating a dashboard that utilizes the data from the City of Chattanooga Open Data Portal. In the below LinkedIn post by Charlie Mix, GIS Director at the University of Tennessee at Chattanooga IGTLab, they use this data to create an ArcGIS Dashboard.
The data is provided as a Feature Service by Charlie Mix, which we will use to create a lightweight interactive dashboard in R using {arcgis}
and additional R packages.
The dashboard that we are going to create can be viewed live here.
There are 4 components to this dashboard that we will want to recreate. These are the two plots, the statistics, and the map. In this tutorial we will not create an exact replica, but one in spirit.
In addition to arcgis we will use a number of other packages to make this happen some may be new to you:
sf
: spatial data manipulationbslib
: create the UIdplyr
: basic data manipulationarcgis
: interact with feature servicesplotly
: interactive plotsbsicons
: icons for our UIggplot2
: create plotsleaflet
: create interactive mapslibrary(sf)
library(bslib)
#> Warning: package 'bslib' was built under R version 4.3.1
library(dplyr)
library(arcgis)
library(plotly)
library(bsicons)
library(ggplot2)
library(leaflet)
The very first step we will take in creating this dashboard is to read in the data from the hosted Feature Services. To do so, we will use the function arc_open()
from arcgislayers.
<- "https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer"
data_url
# open the feature server
<- arc_open(data_url)
crash_server crash_server
#> <FeatureServer <2 layers, 0 tables>>
#> CRS: 32136
#> Capabilities: Query
#> 1: Vehicle Pedestrian Incidents (esriGeometryPoint)
#> 2: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis (esriGeometryPolygon)
The url that we provided was to a Feature Server which contains two layers in it. To access these, we can use the get_layer()
function and provide the index of the layer we want. We’ll do this and store the FeatureLayer
s as the object incidents
and hotspots
.
# fetch individual layers
<- get_layer(crash_server, 1)) (incidents
#> <FeatureLayer>
#> Name: Vehicle Pedestrian Incidents
#> Geometry Type: esriGeometryPoint
#> CRS: 32136
#> Capabilities: Query
<- get_layer(crash_server, 2)) (hotspots
#> <FeatureLayer>
#> Name: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis
#> Geometry Type: esriGeometryPolygon
#> CRS: 32136
#> Capabilities: Query
Since these are very small datasets (1000 features, exactly), we can bring them into memory and interact with them as sf
objects directly without a concern for memory usage.
For larger datasets, we want to be cautious with how much data we bring into memory and only use what is needed at a time.
# bring them into memory as sf objects
<- arc_select(incidents)
inci_sf <- arc_select(hotspots) hs_sf
Let’s preview the data using dplyr::glimpse()
.
glimpse(hs_sf)
#> Rows: 369
#> Columns: 10
#> $ OBJECTID <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…
#> $ SOURCE_ID <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…
#> $ JOIN_COUNT <int> 2, 1, 1, 1, 1, 2, 1, 6, 1, 3, 1, 1, 1, 3, 1, 3, 1, 2, 1,…
#> $ GiZScore <dbl> -0.40186687, -0.40186687, -0.40186687, -0.61763312, 0.76…
#> $ GiPValue <dbl> 0.6877820, 0.6877820, 0.6877820, 0.5368172, 0.4431177, 0…
#> $ NNeighbors <int> 3, 3, 3, 2, 10, 14, 14, 14, 7, 6, 21, 13, 6, 22, 24, 23,…
#> $ Gi_Bin <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
#> $ Shape__Area <dbl> 115843.3, 115848.0, 115857.5, 115909.8, 115924.1, 115933…
#> $ Shape__Length <dbl> 1266.954, 1266.979, 1267.031, 1267.318, 1267.396, 1267.4…
#> $ geometry <MULTIPOLYGON [m]> MULTIPOLYGON (((668610.5 95..., MULTIPOLYGO…
glimpse(inci_sf)
#> Rows: 631
#> Columns: 32
#> $ OBJECTID <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,…
#> $ Incident_Number <chr> "23-008820", "22-130607", "22-108023", "23…
#> $ Incident_Date <dttm> 2023-01-25 18:00:00, 2022-12-03 18:02:00,…
#> $ Time_Num <dbl> 18.0, 18.0, 17.5, 1.5, 12.5, 20.5, 18.5, 9…
#> $ Street <chr> "E 11th St", "2000 S Kelley St", "Dodds Av…
#> $ Alt_Street <chr> NA, NA, NA, NA, NA, "US-11", NA, NA, NA, "…
#> $ City <chr> "Chattanooga", "Chattanooga", "Chattanooga…
#> $ County <chr> "Hamilton", "Hamilton", "Hamilton", "Hamil…
#> $ Intersection <chr> "Market St", "E 23rd Street", "E 41st St",…
#> $ Mile_Post <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
#> $ Accident_Type <chr> "Possible Injury", "Property Damage Under"…
#> $ Collision_Type <chr> "Not Collision with Motor Vehicle in Trans…
#> $ Hit_and_Run <chr> "No", "No", "No", "No", "No", "No", "No", …
#> $ Involved_Fatal_Injury <chr> "No", "No", "No", "No", "No", "No", "No", …
#> $ Involved_Medical_Transport <chr> "No", "No", "Yes", "Yes", "Yes", "Yes", "N…
#> $ Involved_Placarded_Truck <chr> "No", "No", "No", "No", "No", "No", "No", …
#> $ Posted_Speed <int> 25, 20, 40, 30, 45, 45, 15, NA, 35, 45, 40…
#> $ Total_Vehicles_Involved <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
#> $ Weather_Code <chr> "Clear", "Clear", "Clear", "Clear", "Clear…
#> $ Pedestrian_Involved <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", …
#> $ Bicycle_Involved <chr> "No", "No", "No", "No", "No", "No", "No", …
#> $ Drug_Involved <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
#> $ Alcohol_Involved <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
#> $ Light_Condition <chr> "Dark - Lighted", "Dark - Lighted", "Dayli…
#> $ Driver_One_Safety_Equipment <chr> "Unknown", "Unknown", "Unknown", "Unknown"…
#> $ Driver_One_Zip <chr> "37411", "37403", "37421", "37421", "37404…
#> $ Driver_Two_Safety_Equipment <chr> "Shoulder and Lap Belt Used", "Shoulder an…
#> $ Driver_Two_Zip <chr> "30755", "37406", "37407", "37341", "32148…
#> $ Latitude <dbl> 35.04283, 35.01957, 34.99520, 35.08057, 35…
#> $ Longitude <dbl> -85.31865, -85.27885, -85.28440, -85.26217…
#> $ Location_WKT <chr> "POINT (-85.318653 35.0428324)", "POINT (-…
#> $ geometry <POINT [m]> POINT (662169.1 78935.9), POINT (665…
Next, we will recreate the charts that were used in the original dashboard using the packages ggplot2
and plotly
There are two plots that we will need to create. The first is the total number of incidents annually.
Before we can make the plots, we need to calculate the annual counts and store them in their own data.frame
.
Here we drop the geometry from the inci_sf
sf object by using st_drop_geometry()
. Next, we use the function lubridate::year()
to extract the year as an integer from a date vector. Lastly, we dplyr::count()
the number of observations per year.
# set the theme that we will use
theme_set(theme_minimal())
<- inci_sf |>
annual_counts st_drop_geometry() |>
mutate(year = lubridate::year(Incident_Date)) |>
count(year)
annual_counts
#> year n
#> 1 2018 91
#> 2 2019 98
#> 3 2020 85
#> 4 2021 116
#> 5 2022 129
#> 6 2023 112
We drop the geometry because it is not needed for the calculation. If you include the geometry, they will be unioned which can be computationally intensive and time consuming.
From this we can create a basic line plot using ggplot()
.
If you are unfamiliar with the basics of ggplot2 and dplyr, consider starting with R for Data Science
<- ggplot(annual_counts, aes(year, n)) +
gg_annual geom_line() +
geom_point(size = 3) +
labs(
x = "Year",
y = "Incidents"
)
We’ll take a similar approach for for counting the number of incidents based on the Posted_Speed
column. Rather than counting based on the year we count based on the number of observations per unique value of Posted_Speed
. We then remove the count of missing values.
<- inci_sf |>
speed_counts st_drop_geometry() |>
count(Posted_Speed) |>
filter(!is.na(Posted_Speed))
<- ggplot(speed_counts, aes(Posted_Speed, n)) +
gg_speed geom_col() +
labs(
x = "Posted Speed Limit (miles per hour)",
y = "Incidents"
)
gg_annual gg_speed
Achieving interactivity is a breeze with the function plotly::ggplotly()
.
ggplotly(gg_annual)
ggplotly(gg_speed)
Now that we have defined our interactive plots, we can begin to create our first dashboard component with **bslib**
.
bslib lets us create html directly in R and provides many functions to create well designed components. In our dashboard we will include our plots in their own navigable tabs. To do so we will use the navset_card_tab()
function. Each tab in the “navset” is defined by a nav_panel()
. Here we can scaffold the navset and see what it looks like with no contents.
navset_card_tab(
title = "Plots",
nav_panel(
title = "By year"
),nav_panel(
title = "By speed"
) )
Next, let’s include the plots in the nav_panel()
s. We add the a title using card_title()
and then include the plotly widget directly for each plot. We’ll save the component into an object called plot_tab
which we will use later on.
<- navset_card_tab(
plot_tab title = "Plots",
nav_panel(
"By year",
card_title("Vehicle-Pedestrian Incidents by Year"),
ggplotly(gg_annual)
),nav_panel(
"By speed",
card_title("Vehicle Pedestrian Incidents by Posted Speed Limit"),
ggplotly(gg_speed)
)
)
plot_tab
Next, we will replicate the statistics boxes and add a bit of flair. To do so, we need to calculate the counts. This will be a lot like the approach we took above for calculating the number of incidents by year and speed. Below two approaches are provided. The dplyr
approach uses another function dplyr::pull()
which will extract a column into its underlying vector.
<- count(inci_sf) |>
n_incidents pull(n)
<- inci_sf |>
n_medical_transit count(Involved_Medical_Transport) |>
filter(Involved_Medical_Transport == "Yes") |>
pull(n)
<- inci_sf |>
n_fatalities count(Involved_Fatal_Injury) |>
filter(Involved_Fatal_Injury == "Yes") |>
pull(n)
<- inci_sf |>
n_alc_drug filter(Drug_Involved == "Yes" | Alcohol_Involved == "Yes") |>
count() |>
pull(n)
<- nrow(inci_sf)
n_incidents
<- table(inci_sf$Involved_Medical_Transport)["Yes"]
n_medical_transit
<- table(inci_sf$Involved_Fatal_Injury)[["Yes"]]
n_fatalities
<- sum(
n_alc_drug $Drug_Involved == "Yes" | inci_sf$Alcohol_Involved == "Yes",
inci_sfna.rm = TRUE
)
To create the boxes we will utilize bslib::value_box()
. For example
value_box("Number of Incidents", n_incidents)
Number of Incidents
631
The showcase
argument lets us add text or images that are emphasized in the value box. Let’s use bootstrap icons to add a bit of flair.
value_box(
"Number of Incidents",
n_incidents,showcase = bs_icon("person")
)
Number of Incidents
631
Let’s create a card for each of these statistics and store them in their own variable.
<- value_box(
inci_card "Number of Incidents",
n_incidents,showcase = bs_icon("person")
)
<- value_box(
fatalities_card "Total Fatalities",
n_fatalities,showcase = bs_icon("heartbreak")
)
<- value_box(
medical_card "Involved Medical Transport",
n_medical_transit,showcase = bs_icon("heart-pulse")
)
<- value_box(
drugs_card "Involved Drugs or Alcohol",
n_alc_drug,showcase = bs_icon("capsule")
)
Next, we will build out another component of our dashboard from these cards. We’ll create a grid of these 4 using bslib::layout_columns()
. This will arrange bslib components into columns for us.
layout_columns(
inci_card,
fatalities_card,
medical_card,
drugs_card )
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
By default this will put each item in their own column. But we can specify the width of each element in grid units. In web development, user interfaces are often partitioned into grid units that are broken into twelve units. So if we want two value cards per row, we need to specify the column widths to be 6.
<- layout_columns(
stats
inci_card,
fatalities_card,
medical_card,
drugs_card,col_widths = 6
)
stats
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
Having created two of the three component of our dashboard, let’s take on the most challenging one: the map. We will use leaflet to create the map itself. However, for the sake of simplicity we will only be visualizing the hot spots and not adding in further interactivity such as pop-ups. Or the location of individual incidents.
First let’s create a vector of Hot Spot Analysis result labels called gi_labels
.
Hot Spot Analysis works by calculating a statistic called the Gi* (gee-eye-star).
# create labels vector to pass to leaflet
<- c(
gi_labels "Not Significant",
"Hot Spot with 90% Confidence",
"Hot Spot with 95% Confidence",
"Hot Spot with 99% Confidence"
)
We’ll translate the Gi_Bin
values to labels using the dplyr::case_when()
function which lets us evaluate logical statements and when they evaluate to true, assign a value.
Since we will be using leaflet
we will also need to use WGS84 coordinate system. We can use st_transform()
to transform the geometry.
<- hs_sf |>
hexes transmute(
classification = case_when(
== 0 ~ gi_labels[1],
Gi_Bin == 1 ~ gi_labels[2],
Gi_Bin == 2 ~ gi_labels[3],
Gi_Bin == 3 ~ gi_labels[4]
Gi_Bin
)|>
) st_transform(4326)
In order to modify the symbology used by leaflet, we need to create a color palette ourselves. For this, we will use the colorFactor()
function. We need to provide it with two arguments. The first argument will be a character vector of color codes. The second argument levels
, is also a character vector of the same length as the palette
argument. The colors match the levels by position.
<- colorFactor(
pal palette = c("#c6c6c3", "#c8976e", "#be6448", "#af3129"),
levels = gi_labels
)
With all of this, we can create our map in one chain. There’s a lot going on here, but if you run it step by step, it’ll be quite clear.
First, we instantiate a leaflet map using leaflet()
. Then, we add tiles (a base map) using addProviderTiles()
. Following, we add our hexes
object to the map using the addPolygons()
function, add a legend with addLegend()
. Lastly, we set an initial viewport location with the setView()
function.
<- leaflet() |>
map addProviderTiles("Esri.WorldGrayCanvas") |>
addPolygons(
data = hexes,
fillColor = ~pal(classification),
color = "#c6c6c3",
weight = 1,
fillOpacity = 0.8
|>
) addLegend(
pal = pal,
values = gi_labels,
opacity = 1,
title = "Hot Spot Classification"
|>
) setView(-85.3, 35.04, 12.5)
map
To simplify our dashboard creation later, we can put this map into a bslib component with bslib::card()
. We will give it a proper title as well with bslib::card_header()
.
<- card(
map_card card_header("Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)"),
map
)
map_card
Create an empty page with bslib::page_fillable()
. We can add all of our elements directly to this page.
page_fillable(
theme = theme_bootswatch("darkly"),
map_card, stats, plot_tab )
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
But they are all squished together and it isn’t much of a dashboard. We can use the bslib::layout_columns()
function to begin to arrange this a bit more. Let’s first get our right hand side of the dashboard arranged into its own layout so that the statistics sit above the plots.
We’ll set the col_widths = 12
so that each component takes the full width.
<- layout_columns(
rhs_col
stats,
plot_tab,col_widths = 12
)
rhs_col
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
Now that we have the right hand side sorted out, let’s create another layout_columns()
where the map takes up 2/3 of the screen and the right hand column takes up the rest of the space.
<- layout_columns(
dash_content
map_card,
rhs_col,col_widths = c(8, 4)
)
dash_content
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
Now we can put this in our page_filable()
page_fillable(dash_content)
Number of Incidents
631
Total Fatalities
40
Involved Medical Transport
381
Involved Drugs or Alcohol
36
app.R
library(sf)
library(bslib)
library(dplyr)
library(arcgis)
library(plotly)
library(bsicons)
library(ggplot2)
library(leaflet)
theme_set(theme_minimal())
<- "https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer"
data_url
# open the feature server
<- arc_open(data_url)
crash_server
# fetch individual layers
<- get_layer(crash_server, 1)
incidents <- get_layer(crash_server, 2)
hotspots
# bring them into memory as sf objects
<- arc_select(incidents)
inci_sf <- arc_select(hotspots)
hs_sf
# count the number of incidents by year
<- inci_sf |>
annual_counts st_drop_geometry() |>
mutate(year = lubridate::year(Incident_Date)) |>
group_by(year) |>
count() |>
ungroup()
# make annual incidents plot
<- ggplot(annual_counts, aes(year, n)) +
gg_annual geom_line() +
geom_point(size = 3) +
labs(
x = "Year",
y = "Incidents"
)
# count incidents by speed
<- inci_sf |>
speed_counts st_drop_geometry() |>
count(Posted_Speed) |>
filter(!is.na(Posted_Speed))
<- ggplot(speed_counts, aes(Posted_Speed, n)) +
gg_speed geom_col() +
labs(
x = "Posted Speed Limit (miles per hour)",
y = "Incidents"
)
<- navset_card_tab(
plot_tab title = "Plots",
nav_panel(
"By year",
card_title("Vehicle-Pedestrian Incidents by Year"),
ggplotly(gg_annual)
),nav_panel(
"By speed",
card_title("Vehicle Pedestrian Incidents by Posted Speed Limit"),
ggplotly(gg_speed)
)
)
<- count(inci_sf) |>
n_incidents pull(n)
<- inci_sf |>
n_medical_transit count(Involved_Medical_Transport) |>
filter(Involved_Medical_Transport == "Yes") |>
pull(n)
<- inci_sf |>
n_fatalities count(Involved_Fatal_Injury) |>
filter(Involved_Fatal_Injury == "Yes") |>
pull(n)
<- inci_sf |>
n_alc_drug filter(Drug_Involved == "Yes" | Alcohol_Involved == "Yes") |>
count() |>
pull(n)
<- value_box(
inci_card "Number of Incidents",
n_incidents,showcase = bs_icon("person")
)
<- value_box(
fatalities_card "Total Fatalities",
n_fatalities,showcase = bs_icon("heartbreak")
)
<- value_box(
medical_card "Involved Medical Transport",
n_medical_transit,showcase = bs_icon("heart-pulse")
)
<- value_box(
drugs_card "Involved Drugs or Alcohol",
n_alc_drug,showcase = bs_icon("capsule")
)
<- layout_columns(
stats
inci_card,
fatalities_card,
medical_card,
drugs_card,col_widths = 6
)
<- layout_columns(
rhs_col
stats,
plot_tab,col_widths = 12
)
# create labels vector to pass to leaflet
<- c(
gi_labels "Not Significant",
"Hot Spot with 90% Confidence",
"Hot Spot with 95% Confidence",
"Hot Spot with 99% Confidence"
)
<- hs_sf |>
hexes transmute(
classification = case_when(
== 0 ~ gi_labels[1],
Gi_Bin == 1 ~ gi_labels[2],
Gi_Bin == 2 ~ gi_labels[3],
Gi_Bin == 3 ~ gi_labels[4]
Gi_Bin
)|>
) st_transform(4326)
<- colorFactor(
pal palette = c("#c6c6c3", "#c8976e", "#be6448", "#af3129"),
levels = gi_labels
)
<- leaflet() |>
map addProviderTiles("Esri.WorldGrayCanvas") |>
addPolygons(
data = hexes,
fillColor = ~pal(classification),
color = "#c6c6c3",
weight = 1,
fillOpacity = 0.8
|>
) addLegend(
pal = pal,
values = gi_labels,
opacity = 1,
title = "Hot Spot Classification"
|>
) setView(-85.3, 35.04, 12.5)
<- card(
map_card card_header("Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)"),
map
)
<- layout_columns(
dash_content
map_card,
rhs_col,col_widths = c(8, 4)
)
<- page_fillable(
ui
dash_content
)
# print ui to open the dashboard
ui