-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
a58ff21
commit 401b732
Showing
3 changed files
with
21 additions
and
6 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
15 changes: 15 additions & 0 deletions
15
_freeze/location-services/tutorials/shiny-dash/index/execute-results/html.json
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
{ | ||
"hash": "83cabd8a26a1d96cae38ad53b17bbac9", | ||
"result": { | ||
"engine": "knitr", | ||
"markdown": "---\ntitle: \"WIP: Shiny App\"\nsubtitle: \"Building a shiny dashboard\"\nfreeze: true\nresources: \n - ./html/lib\n---\n\n\nThis dashboard is live [here](./html/index.html)\n\nCreating a dashboard https://igtlab.maps.arcgis.com/apps/dashboards/4447ff31b260499a84272c63c9b6da05\n\nWe will create a lightweight dashboard in R using `{bslib}`. The data will be static and the interactivity minimal.\n\nThere are 4 components to this dashboard that we will want to recreate. These are the two plots, the statistics, and the map. \n\n## The Packages\n\nWe're going to use 9 packages to make this happen.\n\n::: {.cell}\n\n```{.r .cell-code}\nknitr::opts_chunk$set(eval = FALSE)\n```\n:::\n\n::: {.cell}\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```\n:::\n\n\n\n## Reading data from ArcGIS Online\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# open the feature server\ncrash_server <- arc_open(\"https://services.arcgis.com/UnTXoPXBYERF0OH6/arcgis/rest/services/Vehicle_Pedestrian_Incidents/FeatureServer\")\n\ncrash_server\n\n# fetch individual layers\n(incidents <- get_layer(crash_server, 1))\n(hotspots <- get_layer(crash_server, 2))\n\n\n# bring them into memory as sf objects\ninci_sf <- arc_select(incidents)\nhs_sf <- arc_select(hotspots)\n```\n:::\n\n\n:::{.panel-tabset}\n\n### Hot Spot Analysis\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(hs_sf)\n```\n:::\n\n\n### Incidents\n\n\n::: {.cell}\n\n```{.r .cell-code}\nglimpse(inci_sf)\n```\n:::\n\n\n:::\n\n## Creating the plots\n\n- use a combination of ggplot2 and plotly\n- ggplot2 creates the static plot\n- plotly makes it interactive\n\n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nannual_counts <- inci_sf |>\n st_drop_geometry() |>\n mutate(year = lubridate::year(Incident_Date)) |>\n group_by(year) |>\n count() |>\n ungroup()\n\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\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\ngg_speed\n```\n:::\n\n\nMake them interactive with plotly\n\n\n::: {.cell layout-ncol=\"2\"}\n\n```{.r .cell-code}\nggplotly(gg_annual)\nggplotly(gg_speed)\n```\n:::\n\n\n\nWe will add these plotly widget directly into our dashboard as a tabset\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\n\n\n## Statistic value boxes\n\nWe want to calculate the statistics and present them in a value box. These are fairly simple statistics that we can calculate from the\n\n:::{.panel-tabset}\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### 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:::\n\n\nWe can pass these into `bslib::value_box()` to create nice looking cards. \n\n\n::: {.cell}\n\n```{.r .cell-code}\nvalue_box(\"Number of Incidents\", n_incidents)\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 pizazz. \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\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\nLet's build out a component of our dashboard using these cards. We'll create a grid of these 4 using `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\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\n\n## Creating the map\n\n\n::: {.cell}\n\n```{.r .cell-code}\nhexes <- hs_sf |>\n transmute(\n classification = case_when(\n Gi_Bin == 0 ~ \"Not Significant\",\n Gi_Bin == 1 ~ \"Hot Spot with 90% Confidence\",\n Gi_Bin == 2 ~ \"Hot Spot with 95% Confidence\",\n Gi_Bin == 3 ~ \"Hot Spot with 99% Confidence\"\n )\n ) |>\n st_transform(4326)\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\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\n```\n:::\n\nLet's put this map in a `bslib::card()` component with a proper title as well. We'll ad a title to the card 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\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::: {.cell}\n\n```{.r .cell-code}\npage_fillable(\n theme = theme_bootswatch(\"darkly\"),\n map_card, stats, plot_tab\n)\n```\n:::\n\nBut they are all squished together and it isnt 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. \nWe'll set the `col_widths = 12` so that each component takes the full width. \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\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\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", | ||
"supporting": [], | ||
"filters": [ | ||
"rmarkdown/pagebreak.lua" | ||
], | ||
"includes": {}, | ||
"engineDependencies": {}, | ||
"preserve": {}, | ||
"postProcess": true | ||
} | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters