From 0d713cbff3ecb7be401f4b9a625b6a9b3bb173e7 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Thu, 7 Dec 2023 15:10:53 -0500 Subject: [PATCH] update --- .../tutorials/shiny-dash/index/execute-results/html.json | 4 ++-- location-services/tutorials/shiny-dash/index.qmd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/_freeze/location-services/tutorials/shiny-dash/index/execute-results/html.json b/_freeze/location-services/tutorials/shiny-dash/index/execute-results/html.json index 237099e..0134d33 100644 --- a/_freeze/location-services/tutorials/shiny-dash/index/execute-results/html.json +++ b/_freeze/location-services/tutorials/shiny-dash/index/execute-results/html.json @@ -1,8 +1,8 @@ { - "hash": "314e2de3588ee070a5993ccc1399aae3", + "hash": "66afece19e375d4fc1b9b9c698a82048", "result": { "engine": "knitr", - "markdown": "---\ntitle: \"Dashboard using `{arcgis}`\"\nsubtitle: \"Building an interactive dashboard with ArcGIS hosted data\"\nfreeze: true\nresources: \n - dash/**\n---\n\n\n\n\nIn this tutorial we will be recreating a dashboard that utilizes the data from the [City of Chattanooga Open Data Portal](https://www.chattadata.org/Public-Safety/Pedestrian-Accidents/8piy-9u9f). In the below LinkedIn post by [Charlie Mix](https://www.linkedin.com/in/charlie-mix/), they use this data to create an ArcGIS Dashboard.\n\n\n\n[Original LinkedIn Post](https://www.linkedin.com/posts/charlie-mix_arcgisdashboard-gis-activity-7135693623307767808-sbRW?utm_source=share&utm_medium=member_desktop)\n\nThe data is provided as a [Feature Service](https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer) by Charlie Mix, which we will use to create a lightweight interactive dashboard in R using `{arcgis}` and additional R packages.\n\nThe dashboard that we are going to create can be [viewed live here](./dash/index.html).\n\n## The Packages\n\nThere 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.\n\nIn addition to **arcgis** we will use a number of other packages to make this happen some may be new to you:\n\n- [`sf`](https://r-spatial.github.io/sf/): spatial data manipulation\n- [`bslib`](https://rstudio.github.io/bslib/): create the UI\n- [`dplyr`](https://dplyr.tidyverse.org/): basic data manipulation\n- [`arcgis`](https://r.esri.com/arcgis/): interact with feature services\n- [`plotly`](https://plotly.com/r/): interactive plots\n- [`bsicons`](https://github.com/rstudio/bsicons): icons for our UI\n- [`ggplot2`](https://ggplot2.tidyverse.org/): create plots\n- [`leaflet`](https://rstudio.github.io/leaflet/): create interactive maps\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(bslib)\n```\n\n::: {.cell-output .cell-output-stderr}\n\n```\n#> Warning: package 'bslib' was built under R version 4.3.1\n```\n\n\n:::\n\n```{.r .cell-code}\nlibrary(dplyr)\nlibrary(arcgis)\nlibrary(plotly)\nlibrary(bsicons)\nlibrary(ggplot2)\nlibrary(leaflet)\n```\n:::\n\n\n## Reading data from ArcGIS Online\n\nThe 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ndata_url <- \"https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer\"\n\n# open the feature server\ncrash_server <- arc_open(data_url)\ncrash_server\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> CRS: 32136\n#> Capabilities: Query\n#> 1: Vehicle Pedestrian Incidents (esriGeometryPoint)\n#> 2: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis (esriGeometryPolygon)\n```\n\n\n:::\n:::\n\n\nThe 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`.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# fetch individual layers\n(incidents <- get_layer(crash_server, 1))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> Name: Vehicle Pedestrian Incidents\n#> Geometry Type: esriGeometryPoint\n#> CRS: 32136\n#> Capabilities: Query\n```\n\n\n:::\n\n```{.r .cell-code}\n(hotspots <- get_layer(crash_server, 2))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> Name: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis\n#> Geometry Type: esriGeometryPolygon\n#> CRS: 32136\n#> Capabilities: Query\n```\n\n\n:::\n:::\n\n\nSince 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. \n\n:::{.callout-tip}\nFor larger datasets, we want to be cautious with how much data we bring into memory and only use what is needed at a time.\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# bring them into memory as sf objects\ninci_sf <- arc_select(incidents)\nhs_sf <- arc_select(hotspots)\n```\n:::\n\n\nLet's preview the data using `dplyr::glimpse()`. \n\n:::{.panel-tabset}\n\n### Hot Spot Analysis\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(hs_sf)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> Rows: 369\n#> Columns: 10\n#> $ OBJECTID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…\n#> $ SOURCE_ID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…\n#> $ JOIN_COUNT 2, 1, 1, 1, 1, 2, 1, 6, 1, 3, 1, 1, 1, 3, 1, 3, 1, 2, 1,…\n#> $ GiZScore -0.40186687, -0.40186687, -0.40186687, -0.61763312, 0.76…\n#> $ GiPValue 0.6877820, 0.6877820, 0.6877820, 0.5368172, 0.4431177, 0…\n#> $ NNeighbors 3, 3, 3, 2, 10, 14, 14, 14, 7, 6, 21, 13, 6, 22, 24, 23,…\n#> $ Gi_Bin 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…\n#> $ Shape__Area 115843.3, 115848.0, 115857.5, 115909.8, 115924.1, 115933…\n#> $ Shape__Length 1266.954, 1266.979, 1267.031, 1267.318, 1267.396, 1267.4…\n#> $ geometry MULTIPOLYGON (((668610.5 95..., MULTIPOLYGO…\n```\n\n\n:::\n:::\n\n\n### Incidents\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(inci_sf)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> Rows: 631\n#> Columns: 32\n#> $ OBJECTID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,…\n#> $ Incident_Number \"23-008820\", \"22-130607\", \"22-108023\", \"23…\n#> $ Incident_Date 2023-01-25 18:00:00, 2022-12-03 18:02:00,…\n#> $ Time_Num 18.0, 18.0, 17.5, 1.5, 12.5, 20.5, 18.5, 9…\n#> $ Street \"E 11th St\", \"2000 S Kelley St\", \"Dodds Av…\n#> $ Alt_Street NA, NA, NA, NA, NA, \"US-11\", NA, NA, NA, \"…\n#> $ City \"Chattanooga\", \"Chattanooga\", \"Chattanooga…\n#> $ County \"Hamilton\", \"Hamilton\", \"Hamilton\", \"Hamil…\n#> $ Intersection \"Market St\", \"E 23rd Street\", \"E 41st St\",…\n#> $ Mile_Post NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Accident_Type \"Possible Injury\", \"Property Damage Under\"…\n#> $ Collision_Type \"Not Collision with Motor Vehicle in Trans…\n#> $ Hit_and_Run \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Involved_Fatal_Injury \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Involved_Medical_Transport \"No\", \"No\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"N…\n#> $ Involved_Placarded_Truck \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Posted_Speed 25, 20, 40, 30, 45, 45, 15, NA, 35, 45, 40…\n#> $ Total_Vehicles_Involved 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …\n#> $ Weather_Code \"Clear\", \"Clear\", \"Clear\", \"Clear\", \"Clear…\n#> $ Pedestrian_Involved \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", …\n#> $ Bicycle_Involved \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Drug_Involved NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Alcohol_Involved NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Light_Condition \"Dark - Lighted\", \"Dark - Lighted\", \"Dayli…\n#> $ Driver_One_Safety_Equipment \"Unknown\", \"Unknown\", \"Unknown\", \"Unknown\"…\n#> $ Driver_One_Zip \"37411\", \"37403\", \"37421\", \"37421\", \"37404…\n#> $ Driver_Two_Safety_Equipment \"Shoulder and Lap Belt Used\", \"Shoulder an…\n#> $ Driver_Two_Zip \"30755\", \"37406\", \"37407\", \"37341\", \"32148…\n#> $ Latitude 35.04283, 35.01957, 34.99520, 35.08057, 35…\n#> $ Longitude -85.31865, -85.27885, -85.28440, -85.26217…\n#> $ Location_WKT \"POINT (-85.318653 35.0428324)\", \"POINT (-…\n#> $ geometry POINT (662169.1 78935.9), POINT (665…\n```\n\n\n:::\n:::\n\n\n:::\n\n## Creating the plots\n\nNext, 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.\n\nBefore we can make the plots, we need to calculate the annual counts and store them in their own `data.frame`.\n\nHere 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\n# set the theme that we will use\ntheme_set(theme_minimal())\n\nannual_counts <- inci_sf |>\n st_drop_geometry() |>\n mutate(year = lubridate::year(Incident_Date)) |>\n count(year)\n\nannual_counts\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> year n\n#> 1 2018 91\n#> 2 2019 98\n#> 3 2020 85\n#> 4 2021 116\n#> 5 2022 129\n#> 6 2023 112\n```\n\n\n:::\n:::\n\n\n:::{.aside}\nWe 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. \n:::\n\nFrom this we can create a basic line plot using `ggplot()`. \n\n:::{.callout-note}\nIf you are unfamiliar with the basics of ggplot2 and dplyr, consider starting with [R for Data Science](https://r4ds.had.co.nz/data-visualisation.html)\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\ngg_annual <- ggplot(annual_counts, aes(year, n)) +\n geom_line() +\n geom_point(size = 3) +\n labs(\n x = \"Year\",\n y = \"Incidents\"\n )\n```\n:::\n\n\nWe'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. \n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nspeed_counts <- inci_sf |>\n st_drop_geometry() |>\n count(Posted_Speed) |>\n filter(!is.na(Posted_Speed))\n\ngg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +\n geom_col() +\n labs(\n x = \"Posted Speed Limit (miles per hour)\",\n y = \"Incidents\"\n )\n\ngg_annual\n```\n\n::: {.cell-output-display}\n![](index_files/figure-html/unnamed-chunk-10-1.png){width=672}\n:::\n\n```{.r .cell-code}\ngg_speed\n```\n\n::: {.cell-output-display}\n![](index_files/figure-html/unnamed-chunk-10-2.png){width=672}\n:::\n:::\n\n\nAchieving interactivity is a breeze with the function `plotly::ggplotly()`.\n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nggplotly(gg_annual)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n\n```{.r .cell-code}\nggplotly(gg_speed)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n:::\n\n\n\n### Plots UI components \n\nNow that we have defined our interactive plots, we can begin to create our first dashboard component with `**bslib**`. \n\nbslib 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nnavset_card_tab(\n title = \"Plots\",\n nav_panel(\n title = \"By year\"\n ),\n nav_panel(\n title = \"By speed\"\n )\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\nPlots\n\n
\n
\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\nNext, 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nplot_tab <- navset_card_tab(\n title = \"Plots\",\n nav_panel(\n \"By year\",\n card_title(\"Vehicle-Pedestrian Incidents by Year\"),\n ggplotly(gg_annual)\n ),\n nav_panel(\n \"By speed\",\n card_title(\"Vehicle Pedestrian Incidents by Posted Speed Limit\"),\n ggplotly(gg_speed)\n )\n)\n\nplot_tab\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\n\n## Statistic value boxes\n\nNext, 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\n:::{.panel-tabset}\n\n### dplyr\n\n\n::: {.cell}\n\n```{.r .cell-code}\nn_incidents <- count(inci_sf) |> \n pull(n)\n\nn_medical_transit <- inci_sf |> \n count(Involved_Medical_Transport) |> \n filter(Involved_Medical_Transport == \"Yes\") |> \n pull(n)\n\nn_fatalities <- inci_sf |> \n count(Involved_Fatal_Injury) |> \n filter(Involved_Fatal_Injury == \"Yes\") |> \n pull(n)\n\nn_alc_drug <- inci_sf |> \n filter(Drug_Involved == \"Yes\" | Alcohol_Involved == \"Yes\") |> \n count() |> \n pull(n)\n```\n:::\n\n\n### Base R\n\n\n::: {.cell}\n\n```{.r .cell-code}\nn_incidents <- nrow(inci_sf)\n\nn_medical_transit <- table(inci_sf$Involved_Medical_Transport)[\"Yes\"]\n\nn_fatalities <- table(inci_sf$Involved_Fatal_Injury)[[\"Yes\"]]\n\nn_alc_drug <- sum(\n inci_sf$Drug_Involved == \"Yes\" | inci_sf$Alcohol_Involved == \"Yes\", \n na.rm = TRUE\n)\n```\n:::\n\n\n:::\n\n\nTo create the boxes we will utilize `bslib::value_box()`. For example\n\n\n::: {.cell}\n\n```{.r .cell-code}\nvalue_box(\"Number of Incidents\", n_incidents)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n\n
\n```\n\n:::\n:::\n\n\nThe `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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nvalue_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\n\nLet's create a card for each of these statistics and store them in their own variable. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ninci_card <- value_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n\nfatalities_card <- value_box(\n \"Total Fatalities\",\n n_fatalities,\n showcase = bs_icon(\"heartbreak\")\n)\n\nmedical_card <- value_box(\n \"Involved Medical Transport\",\n n_medical_transit,\n showcase = bs_icon(\"heart-pulse\")\n)\n\ndrugs_card <- value_box(\n \"Involved Drugs or Alcohol\",\n n_alc_drug,\n showcase = bs_icon(\"capsule\")\n)\n```\n:::\n\n\nNext, 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nlayout_columns(\n inci_card, \n fatalities_card,\n medical_card, \n drugs_card\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\nBy 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nstats <- layout_columns(\n inci_card, \n fatalities_card,\n medical_card, \n drugs_card,\n col_widths = 6\n)\n\nstats\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\n## Creating the map\n\nHaving 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.\n\nFirst let's create a vector of [Hot Spot Analysis](https://pro.arcgis.com/en/pro-app/latest/tool-reference/spatial-statistics/h-how-hot-spot-analysis-getis-ord-gi-spatial-stati.htm) result labels called `gi_labels`. \n\n:::{.aside}\nHot Spot Analysis works by calculating a statistic called the Gi* (gee-eye-star).\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# create labels vector to pass to leaflet\ngi_labels <- c(\n \"Not Significant\",\n \"Hot Spot with 90% Confidence\",\n \"Hot Spot with 95% Confidence\",\n \"Hot Spot with 99% Confidence\"\n)\n```\n:::\n\n\nWe'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. \n\nSince we will be using `leaflet` we will also need to use WGS84 coordinate system. We can use `st_transform()` to transform the geometry. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nhexes <- hs_sf |>\n transmute(\n classification = case_when(\n Gi_Bin == 0 ~ gi_labels[1],\n Gi_Bin == 1 ~ gi_labels[2],\n Gi_Bin == 2 ~ gi_labels[3],\n Gi_Bin == 3 ~ gi_labels[4]\n )\n ) |>\n st_transform(4326)\n```\n:::\n\n\nIn 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\npal <- colorFactor(\n palette = c(\"#c6c6c3\", \"#c8976e\", \"#be6448\", \"#af3129\"),\n levels = gi_labels\n)\n```\n:::\n\n\nWith 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.\n\nFirst, 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmap <- leaflet() |>\n addProviderTiles(\"Esri.WorldGrayCanvas\") |>\n addPolygons(\n data = hexes,\n fillColor = ~pal(classification),\n color = \"#c6c6c3\",\n weight = 1,\n fillOpacity = 0.8\n ) |>\n addLegend(\n pal = pal,\n values = gi_labels,\n opacity = 1,\n title = \"Hot Spot Classification\"\n ) |>\n setView(-85.3, 35.04, 12.5)\n\nmap\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n:::\n\n\nTo 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()`.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmap_card <- card(\n card_header(\"Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)\"),\n map\n)\n\nmap_card\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n```\n\n:::\n:::\n\n\n\n## Putting the UI together\n\nCreate an empty page with `bslib::page_fillable()`. We can add all of our elements directly to this page.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\npage_fillable(\n theme = theme_bootswatch(\"darkly\"),\n map_card, stats, plot_tab\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n\n```\n\n:::\n:::\n\n\nBut 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. \n\nWe'll set the `col_widths = 12` so that each component takes the full width. \n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nrhs_col <- layout_columns(\n stats,\n plot_tab,\n col_widths = 12\n)\n\nrhs_col\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\nNow 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ndash_content <- layout_columns(\n map_card,\n rhs_col,\n col_widths = c(8, 4)\n)\n\ndash_content\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n
\n
\n```\n\n:::\n:::\n\n\nNow we can put this in our `page_filable()`\n\n\n::: {.cell}\n\n```{.r .cell-code}\npage_fillable(dash_content)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n\n
\n
\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n
\n
\n\n```\n\n:::\n:::\n\n\n\n## Source code {#source-code}\n\n\n::: {.cell filename='app.R'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(bslib)\nlibrary(dplyr)\nlibrary(arcgis)\nlibrary(plotly)\nlibrary(bsicons)\nlibrary(ggplot2)\nlibrary(leaflet)\n\ntheme_set(theme_minimal())\n\ndata_url <- \"https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer\"\n\n# open the feature server\ncrash_server <- arc_open(data_url)\n\n# fetch individual layers\nincidents <- get_layer(crash_server, 1)\nhotspots <- get_layer(crash_server, 2)\n\n# bring them into memory as sf objects\ninci_sf <- arc_select(incidents)\nhs_sf <- arc_select(hotspots)\n\n# count the number of incidents by year\nannual_counts <- inci_sf |>\n st_drop_geometry() |>\n mutate(year = lubridate::year(Incident_Date)) |>\n group_by(year) |>\n count() |>\n ungroup()\n\n# make annual incidents plot\ngg_annual <- ggplot(annual_counts, aes(year, n)) +\n geom_line() +\n geom_point(size = 3) +\n labs(\n x = \"Year\",\n y = \"Incidents\"\n )\n\n# count incidents by speed\nspeed_counts <- inci_sf |>\n st_drop_geometry() |>\n count(Posted_Speed) |>\n filter(!is.na(Posted_Speed))\n\ngg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +\n geom_col() +\n labs(\n x = \"Posted Speed Limit (miles per hour)\",\n y = \"Incidents\"\n )\n\nplot_tab <- navset_card_tab(\n title = \"Plots\",\n nav_panel(\n \"By year\",\n card_title(\"Vehicle-Pedestrian Incidents by Year\"),\n ggplotly(gg_annual)\n ),\n nav_panel(\n \"By speed\",\n card_title(\"Vehicle Pedestrian Incidents by Posted Speed Limit\"),\n ggplotly(gg_speed)\n )\n)\n\nn_incidents <- count(inci_sf) |>\n pull(n)\n\nn_medical_transit <- inci_sf |>\n count(Involved_Medical_Transport) |>\n filter(Involved_Medical_Transport == \"Yes\") |>\n pull(n)\n\nn_fatalities <- inci_sf |>\n count(Involved_Fatal_Injury) |>\n filter(Involved_Fatal_Injury == \"Yes\") |>\n pull(n)\n\nn_alc_drug <- inci_sf |>\n filter(Drug_Involved == \"Yes\" | Alcohol_Involved == \"Yes\") |>\n count() |>\n pull(n)\n\ninci_card <- value_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n\nfatalities_card <- value_box(\n \"Total Fatalities\",\n n_fatalities,\n showcase = bs_icon(\"heartbreak\")\n)\n\nmedical_card <- value_box(\n \"Involved Medical Transport\",\n n_medical_transit,\n showcase = bs_icon(\"heart-pulse\")\n)\n\ndrugs_card <- value_box(\n \"Involved Drugs or Alcohol\",\n n_alc_drug,\n showcase = bs_icon(\"capsule\")\n)\n\nstats <- layout_columns(\n inci_card,\n fatalities_card,\n medical_card,\n drugs_card,\n col_widths = 6\n)\n\n\nrhs_col <- layout_columns(\n stats,\n plot_tab,\n col_widths = 12\n)\n\n\n# create labels vector to pass to leaflet\ngi_labels <- c(\n \"Not Significant\",\n \"Hot Spot with 90% Confidence\",\n \"Hot Spot with 95% Confidence\",\n \"Hot Spot with 99% Confidence\"\n)\n\nhexes <- hs_sf |>\n transmute(\n classification = case_when(\n Gi_Bin == 0 ~ gi_labels[1],\n Gi_Bin == 1 ~ gi_labels[2],\n Gi_Bin == 2 ~ gi_labels[3],\n Gi_Bin == 3 ~ gi_labels[4]\n )\n ) |>\n st_transform(4326)\n\npal <- colorFactor(\n palette = c(\"#c6c6c3\", \"#c8976e\", \"#be6448\", \"#af3129\"),\n levels = gi_labels\n)\n\nmap <- leaflet() |>\n addProviderTiles(\"Esri.WorldGrayCanvas\") |>\n addPolygons(\n data = hexes,\n fillColor = ~pal(classification),\n color = \"#c6c6c3\",\n weight = 1,\n fillOpacity = 0.8\n ) |>\n addLegend(\n pal = pal,\n values = gi_labels,\n opacity = 1,\n title = \"Hot Spot Classification\"\n ) |>\n setView(-85.3, 35.04, 12.5)\n\nmap_card <- card(\n card_header(\"Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)\"),\n map\n)\n\ndash_content <- layout_columns(\n map_card,\n rhs_col,\n col_widths = c(8, 4)\n)\n\nui <- page_fillable(\n dash_content\n)\n\n# print ui to open the dashboard\nui\n```\n:::", + "markdown": "---\ntitle: \"Dashboard using `{arcgis}`\"\nsubtitle: \"Building an interactive dashboard with ArcGIS hosted data\"\nfreeze: true\nresources: \n - dash/**\n---\n\n\n\n\nIn this tutorial we will be recreating a dashboard that utilizes the data from the [City of Chattanooga Open Data Portal](https://www.chattadata.org/Public-Safety/Pedestrian-Accidents/8piy-9u9f). In the below LinkedIn post by [Charlie Mix](https://www.linkedin.com/in/charlie-mix/), GIS Director at the University of Tennessee at Chattanooga [IGTLab](https://www.utc.edu/interdisciplinary-geospatial-technology-lab), they use this data to create an ArcGIS Dashboard.\n\n\n\n[Original LinkedIn Post](https://www.linkedin.com/posts/charlie-mix_arcgisdashboard-gis-activity-7135693623307767808-sbRW?utm_source=share&utm_medium=member_desktop)\n\nThe data is provided as a [Feature Service](https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer) by Charlie Mix, which we will use to create a lightweight interactive dashboard in R using `{arcgis}` and additional R packages.\n\nThe dashboard that we are going to create can be [viewed live here](./dash/index.html).\n\n## The Packages\n\nThere 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.\n\nIn addition to **arcgis** we will use a number of other packages to make this happen some may be new to you:\n\n- [`sf`](https://r-spatial.github.io/sf/): spatial data manipulation\n- [`bslib`](https://rstudio.github.io/bslib/): create the UI\n- [`dplyr`](https://dplyr.tidyverse.org/): basic data manipulation\n- [`arcgis`](https://r.esri.com/arcgis/): interact with feature services\n- [`plotly`](https://plotly.com/r/): interactive plots\n- [`bsicons`](https://github.com/rstudio/bsicons): icons for our UI\n- [`ggplot2`](https://ggplot2.tidyverse.org/): create plots\n- [`leaflet`](https://rstudio.github.io/leaflet/): create interactive maps\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(bslib)\n```\n\n::: {.cell-output .cell-output-stderr}\n\n```\n#> Warning: package 'bslib' was built under R version 4.3.1\n```\n\n\n:::\n\n```{.r .cell-code}\nlibrary(dplyr)\nlibrary(arcgis)\nlibrary(plotly)\nlibrary(bsicons)\nlibrary(ggplot2)\nlibrary(leaflet)\n```\n:::\n\n\n## Reading data from ArcGIS Online\n\nThe 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ndata_url <- \"https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer\"\n\n# open the feature server\ncrash_server <- arc_open(data_url)\ncrash_server\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> CRS: 32136\n#> Capabilities: Query\n#> 1: Vehicle Pedestrian Incidents (esriGeometryPoint)\n#> 2: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis (esriGeometryPolygon)\n```\n\n\n:::\n:::\n\n\nThe 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`.\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# fetch individual layers\n(incidents <- get_layer(crash_server, 1))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> Name: Vehicle Pedestrian Incidents\n#> Geometry Type: esriGeometryPoint\n#> CRS: 32136\n#> Capabilities: Query\n```\n\n\n:::\n\n```{.r .cell-code}\n(hotspots <- get_layer(crash_server, 2))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> >\n#> Name: Vehicle Pedestrian Incidents OptimizedHotSpotAnalysis\n#> Geometry Type: esriGeometryPolygon\n#> CRS: 32136\n#> Capabilities: Query\n```\n\n\n:::\n:::\n\n\nSince 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. \n\n:::{.callout-tip}\nFor larger datasets, we want to be cautious with how much data we bring into memory and only use what is needed at a time.\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# bring them into memory as sf objects\ninci_sf <- arc_select(incidents)\nhs_sf <- arc_select(hotspots)\n```\n:::\n\n\nLet's preview the data using `dplyr::glimpse()`. \n\n:::{.panel-tabset}\n\n### Hot Spot Analysis\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(hs_sf)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> Rows: 369\n#> Columns: 10\n#> $ OBJECTID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…\n#> $ SOURCE_ID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…\n#> $ JOIN_COUNT 2, 1, 1, 1, 1, 2, 1, 6, 1, 3, 1, 1, 1, 3, 1, 3, 1, 2, 1,…\n#> $ GiZScore -0.40186687, -0.40186687, -0.40186687, -0.61763312, 0.76…\n#> $ GiPValue 0.6877820, 0.6877820, 0.6877820, 0.5368172, 0.4431177, 0…\n#> $ NNeighbors 3, 3, 3, 2, 10, 14, 14, 14, 7, 6, 21, 13, 6, 22, 24, 23,…\n#> $ Gi_Bin 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…\n#> $ Shape__Area 115843.3, 115848.0, 115857.5, 115909.8, 115924.1, 115933…\n#> $ Shape__Length 1266.954, 1266.979, 1267.031, 1267.318, 1267.396, 1267.4…\n#> $ geometry MULTIPOLYGON (((668610.5 95..., MULTIPOLYGO…\n```\n\n\n:::\n:::\n\n\n### Incidents\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(inci_sf)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> Rows: 631\n#> Columns: 32\n#> $ OBJECTID 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,…\n#> $ Incident_Number \"23-008820\", \"22-130607\", \"22-108023\", \"23…\n#> $ Incident_Date 2023-01-25 18:00:00, 2022-12-03 18:02:00,…\n#> $ Time_Num 18.0, 18.0, 17.5, 1.5, 12.5, 20.5, 18.5, 9…\n#> $ Street \"E 11th St\", \"2000 S Kelley St\", \"Dodds Av…\n#> $ Alt_Street NA, NA, NA, NA, NA, \"US-11\", NA, NA, NA, \"…\n#> $ City \"Chattanooga\", \"Chattanooga\", \"Chattanooga…\n#> $ County \"Hamilton\", \"Hamilton\", \"Hamilton\", \"Hamil…\n#> $ Intersection \"Market St\", \"E 23rd Street\", \"E 41st St\",…\n#> $ Mile_Post NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Accident_Type \"Possible Injury\", \"Property Damage Under\"…\n#> $ Collision_Type \"Not Collision with Motor Vehicle in Trans…\n#> $ Hit_and_Run \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Involved_Fatal_Injury \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Involved_Medical_Transport \"No\", \"No\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"N…\n#> $ Involved_Placarded_Truck \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Posted_Speed 25, 20, 40, 30, 45, 45, 15, NA, 35, 45, 40…\n#> $ Total_Vehicles_Involved 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …\n#> $ Weather_Code \"Clear\", \"Clear\", \"Clear\", \"Clear\", \"Clear…\n#> $ Pedestrian_Involved \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", \"Yes\", …\n#> $ Bicycle_Involved \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", \"No\", …\n#> $ Drug_Involved NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Alcohol_Involved NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…\n#> $ Light_Condition \"Dark - Lighted\", \"Dark - Lighted\", \"Dayli…\n#> $ Driver_One_Safety_Equipment \"Unknown\", \"Unknown\", \"Unknown\", \"Unknown\"…\n#> $ Driver_One_Zip \"37411\", \"37403\", \"37421\", \"37421\", \"37404…\n#> $ Driver_Two_Safety_Equipment \"Shoulder and Lap Belt Used\", \"Shoulder an…\n#> $ Driver_Two_Zip \"30755\", \"37406\", \"37407\", \"37341\", \"32148…\n#> $ Latitude 35.04283, 35.01957, 34.99520, 35.08057, 35…\n#> $ Longitude -85.31865, -85.27885, -85.28440, -85.26217…\n#> $ Location_WKT \"POINT (-85.318653 35.0428324)\", \"POINT (-…\n#> $ geometry POINT (662169.1 78935.9), POINT (665…\n```\n\n\n:::\n:::\n\n\n:::\n\n## Creating the plots\n\nNext, 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.\n\nBefore we can make the plots, we need to calculate the annual counts and store them in their own `data.frame`.\n\nHere 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\n# set the theme that we will use\ntheme_set(theme_minimal())\n\nannual_counts <- inci_sf |>\n st_drop_geometry() |>\n mutate(year = lubridate::year(Incident_Date)) |>\n count(year)\n\nannual_counts\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> year n\n#> 1 2018 91\n#> 2 2019 98\n#> 3 2020 85\n#> 4 2021 116\n#> 5 2022 129\n#> 6 2023 112\n```\n\n\n:::\n:::\n\n\n:::{.aside}\nWe 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. \n:::\n\nFrom this we can create a basic line plot using `ggplot()`. \n\n:::{.callout-note}\nIf you are unfamiliar with the basics of ggplot2 and dplyr, consider starting with [R for Data Science](https://r4ds.had.co.nz/data-visualisation.html)\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\ngg_annual <- ggplot(annual_counts, aes(year, n)) +\n geom_line() +\n geom_point(size = 3) +\n labs(\n x = \"Year\",\n y = \"Incidents\"\n )\n```\n:::\n\n\nWe'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. \n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nspeed_counts <- inci_sf |>\n st_drop_geometry() |>\n count(Posted_Speed) |>\n filter(!is.na(Posted_Speed))\n\ngg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +\n geom_col() +\n labs(\n x = \"Posted Speed Limit (miles per hour)\",\n y = \"Incidents\"\n )\n\ngg_annual\n```\n\n::: {.cell-output-display}\n![](index_files/figure-html/unnamed-chunk-10-1.png){width=672}\n:::\n\n```{.r .cell-code}\ngg_speed\n```\n\n::: {.cell-output-display}\n![](index_files/figure-html/unnamed-chunk-10-2.png){width=672}\n:::\n:::\n\n\nAchieving interactivity is a breeze with the function `plotly::ggplotly()`.\n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nggplotly(gg_annual)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n\n```{.r .cell-code}\nggplotly(gg_speed)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n:::\n\n\n\n### Plots UI components \n\nNow that we have defined our interactive plots, we can begin to create our first dashboard component with `**bslib**`. \n\nbslib 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nnavset_card_tab(\n title = \"Plots\",\n nav_panel(\n title = \"By year\"\n ),\n nav_panel(\n title = \"By speed\"\n )\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\nPlots\n\n
\n
\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\nNext, 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nplot_tab <- navset_card_tab(\n title = \"Plots\",\n nav_panel(\n \"By year\",\n card_title(\"Vehicle-Pedestrian Incidents by Year\"),\n ggplotly(gg_annual)\n ),\n nav_panel(\n \"By speed\",\n card_title(\"Vehicle Pedestrian Incidents by Posted Speed Limit\"),\n ggplotly(gg_speed)\n )\n)\n\nplot_tab\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\n\n## Statistic value boxes\n\nNext, 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\n:::{.panel-tabset}\n\n### dplyr\n\n\n::: {.cell}\n\n```{.r .cell-code}\nn_incidents <- count(inci_sf) |> \n pull(n)\n\nn_medical_transit <- inci_sf |> \n count(Involved_Medical_Transport) |> \n filter(Involved_Medical_Transport == \"Yes\") |> \n pull(n)\n\nn_fatalities <- inci_sf |> \n count(Involved_Fatal_Injury) |> \n filter(Involved_Fatal_Injury == \"Yes\") |> \n pull(n)\n\nn_alc_drug <- inci_sf |> \n filter(Drug_Involved == \"Yes\" | Alcohol_Involved == \"Yes\") |> \n count() |> \n pull(n)\n```\n:::\n\n\n### Base R\n\n\n::: {.cell}\n\n```{.r .cell-code}\nn_incidents <- nrow(inci_sf)\n\nn_medical_transit <- table(inci_sf$Involved_Medical_Transport)[\"Yes\"]\n\nn_fatalities <- table(inci_sf$Involved_Fatal_Injury)[[\"Yes\"]]\n\nn_alc_drug <- sum(\n inci_sf$Drug_Involved == \"Yes\" | inci_sf$Alcohol_Involved == \"Yes\", \n na.rm = TRUE\n)\n```\n:::\n\n\n:::\n\n\nTo create the boxes we will utilize `bslib::value_box()`. For example\n\n\n::: {.cell}\n\n```{.r .cell-code}\nvalue_box(\"Number of Incidents\", n_incidents)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n\n
\n```\n\n:::\n:::\n\n\nThe `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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nvalue_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n```\n\n:::\n:::\n\n\nLet's create a card for each of these statistics and store them in their own variable. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ninci_card <- value_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n\nfatalities_card <- value_box(\n \"Total Fatalities\",\n n_fatalities,\n showcase = bs_icon(\"heartbreak\")\n)\n\nmedical_card <- value_box(\n \"Involved Medical Transport\",\n n_medical_transit,\n showcase = bs_icon(\"heart-pulse\")\n)\n\ndrugs_card <- value_box(\n \"Involved Drugs or Alcohol\",\n n_alc_drug,\n showcase = bs_icon(\"capsule\")\n)\n```\n:::\n\n\nNext, 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nlayout_columns(\n inci_card, \n fatalities_card,\n medical_card, \n drugs_card\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\nBy 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nstats <- layout_columns(\n inci_card, \n fatalities_card,\n medical_card, \n drugs_card,\n col_widths = 6\n)\n\nstats\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\n## Creating the map\n\nHaving 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.\n\nFirst let's create a vector of [Hot Spot Analysis](https://pro.arcgis.com/en/pro-app/latest/tool-reference/spatial-statistics/h-how-hot-spot-analysis-getis-ord-gi-spatial-stati.htm) result labels called `gi_labels`. \n\n:::{.aside}\nHot Spot Analysis works by calculating a statistic called the Gi* (gee-eye-star).\n:::\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# create labels vector to pass to leaflet\ngi_labels <- c(\n \"Not Significant\",\n \"Hot Spot with 90% Confidence\",\n \"Hot Spot with 95% Confidence\",\n \"Hot Spot with 99% Confidence\"\n)\n```\n:::\n\n\nWe'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. \n\nSince we will be using `leaflet` we will also need to use WGS84 coordinate system. We can use `st_transform()` to transform the geometry. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nhexes <- hs_sf |>\n transmute(\n classification = case_when(\n Gi_Bin == 0 ~ gi_labels[1],\n Gi_Bin == 1 ~ gi_labels[2],\n Gi_Bin == 2 ~ gi_labels[3],\n Gi_Bin == 3 ~ gi_labels[4]\n )\n ) |>\n st_transform(4326)\n```\n:::\n\n\nIn 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\npal <- colorFactor(\n palette = c(\"#c6c6c3\", \"#c8976e\", \"#be6448\", \"#af3129\"),\n levels = gi_labels\n)\n```\n:::\n\n\nWith 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.\n\nFirst, 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.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmap <- leaflet() |>\n addProviderTiles(\"Esri.WorldGrayCanvas\") |>\n addPolygons(\n data = hexes,\n fillColor = ~pal(classification),\n color = \"#c6c6c3\",\n weight = 1,\n fillOpacity = 0.8\n ) |>\n addLegend(\n pal = pal,\n values = gi_labels,\n opacity = 1,\n title = \"Hot Spot Classification\"\n ) |>\n setView(-85.3, 35.04, 12.5)\n\nmap\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n\n```\n\n:::\n:::\n\n\nTo 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()`.\n\n\n::: {.cell}\n\n```{.r .cell-code}\nmap_card <- card(\n card_header(\"Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)\"),\n map\n)\n\nmap_card\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n```\n\n:::\n:::\n\n\n\n## Putting the UI together\n\nCreate an empty page with `bslib::page_fillable()`. We can add all of our elements directly to this page.\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\npage_fillable(\n theme = theme_bootswatch(\"darkly\"),\n map_card, stats, plot_tab\n)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n\n```\n\n:::\n:::\n\n\nBut 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. \n\nWe'll set the `col_widths = 12` so that each component takes the full width. \n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nrhs_col <- layout_columns(\n stats,\n plot_tab,\n col_widths = 12\n)\n\nrhs_col\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n```\n\n:::\n:::\n\n\nNow 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. \n\n\n::: {.cell}\n\n```{.r .cell-code}\ndash_content <- layout_columns(\n map_card,\n rhs_col,\n col_widths = c(8, 4)\n)\n\ndash_content\n```\n\n::: {.cell-output-display}\n\n```{=html}\n
\n
\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n
\n
\n```\n\n:::\n:::\n\n\nNow we can put this in our `page_filable()`\n\n\n::: {.cell}\n\n```{.r .cell-code}\npage_fillable(dash_content)\n```\n\n::: {.cell-output-display}\n\n```{=html}\n\n
\n
\n
\n
Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)
\n
\n
\n\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Number of Incidents

\n

631

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Total Fatalities

\n

40

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Medical Transport

\n

381

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\n
\n

Involved Drugs or Alcohol

\n

36

\n
\n
\n
\n\n
\n
\n
\n
\n
\n
\n
\nPlots\n\n
\n
\n
\n
\n
Vehicle-Pedestrian Incidents by Year
\n
\n\n
\n
\n
\n
\n
Vehicle Pedestrian Incidents by Posted Speed Limit
\n
\n\n
\n
\n
\n\n
\n
\n
\n
\n
\n\n```\n\n:::\n:::\n\n\n\n## Source code {#source-code}\n\n\n::: {.cell filename='app.R'}\n\n```{.r .cell-code}\nlibrary(sf)\nlibrary(bslib)\nlibrary(dplyr)\nlibrary(arcgis)\nlibrary(plotly)\nlibrary(bsicons)\nlibrary(ggplot2)\nlibrary(leaflet)\n\ntheme_set(theme_minimal())\n\ndata_url <- \"https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer\"\n\n# open the feature server\ncrash_server <- arc_open(data_url)\n\n# fetch individual layers\nincidents <- get_layer(crash_server, 1)\nhotspots <- get_layer(crash_server, 2)\n\n# bring them into memory as sf objects\ninci_sf <- arc_select(incidents)\nhs_sf <- arc_select(hotspots)\n\n# count the number of incidents by year\nannual_counts <- inci_sf |>\n st_drop_geometry() |>\n mutate(year = lubridate::year(Incident_Date)) |>\n group_by(year) |>\n count() |>\n ungroup()\n\n# make annual incidents plot\ngg_annual <- ggplot(annual_counts, aes(year, n)) +\n geom_line() +\n geom_point(size = 3) +\n labs(\n x = \"Year\",\n y = \"Incidents\"\n )\n\n# count incidents by speed\nspeed_counts <- inci_sf |>\n st_drop_geometry() |>\n count(Posted_Speed) |>\n filter(!is.na(Posted_Speed))\n\ngg_speed <- ggplot(speed_counts, aes(Posted_Speed, n)) +\n geom_col() +\n labs(\n x = \"Posted Speed Limit (miles per hour)\",\n y = \"Incidents\"\n )\n\nplot_tab <- navset_card_tab(\n title = \"Plots\",\n nav_panel(\n \"By year\",\n card_title(\"Vehicle-Pedestrian Incidents by Year\"),\n ggplotly(gg_annual)\n ),\n nav_panel(\n \"By speed\",\n card_title(\"Vehicle Pedestrian Incidents by Posted Speed Limit\"),\n ggplotly(gg_speed)\n )\n)\n\nn_incidents <- count(inci_sf) |>\n pull(n)\n\nn_medical_transit <- inci_sf |>\n count(Involved_Medical_Transport) |>\n filter(Involved_Medical_Transport == \"Yes\") |>\n pull(n)\n\nn_fatalities <- inci_sf |>\n count(Involved_Fatal_Injury) |>\n filter(Involved_Fatal_Injury == \"Yes\") |>\n pull(n)\n\nn_alc_drug <- inci_sf |>\n filter(Drug_Involved == \"Yes\" | Alcohol_Involved == \"Yes\") |>\n count() |>\n pull(n)\n\ninci_card <- value_box(\n \"Number of Incidents\",\n n_incidents,\n showcase = bs_icon(\"person\")\n)\n\nfatalities_card <- value_box(\n \"Total Fatalities\",\n n_fatalities,\n showcase = bs_icon(\"heartbreak\")\n)\n\nmedical_card <- value_box(\n \"Involved Medical Transport\",\n n_medical_transit,\n showcase = bs_icon(\"heart-pulse\")\n)\n\ndrugs_card <- value_box(\n \"Involved Drugs or Alcohol\",\n n_alc_drug,\n showcase = bs_icon(\"capsule\")\n)\n\nstats <- layout_columns(\n inci_card,\n fatalities_card,\n medical_card,\n drugs_card,\n col_widths = 6\n)\n\n\nrhs_col <- layout_columns(\n stats,\n plot_tab,\n col_widths = 12\n)\n\n\n# create labels vector to pass to leaflet\ngi_labels <- c(\n \"Not Significant\",\n \"Hot Spot with 90% Confidence\",\n \"Hot Spot with 95% Confidence\",\n \"Hot Spot with 99% Confidence\"\n)\n\nhexes <- hs_sf |>\n transmute(\n classification = case_when(\n Gi_Bin == 0 ~ gi_labels[1],\n Gi_Bin == 1 ~ gi_labels[2],\n Gi_Bin == 2 ~ gi_labels[3],\n Gi_Bin == 3 ~ gi_labels[4]\n )\n ) |>\n st_transform(4326)\n\npal <- colorFactor(\n palette = c(\"#c6c6c3\", \"#c8976e\", \"#be6448\", \"#af3129\"),\n levels = gi_labels\n)\n\nmap <- leaflet() |>\n addProviderTiles(\"Esri.WorldGrayCanvas\") |>\n addPolygons(\n data = hexes,\n fillColor = ~pal(classification),\n color = \"#c6c6c3\",\n weight = 1,\n fillOpacity = 0.8\n ) |>\n addLegend(\n pal = pal,\n values = gi_labels,\n opacity = 1,\n title = \"Hot Spot Classification\"\n ) |>\n setView(-85.3, 35.04, 12.5)\n\nmap_card <- card(\n card_header(\"Vehicle-Pedestrian Incidents for Chattanooga, TN (2018-2023)\"),\n map\n)\n\ndash_content <- layout_columns(\n map_card,\n rhs_col,\n col_widths = c(8, 4)\n)\n\nui <- page_fillable(\n dash_content\n)\n\n# print ui to open the dashboard\nui\n```\n:::", "supporting": [ "index_files" ], diff --git a/location-services/tutorials/shiny-dash/index.qmd b/location-services/tutorials/shiny-dash/index.qmd index 31d3dfd..cd7162f 100644 --- a/location-services/tutorials/shiny-dash/index.qmd +++ b/location-services/tutorials/shiny-dash/index.qmd @@ -9,7 +9,7 @@ resources: knitr::opts_chunk$set(comment = "#>", message = FALSE) ``` -In this tutorial we will be recreating a dashboard that utilizes the data from the [City of Chattanooga Open Data Portal](https://www.chattadata.org/Public-Safety/Pedestrian-Accidents/8piy-9u9f). In the below LinkedIn post by [Charlie Mix](https://www.linkedin.com/in/charlie-mix/), they use this data to create an ArcGIS Dashboard. +In this tutorial we will be recreating a dashboard that utilizes the data from the [City of Chattanooga Open Data Portal](https://www.chattadata.org/Public-Safety/Pedestrian-Accidents/8piy-9u9f). In the below LinkedIn post by [Charlie Mix](https://www.linkedin.com/in/charlie-mix/), GIS Director at the University of Tennessee at Chattanooga [IGTLab](https://www.utc.edu/interdisciplinary-geospatial-technology-lab), they use this data to create an ArcGIS Dashboard.