Dashboard using {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.

Original LinkedIn Post

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.

The Packages

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 manipulation
  • bslib: create the UI
  • dplyr: basic data manipulation
  • arcgis: interact with feature services
  • plotly: interactive plots
  • bsicons: icons for our UI
  • ggplot2: create plots
  • leaflet: create interactive maps
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)

Reading data from ArcGIS Online

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.

data_url <- "https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer"

# open the feature server
crash_server <- arc_open(data_url)
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 FeatureLayers as the object incidents and hotspots.

# fetch individual layers
(incidents <- get_layer(crash_server, 1))
#> <FeatureLayer>
#> Name: Vehicle Pedestrian Incidents
#> Geometry Type: esriGeometryPoint
#> CRS: 32136
#> Capabilities: Query
(hotspots <- get_layer(crash_server, 2))
#> <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.

Tip

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
inci_sf <- arc_select(incidents)
hs_sf <- arc_select(hotspots)

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…

Creating the plots

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())

annual_counts <- inci_sf |>
  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().

Note

If you are unfamiliar with the basics of ggplot2 and dplyr, consider starting with R for Data Science

gg_annual <- ggplot(annual_counts, aes(year, n)) +
  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.

speed_counts <- inci_sf |>
  st_drop_geometry() |>
  count(Posted_Speed) |>
  filter(!is.na(Posted_Speed))

gg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +
  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)

Plots UI components

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.

plot_tab <- navset_card_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
Vehicle-Pedestrian Incidents by Year
Vehicle Pedestrian Incidents by Posted Speed Limit

Statistic value boxes

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.

n_incidents <- count(inci_sf) |> 
  pull(n)

n_medical_transit <- inci_sf |> 
  count(Involved_Medical_Transport) |> 
  filter(Involved_Medical_Transport == "Yes") |> 
  pull(n)

n_fatalities <- inci_sf |> 
  count(Involved_Fatal_Injury) |> 
  filter(Involved_Fatal_Injury == "Yes") |> 
  pull(n)

n_alc_drug <- inci_sf |> 
  filter(Drug_Involved == "Yes" | Alcohol_Involved == "Yes") |> 
  count() |> 
  pull(n)
n_incidents <- nrow(inci_sf)

n_medical_transit <- table(inci_sf$Involved_Medical_Transport)["Yes"]

n_fatalities <- table(inci_sf$Involved_Fatal_Injury)[["Yes"]]

n_alc_drug <- sum(
  inci_sf$Drug_Involved == "Yes" | inci_sf$Alcohol_Involved == "Yes", 
  na.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.

inci_card <- value_box(
  "Number of Incidents",
  n_incidents,
  showcase = bs_icon("person")
)

fatalities_card <- value_box(
  "Total Fatalities",
  n_fatalities,
  showcase = bs_icon("heartbreak")
)

medical_card <- value_box(
  "Involved Medical Transport",
  n_medical_transit,
  showcase = bs_icon("heart-pulse")
)

drugs_card <- value_box(
  "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.

stats <- layout_columns(
  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

Creating the map

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
gi_labels <- c(
  "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.

hexes <- hs_sf |>
  transmute(
    classification = case_when(
      Gi_Bin == 0 ~ gi_labels[1],
      Gi_Bin == 1 ~ gi_labels[2],
      Gi_Bin == 2 ~ gi_labels[3],
      Gi_Bin == 3 ~ gi_labels[4]
    )
  ) |>
  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.

pal <- colorFactor(
  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.

map <- leaflet() |>
  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().

map_card <- card(
  card_header("Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)"),
  map
)

map_card
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)

Putting the UI together

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
)
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)

Number of Incidents

631

Total Fatalities

40

Involved Medical Transport

381

Involved Drugs or Alcohol

36

Vehicle-Pedestrian Incidents by Year
Vehicle Pedestrian Incidents by Posted Speed Limit

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.

rhs_col <- layout_columns(
  stats,
  plot_tab,
  col_widths = 12
)

rhs_col

Number of Incidents

631

Total Fatalities

40

Involved Medical Transport

381

Involved Drugs or Alcohol

36

Vehicle-Pedestrian Incidents by Year
Vehicle Pedestrian Incidents by Posted Speed Limit

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.

dash_content <- layout_columns(
  map_card,
  rhs_col,
  col_widths = c(8, 4)
)

dash_content
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)

Number of Incidents

631

Total Fatalities

40

Involved Medical Transport

381

Involved Drugs or Alcohol

36

Vehicle-Pedestrian Incidents by Year
Vehicle Pedestrian Incidents by Posted Speed Limit

Now we can put this in our page_filable()

page_fillable(dash_content)
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)

Number of Incidents

631

Total Fatalities

40

Involved Medical Transport

381

Involved Drugs or Alcohol

36

Vehicle-Pedestrian Incidents by Year
Vehicle Pedestrian Incidents by Posted Speed Limit

Source code

app.R
library(sf)
library(bslib)
library(dplyr)
library(arcgis)
library(plotly)
library(bsicons)
library(ggplot2)
library(leaflet)

theme_set(theme_minimal())

data_url <- "https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer"

# open the feature server
crash_server <- arc_open(data_url)

# fetch individual layers
incidents <- get_layer(crash_server, 1)
hotspots <- get_layer(crash_server, 2)

# bring them into memory as sf objects
inci_sf <- arc_select(incidents)
hs_sf <- arc_select(hotspots)

# count the number of incidents by year
annual_counts <- inci_sf |>
  st_drop_geometry() |>
  mutate(year = lubridate::year(Incident_Date)) |>
  group_by(year) |>
  count() |>
  ungroup()

# make annual incidents plot
gg_annual <- ggplot(annual_counts, aes(year, n)) +
  geom_line() +
  geom_point(size = 3) +
  labs(
    x = "Year",
    y = "Incidents"
  )

# count incidents by speed
speed_counts <- inci_sf |>
  st_drop_geometry() |>
  count(Posted_Speed) |>
  filter(!is.na(Posted_Speed))

gg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +
  geom_col() +
  labs(
    x = "Posted Speed Limit (miles per hour)",
    y = "Incidents"
  )

plot_tab <- navset_card_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)
  )
)

n_incidents <- count(inci_sf) |>
  pull(n)

n_medical_transit <- inci_sf |>
  count(Involved_Medical_Transport) |>
  filter(Involved_Medical_Transport == "Yes") |>
  pull(n)

n_fatalities <- inci_sf |>
  count(Involved_Fatal_Injury) |>
  filter(Involved_Fatal_Injury == "Yes") |>
  pull(n)

n_alc_drug <- inci_sf |>
  filter(Drug_Involved == "Yes" | Alcohol_Involved == "Yes") |>
  count() |>
  pull(n)

inci_card <- value_box(
  "Number of Incidents",
  n_incidents,
  showcase = bs_icon("person")
)

fatalities_card <- value_box(
  "Total Fatalities",
  n_fatalities,
  showcase = bs_icon("heartbreak")
)

medical_card <- value_box(
  "Involved Medical Transport",
  n_medical_transit,
  showcase = bs_icon("heart-pulse")
)

drugs_card <- value_box(
  "Involved Drugs or Alcohol",
  n_alc_drug,
  showcase = bs_icon("capsule")
)

stats <- layout_columns(
  inci_card,
  fatalities_card,
  medical_card,
  drugs_card,
  col_widths = 6
)


rhs_col <- layout_columns(
  stats,
  plot_tab,
  col_widths = 12
)


# create labels vector to pass to leaflet
gi_labels <- c(
  "Not Significant",
  "Hot Spot with 90% Confidence",
  "Hot Spot with 95% Confidence",
  "Hot Spot with 99% Confidence"
)

hexes <- hs_sf |>
  transmute(
    classification = case_when(
      Gi_Bin == 0 ~ gi_labels[1],
      Gi_Bin == 1 ~ gi_labels[2],
      Gi_Bin == 2 ~ gi_labels[3],
      Gi_Bin == 3 ~ gi_labels[4]
    )
  ) |>
  st_transform(4326)

pal <- colorFactor(
  palette = c("#c6c6c3", "#c8976e", "#be6448", "#af3129"),
  levels = gi_labels
)

map <- leaflet() |>
  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_card <- card(
  card_header("Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)"),
  map
)

dash_content <- layout_columns(
  map_card,
  rhs_col,
  col_widths = c(8, 4)
)

ui <- page_fillable(
  dash_content
)

# print ui to open the dashboard
ui