diff --git a/.github/workflows/quarto-publish.yml b/.github/workflows/quarto-publish.yml index 4648f0d..fe0f3b4 100644 --- a/.github/workflows/quarto-publish.yml +++ b/.github/workflows/quarto-publish.yml @@ -25,14 +25,7 @@ jobs: # uses: actions/setup-python@v3 # From https://github.com/r-lib/actions/tree/v2-branch/setup-r - - name: Set up R - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - name: Set up R dependencies - uses: r-lib/actions/setup-r-dependencies@v2 - - # - name: Setup R + # - name: Set up R # uses: r-lib/actions/setup-r@v2 # with: # use-public-rspm: true 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 2aa7556..cc27efd 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": "83cabd8a26a1d96cae38ad53b17bbac9", + "hash": "656bce64dc809f5e102ef144c5415d5f", "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", + "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" diff --git a/location-services/tutorials/shiny-dash/index.qmd b/location-services/tutorials/shiny-dash/index.qmd index 77c9c45..76c7bc8 100644 --- a/location-services/tutorials/shiny-dash/index.qmd +++ b/location-services/tutorials/shiny-dash/index.qmd @@ -3,7 +3,7 @@ title: "WIP: Shiny App" subtitle: "Building a shiny dashboard" freeze: true resources: - - ./html/lib + - html/lib --- This dashboard is live [here](./html/index.html)