In Metropolitan-Council/planting.shade: Tree planting and preservation prioritization tool
library(dplyr)
library(stringr)
library(ggplot2)
library(tidyr)
# library(tidyverse)
# library(leaflet)
# library(mapview)
# knitr::opts_knit$set(eval.after = "fig.cap")
knitr::opts_chunk$set(echo = TRUE, fig.align="center")
# knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, tidy.opts=list(width.cutoff=50))
# output:
# html_document:
# toc: true
# toc_depth: 3
# # css: "inst/app/www/style.css"
# code_folding: show
params$priority_score #scaled and centered average based on inputs
params$priority_rank #rank of scaled and centered average based on inputs
# rank_total #number of tracts total
reportfor <- if (params$selected_geo == "City (MetCouncil region only)") {
params$selected_city
} else if (params$selected_geo == "Selected tract") {
paste0("tract ", params$selected_tract)
} else if (params$selected_geo == "County (within MN or WI)") {
"Prank! nothing here yet"
}
scaled_summed <- if(params$selected_geo == "Selected tract") {
params$priority_score %>%
filter(tract_string == params$selected_tract)
} else if (params$selected_geo == "City (MetCouncil region only)"){
params$priority_score %>% filter(tract_string == "27037060716")
}
fheight = if (nrow(params$vars_selected) < 3) {
3
} else {nrow(params$vars_selected)*.9}
eabcount<- if(params$selected_geo == "Selected tract") {
eab %>%
sf::st_intersection(filter(mn_tracts, #crop_tract_ctus,
GEOID == params$selected_tract)) %>%
nrow()} else if (params$selected_geo == "City (MetCouncil region only)") {
eab %>%
sf::st_intersection(filter(mn_tracts, #crop_tract_ctus,
GEOID == "27037060716")) %>%
nrow()
}
canopycover <- if(params$selected_geo == "Selected tract") {
params$canopy %>%
filter(tract_string == params$selected_tract)
} else if (params$selected_geo == "City (MetCouncil region only)") {
params$canopy %>%
filter(tract_string == "27037060716")}
Report for r reportfor
#, fig.cap = "\\label{fig:map}The geographic location of the selected area. The selected area is highlighed in green."
if(params$selected_geo == "Selected tract") {
metc_region %>% ggplot() + geom_sf(fill = NA, color = "grey80") +
geom_sf(data = filter(mn_tracts, GEOID == params$selected_tract), color = councilR::colors$cdGreen, fill = councilR::colors$cdGreen) +
theme_void()
} else if (params$selected_geo == "City (MetCouncil region only)") {
metc_region %>% ggplot() + geom_sf(fill = NA, color = "grey80") +
geom_sf(data = filter(mn_tracts, GEOID == "27037060716"), color = councilR::colors$cdGreen, fill = councilR::colors$cdGreen) +
theme_void()}
This report was generated from the Growing Shade interactive tool produced by the Metropolitan Council in collaboration with The Nature Conservancy and Tree Trust. Trees provide critical ecosystem services and are important components of the human, natural and built environments. Enhancing and maintaining tree canopy cover is an actionable step to create healthy places for people to live and a resilient future.
This report synthesizes and summarizes data about trees, people, and the built environments. Understanding the tree canopy within this larger context is important for prioritization and planning efforts. Please review "what's next for Growing Shade" or contact us at SOME EMAIL HERE if this report does not address your data needs - we welcome the feedback and may be able to accommodate requests.
Status of the tree canopy
This section summarizes the how the tree canopy priority of the selected region compares to other geographies across the region.
r reportfor has an existing tree coverage of approximately r round(canopycover$raw_value, 1)*100%. The distribution of tree canopy across tracts is shown below, with the selected tract highlighted in green. In most areas in our region, a tree canopy coverage of 40% (as detected by our methods) leads to the greatest benefits. Some areas in our region are dominated by native tallgrass prairie which has lower tree coverage - this should not be penalized.
If you wish to obtain a map of the tree canopy within the selected area, please use the interactive tool - just zoom in as desired and take a screenshot (instructions for Windows or instructions for Mac).
```rThe distribution of tree canopy coverage across tracts. The selected tract in highlighed in green. We provide two ways of looking at the distribution of tree capony coverage. On the bottom is a box plot, where each grey circle represents one geographic area. The line in the middle of the box shows the median value: half of the geographic areas fall below the median, and half of them lie above the median. The median is also known as the 50th percentile. The top and bottom edges of the box show the 75th percentile and the 25th percentile. On top is a density plot. The more geographic areas there are at a particular value, the taller this plot gets."}
canopyplot<-eva_data_main %>% filter(variable %in% c("canopy_percent")) %>%
select(tract_string, variable, raw_value) %>%
pivot_wider(names_from = variable, values_from = raw_value)
canopyhist <- if(params$selected_geo == "Selected tract") {
ggplot()+
#distribution
ggdist::stat_halfeye(
data = canopyplot, aes(x = canopy_percent, y = 1),
adjust = .5, width = .6, .width = 0, justification = -.3,
point_colour = NA) +
geom_boxplot(data = canopyplot, aes(x = canopy_percent, y = 1),
width = .25, outlier.shape = NA) +
councilR::council_theme() +
theme(panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank(),
axis.text.y = element_blank())+
geom_point(size = 1.3,alpha = .3,
position = position_jitter(seed = 1, width = 0, height = .1),
col = "grey40",
aes(x = canopy_percent, y = 1),
data = filter(canopyplot, tract_string != params$selected_tract)) +
labs(y = "", x = "Tree canopy cover (%)") +
scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
geom_point(aes(x = canopy_percent, y = 1), fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(canopyplot, tract_string == params$selected_tract))
} else if (params$selected_geo == "City (MetCouncil region only)") {
ggplot()+
#distribution
ggdist::stat_halfeye(
data = canopyplot, aes(x = canopy_percent, y = 1),
adjust = .5, width = .6, .width = 0, justification = -.3,
point_colour = NA) +
geom_boxplot(data = canopyplot, aes(x = canopy_percent, y = 1),
width = .25, outlier.shape = NA) +
councilR::council_theme() +
theme(panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank(),
axis.text.y = element_blank())+
geom_point(size = 1.3,alpha = .3,
position = position_jitter(seed = 1, width = 0, height = .1),
col = "grey40",
aes(x = canopy_percent, y = 1),
data = filter(canopyplot, tract_string != "27037060716")) +
labs(y = "", x = "Tree canopy cover (%)") +
scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
geom_point(aes(x = canopy_percent, y = 1), fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(canopyplot, tract_string == "27037060716"))
}
canopyhist
```r
# We have chosen not to print an overview map in this space, because the time needed to generate the map adds considerably to the processing time of this report. Please note higher resolution images (and images with different underlying basemaps) can be obtained from the interactive tool - just zoom in to the desired level and take a screenshot. We recommend turning off the priority scores and using the "aerial imagery with roads" basemap.
# map_path <- paste0(tempdir(), "/map.png")
#
# mapshot(
# leaflet() %>%
# addMapPane(name = "Aerial Imagery", zIndex = 100) %>%
# addMapPane(name = "Aerial Imagery with roads", zIndex = 100) %>%
# addMapPane(name = "Road outlines", zIndex = 151) %>%
# addProviderTiles("Stamen.TonerLines",
# options = pathOptions(pane = "Road outlines"),
# group = "Aerial Imagery with roads") %>%
# addProviderTiles("Stamen.TonerLabels",
# options = c(zIndex = 600),# pathOptions(pane = "Stamen Toner"),
# group = "Aerial Imagery with roads") %>%
# addProviderTiles(
# provider = providers$Esri.WorldImagery,
# group = "Aerial Imagery with roads",
# options = pathOptions(pane = "Aerial Imagery")
# ) %>%
# addRasterImage(trees %>%
# raster::crop(filter(mn_tracts,#crop_tract_ctus,
# # GEOID == "27053109100")),
# GEOID == params$selected_tract)),
# colors = "#238b45", #pal,
# opacity = .8,
# layerId = "Trees",
# group = "Trees"#,
# # project = FALSE)
# ) %>%
# addPolygons(data = filter(mn_tracts,
# GEOID == params$selected_tract),
# # GEOID == "27053109100"),
# fill = NA,
# opacity = 1,
# color = councilR::colors$councilBlue) %>%
# addLayersControl(
# position = "bottomright",
# baseGroups = c(
# "Aerial Imagery with roads"
# ),
# overlayGroups = c(
# "Trees"),
# options = layersControlOptions(collapsed = TRUE)
# ),
# file = map_path, cliprect = "viewport")
#
# knitr::include_graphics(map_path)
\newpage
Priortization summary
Based on the r params$vars_used preset used, the selected area ranks r scaled_summed$RANK out of r params$rank_total (where a higher rank indicates a higher priority area) with an average priority score of r round(scaled_summed$MEAN, 2) (out of 10, with 10 indicating the highest priority).
The specific variables which went into this ranking include :
selectedvariables <- if (params$vars_used == "Custom") {
params$vars_selected$value
} else if (params$vars_used == "Environmental justice") {
c(metadata[metadata$ej == 1, ])$name
} else if (params$vars_used == "Public health") {
c(metadata[metadata$ph == 1, ])$name
} else if (params$vars_used == "Climate change") {
c(metadata[metadata$cc == 1, ])$name
} else if (params$vars_used == "Conservation") {
c(metadata[metadata$cons == 1, ])$name
}
row_count <- nrow(params$vars_selected)
if(!is.null(row_count)){
# write a function to create a list from the vector
vectorBulletList <- function(vector) {
if(length(vector > 1)) {
paste0("<ul><li>",
paste0(
paste0(vector, collpase = ""), collapse = "</li><li>"),
"</li></ul>")
}
}
}
HTML(paste0("<code>",vectorBulletList(selectedvariables), "</code>"))
Here is how the selected area compares to the regional average for the selected variables. The plot shows the scaled and standardized scores on the x-axis. The table shows the raw values. Please refer to the Methods tab for more detail. Please go to the Appendix section of this report for more information on all the variables.
```rA comparison of the selected area to regional averages with respect to the variables selected for this report. The value(s) of the selected geography are shown in green, while the regional averages are shown in blue."}
testdf <- eva_data_main %>%
full_join(metadata)#%>% filter(variable == "prim_flood")
testtr <- if(params$selected_geo == "Selected tract") {
params$selected_tract
} else if (params$selected_geo == "City (MetCouncil region only)") {
"27037060716"}
summary_table <- filter(testdf, tract_string == testtr) %>%
mutate(overall_rank = as.factor(overall_rank)) %>%
mutate(across(c(raw_value, MEANRAW), ~ifelse(str_detect(name, "%"), . * 100, .))) %>%
mutate(across(where(is.numeric), round, 2))
# if (params$vars_used == "Custom"){
summary_table %>%
ungroup() %>%
select(name, MEANSCALED, weights_scaled) %>%
filter(name %in% selectedvariables) %>%
pivot_longer(names_to = "TYPE", values_to = "VALUES", -name) %>%
mutate(TYPE = case_when(TYPE == "MEANSCALED" ~ "Regional average",
TYPE == "weights_scaled" ~ "Selected area")) %>%
ggplot(aes(y = name, x= VALUES, fill= TYPE)) +
geom_bar(stat = "identity", position = position_dodge(width = .5), width = .5, size = .75) +
# facet_grid(PRESETVAR ~., space = "free_y", scales = "free_y") +
councilR::council_theme() +
scale_y_discrete(labels = function(x) str_wrap(x, width = 40))+
xlim(0, 10)+
scale_fill_manual(values = c(councilR::colors$councilBlue, councilR::colors$cdGreen),
name = "Geography") +
# scale_color_manual(values = c(councilR::colors$mtsRed, "white")) +
labs(y = "", x = "Score (out of 10)") +
theme(panel.border = element_rect(colour = "black", fill = NA),
# axis.text.y = element_text(size = 12),
# axis.title.x = element_text(size = 12)
strip.text = element_text(size = 12),
panel.grid.major.x = element_blank()#,
# legend.position = "bottom"
)
# }
```rA table comparing of the selected area to regional averages with respect to the variables selected for this report."}
kableExtra::kbl(summary_table %>%
ungroup() %>%
select(name, raw_value, MEANRAW, overall_rank, n) %>%
filter(name %in% selectedvariables) %>%
rename(Variable = name,
`Selected area` = raw_value,
`Regional average` = MEANRAW,
`Ranking` = overall_rank,
`Total ranked areas` = n),
booktabs = TRUE) %>%
kableExtra::kable_styling(#latex_options = "striped",
full_width = FALSE) %>%
kableExtra::column_spec(1, width = "20em") %>%
kableExtra::column_spec(2, width = "5em") %>%
kableExtra::column_spec(3, width = "5em") %>%
kableExtra::column_spec(4, width = "5em") %>%
kableExtra::column_spec(5, width = "5em")
\newpage
Equity analysis
The goal of this section is to show how people and trees interact, and where the selected geography compares.
Research shows that trees are unevenly distributed across communities. In particular, neighborhoods with high BIPOC or low-income populations have less tree canopy (MacDonald 2021) than areas which were historically redlined (NPR news story, Locke et al. 2021, Namin et al. 2020). Addressing inequity in tree canopy cover may reduce heat-related deaths by up to 25% (Sinha 2021).
At the MetCouncil, we have shown that areas where the median income is <100,000 and areas with high BIPOC populations have less tree canopy and greenness. We are specifically calling out these variables in figures here. The selected tract is in green, and the regional trend is in blue. This relationship is falling apart a bit at the TRACT level. Ideally, it would be good to get down to the block group level, for everything in this report and in the tool
```rA figure showing how canopy coverage is related to race (A) and income (B). The selected area is shown in green and all other tracts are shown in grey. The regional trend line is blue."}
equityplot<-eva_data_main %>% filter(variable %in% c("pbipoc", "canopy_percent", "ndvi", "mdhhincnow")) %>%
select(tract_string, variable, raw_value) %>%
pivot_wider(names_from = variable, values_from = raw_value)
race_equity <- if(params$selected_geo == "Selected tract") {
equityplot%>%
ggplot(aes(x = pbipoc, y = canopy_percent)) +
geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != params$selected_tract)) +
geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue, data = equityplot) +
geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == params$selected_tract)) +
councilR::council_theme() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x = "Tract people of color population\n(%)", y = "Canopy coverage in tract\n(%)")
} else if (params$selected_geo == "City (MetCouncil region only)") {
equityplot%>%
ggplot(aes(x = pbipoc, y = canopy_percent)) +
geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != "27037060716")) +
geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue, data = equityplot) +
geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == "27037060716")) +
councilR::council_theme() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x = "Tract people of color population\n(%)", y = "Canopy coverage in tract\n(%)")}
inc_equity <- if(params$selected_geo == "Selected tract") {
equityplot%>%
ggplot(aes(x = mdhhincnow, y = (canopy_percent))) +
geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != params$selected_tract)) +
geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == params$selected_tract)) +
councilR::council_theme() +
labs(x = "Block group median household income\n($)", y = "")
} else if (params$selected_geo == "City (MetCouncil region only)") {
equityplot%>%
ggplot(aes(x = mdhhincnow, y = (canopy_percent))) +
geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != "27037060716")) +
geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == "27037060716")) +
councilR::council_theme() +
labs(x = "Block group median household income\n($)", y = "")
}
fig_equity <- cowplot::plot_grid(race_equity, inc_equity, labels = "AUTO")
fig_equity
\newpage
## Other considerations
The goal of this section is present information about biodiversity, management challenges, and other considerations for managing the tree canopy.
Invasion by the Emerald ash borer (EAB) insect is a major threat to existing tree canopy. Data shows that EAB has infested ```r eabcount``` trees in the selected geography (<a href = 'https://mnag.maps.arcgis.com/apps/webappviewer/index.html?id=63ebb977e2924d27b9ef0787ecedf6e9' target = '_blank'>Minnesota DNR</a>). Please note that these data are not necessarily intended to identify every ash tree (infested or not), however we still believe this information to be useful.
Low biodiversity is another threat to the tree canopy in the region. And knowing which species can adapt to a changing climate. Over the last 100 years, our region has seen a decline in oak trees, and an increase in ash, elm, and maple trees (<a href = 'https://gisdata.mn.gov/dataset/biota-original-pls-bearing-trees' target = '_blank'>Almendinger 1997</a>, <a href = 'https://www.nrs.fs.fed.us/data/urban/state/city/?city=6#ufore_data' target = '_blank'>Davey Resource Group 2004</a>). "Other" species make up a larger percent of the tree canopy today, but these species are mostly introduced species rather than a diverse assemblage of native species (as was the case before 1900).
```rThis figure shows changes observed in tree canopy species across the Twin Cities region. Point shape and size indicates species identity."}
treebiodiv %>%
ggplot(aes(x = (timepoint), y = percent, fill = spp_name, shape = spp_name)) +
geom_line( position = position_dodge(width = 10))+#, aes(col = spp_name)) +
geom_point(#aes(color = if_else(spp_name %in% c("oak", "ash", "elm"), "red", "")), #col = "black",
size = 5, position = position_dodge(width = 10)) +
scale_fill_brewer(palette = "Paired", name = "Species") +
scale_color_brewer(palette = "Paired", name = "Species") +
scale_shape_manual(values = rep(c(21:25), 3), name = "Species")+
councilR::council_theme() +
labs(x = "Date", y = "Species composition (%)")
# https://www.biorxiv.org/content/10.1101/026575v3
\newpage
What's next for Growing Shade?
This tool is under active development (probably). Can we have people sign up for an email list to be notified when more features are added?
- Underlying land use in map (talk to gis folks)
- tree canopy uploaded to mn geospatial commons
- tree biodiversity data on map (if it exists in decent coverage)
- expanding to entire state/midwest
- ability to make a report for cities?
- updating to 2021 tree canopy (or other years)
- including some canopy loss/gain metrics over time (5 year time span, or something)
- news or use cases highlighted?
- stories added on map? or call for new story submissions?
- drilling down to block groups (when equity considerations are updated)
- tree short course talk coming up
- base data updated for most recent years (equity considerations data)
- if we add something on "tree stress/status" for maintenance (variability in ndvi over time?)
Other resources
The Growing Shade is a unique tool offering users the ability to customize prioritization and see detailed maps of tree canopy gaps. However, there are other tools which may be of interest.
- American Forest's Tree Equity Score
- This tool ranks areas based on their tree equity. Their methods are very similar to our "environmental justice" preset.
- Use this tool to look at tree equity across the United States.
- Growing Shade might be better suited for your needs if you want to view the location of trees or if you want to customize the variables which go into creating a prioritization layer.
- The Vibrant Cities Lab
- Go here to read lots of stories about why trees are useful.
- Hennepin County's Tree canopy priority areas
- If you're interest is just in Hennepin County, this might be a good cross reference too.
- Etc
- Etc
Appendix
Because we believe that context is important, this is how the selected area compares to the regional average for all the presets available in the Growing Shade application. Do note that some variables are shared across presets.
# If the variable was used in the user-selected ranking, those bars are outlined in red.
forplot <- summary_table %>%
ungroup() %>%
select(name, MEANSCALED, weights_scaled, ej, cc, ph, cons) %>%
pivot_longer(names_to = "TYPE", values_to = "VALUES", -c(name, ej, cc, ph, cons)) %>%
pivot_longer(names_to = "PRESETVAR", values_to = "PRESETVAL", -c(name, TYPE, VALUES)) %>%
filter(PRESETVAL == 1) %>%
mutate(PRESETVAR = case_when(PRESETVAR == "ej" ~ "Environmental justice",
PRESETVAR == "cc" ~ "Climate change",
PRESETVAR == "ph" ~ "Public health",
PRESETVAR == "cons" ~ "Con-\nserv-\nation"),
TYPE = case_when(TYPE == "MEANSCALED" ~ "Regional average",
TYPE == "weights_scaled" ~ "Selected area"))
forplot %>%
# mutate(FLAG = case_when(name %in% params$vars_selected$value ~ "flag",
# TRUE ~ NA_character_)) %>%
ggplot(aes(y = name, x= VALUES, fill= TYPE))+#, col = FLAG)) +
geom_bar(stat = "identity", position = position_dodge(width = .5), width = .5, size = .75) +
# coord_flip() +
facet_grid(PRESETVAR ~., space = "free_y", scales = "free_y") +
councilR::council_theme() +
scale_y_discrete(labels = function(x) str_wrap(x, width = 50))+
xlim(0, 10) +
scale_fill_manual(values = c(councilR::colors$councilBlue, councilR::colors$cdGreen),
name = "Geography") +
# scale_color_manual(values = c(councilR::colors$mtsRed, "white")) +
labs(y = "", x = "Score (out of 10)") +
theme(panel.border = element_rect(colour = "black", fill = NA),
# axis.text.y = element_text(size = 12),
# axis.title.x = element_text(size = 12)
strip.text = element_text(size = 12),
panel.grid.major.x = element_blank())#,
# legend.position = "bottom")# +
# guides(color = FALSE)
\newpage
kableExtra::kbl(summary_table %>%
ungroup() %>%
select(name, raw_value, MEANRAW, overall_rank, n) %>%
# filter(name %in% params$vars_selected$value) %>%
rename(Variable = name,
`Selected area` = raw_value,
`Regional average` = MEANRAW,
`Ranking` = overall_rank,
`Total ranked areas` = n),
booktabs = TRUE) %>%
kableExtra::kable_styling(#latex_options = "striped",
full_width = FALSE) %>%
kableExtra::column_spec(1, width = "20em") %>%
kableExtra::column_spec(2, width = "5em") %>%
kableExtra::column_spec(3, width = "5em") %>%
kableExtra::column_spec(4, width = "5em") %>%
kableExtra::column_spec(5, width = "5em")
# knitr::kable(summary_table %>%
# ungroup() %>%
# select(name, raw_value, MEANRAW, overall_rank, n) %>%
# # filter(name %in% params$vars_selected$value) %>%
# rename(Variable = name,
# `Selected area` = raw_value,
# `Regional average` = MEANRAW,
# `Ranking (higher rank = higher priority)` = overall_rank,
# `Total ranked areas` = n), "latex") %>%
# kableExtra::column_spec(1, width = "20em")
# kableExtra::kable_styling(full_width = FALSE)
# (summary_table %>%
# ungroup() %>%
# select(name, raw_value, MEANRAW, overall_rank, n) %>%
# # filter(name %in% params$vars_selected$value) %>%
# rename(Variable = name,
# `Selected area` = raw_value,
# `Regional average` = MEANRAW,
# `Ranking (higher rank = higher priority)` = overall_rank,
# `Total ranked areas` = n)) %>%
# kbl() %>%
# kable_styling(full_width = FALSE)
Metropolitan-Council/planting.shade documentation built on Feb. 25, 2024, 3:15 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(dplyr) library(stringr) library(ggplot2) library(tidyr) # library(tidyverse) # library(leaflet) # library(mapview) # knitr::opts_knit$set(eval.after = "fig.cap") knitr::opts_chunk$set(echo = TRUE, fig.align="center") # knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, tidy.opts=list(width.cutoff=50)) # output: # html_document: # toc: true # toc_depth: 3 # # css: "inst/app/www/style.css" # code_folding: show params$priority_score #scaled and centered average based on inputs params$priority_rank #rank of scaled and centered average based on inputs # rank_total #number of tracts total reportfor <- if (params$selected_geo == "City (MetCouncil region only)") { params$selected_city } else if (params$selected_geo == "Selected tract") { paste0("tract ", params$selected_tract) } else if (params$selected_geo == "County (within MN or WI)") { "Prank! nothing here yet" } scaled_summed <- if(params$selected_geo == "Selected tract") { params$priority_score %>% filter(tract_string == params$selected_tract) } else if (params$selected_geo == "City (MetCouncil region only)"){ params$priority_score %>% filter(tract_string == "27037060716") } fheight = if (nrow(params$vars_selected) < 3) { 3 } else {nrow(params$vars_selected)*.9} eabcount<- if(params$selected_geo == "Selected tract") { eab %>% sf::st_intersection(filter(mn_tracts, #crop_tract_ctus, GEOID == params$selected_tract)) %>% nrow()} else if (params$selected_geo == "City (MetCouncil region only)") { eab %>% sf::st_intersection(filter(mn_tracts, #crop_tract_ctus, GEOID == "27037060716")) %>% nrow() } canopycover <- if(params$selected_geo == "Selected tract") { params$canopy %>% filter(tract_string == params$selected_tract) } else if (params$selected_geo == "City (MetCouncil region only)") { params$canopy %>% filter(tract_string == "27037060716")}
Report for r reportfor
#, fig.cap = "\\label{fig:map}The geographic location of the selected area. The selected area is highlighed in green." if(params$selected_geo == "Selected tract") { metc_region %>% ggplot() + geom_sf(fill = NA, color = "grey80") + geom_sf(data = filter(mn_tracts, GEOID == params$selected_tract), color = councilR::colors$cdGreen, fill = councilR::colors$cdGreen) + theme_void() } else if (params$selected_geo == "City (MetCouncil region only)") { metc_region %>% ggplot() + geom_sf(fill = NA, color = "grey80") + geom_sf(data = filter(mn_tracts, GEOID == "27037060716"), color = councilR::colors$cdGreen, fill = councilR::colors$cdGreen) + theme_void()}
This report was generated from the Growing Shade interactive tool produced by the Metropolitan Council in collaboration with The Nature Conservancy and Tree Trust. Trees provide critical ecosystem services and are important components of the human, natural and built environments. Enhancing and maintaining tree canopy cover is an actionable step to create healthy places for people to live and a resilient future.
This report synthesizes and summarizes data about trees, people, and the built environments. Understanding the tree canopy within this larger context is important for prioritization and planning efforts. Please review "what's next for Growing Shade" or contact us at SOME EMAIL HERE if this report does not address your data needs - we welcome the feedback and may be able to accommodate requests.
Status of the tree canopy
This section summarizes the how the tree canopy priority of the selected region compares to other geographies across the region.
r reportfor has an existing tree coverage of approximately r round(canopycover$raw_value, 1)*100%. The distribution of tree canopy across tracts is shown below, with the selected tract highlighted in green. In most areas in our region, a tree canopy coverage of 40% (as detected by our methods) leads to the greatest benefits. Some areas in our region are dominated by native tallgrass prairie which has lower tree coverage - this should not be penalized.
If you wish to obtain a map of the tree canopy within the selected area, please use the interactive tool - just zoom in as desired and take a screenshot (instructions for Windows or instructions for Mac).
```rThe distribution of tree canopy coverage across tracts. The selected tract in highlighed in green. We provide two ways of looking at the distribution of tree capony coverage. On the bottom is a box plot, where each grey circle represents one geographic area. The line in the middle of the box shows the median value: half of the geographic areas fall below the median, and half of them lie above the median. The median is also known as the 50th percentile. The top and bottom edges of the box show the 75th percentile and the 25th percentile. On top is a density plot. The more geographic areas there are at a particular value, the taller this plot gets."}
canopyplot<-eva_data_main %>% filter(variable %in% c("canopy_percent")) %>% select(tract_string, variable, raw_value) %>% pivot_wider(names_from = variable, values_from = raw_value)
canopyhist <- if(params$selected_geo == "Selected tract") { ggplot()+ #distribution ggdist::stat_halfeye( data = canopyplot, aes(x = canopy_percent, y = 1), adjust = .5, width = .6, .width = 0, justification = -.3, point_colour = NA) + geom_boxplot(data = canopyplot, aes(x = canopy_percent, y = 1), width = .25, outlier.shape = NA) + councilR::council_theme() + theme(panel.grid.minor = element_blank(), panel.grid.major.y = element_blank(), axis.text.y = element_blank())+ geom_point(size = 1.3,alpha = .3, position = position_jitter(seed = 1, width = 0, height = .1), col = "grey40", aes(x = canopy_percent, y = 1), data = filter(canopyplot, tract_string != params$selected_tract)) + labs(y = "", x = "Tree canopy cover (%)") + scale_x_continuous(labels = scales::percent_format(accuracy = 1)) + geom_point(aes(x = canopy_percent, y = 1), fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(canopyplot, tract_string == params$selected_tract)) } else if (params$selected_geo == "City (MetCouncil region only)") { ggplot()+ #distribution ggdist::stat_halfeye( data = canopyplot, aes(x = canopy_percent, y = 1), adjust = .5, width = .6, .width = 0, justification = -.3, point_colour = NA) + geom_boxplot(data = canopyplot, aes(x = canopy_percent, y = 1), width = .25, outlier.shape = NA) + councilR::council_theme() + theme(panel.grid.minor = element_blank(), panel.grid.major.y = element_blank(), axis.text.y = element_blank())+ geom_point(size = 1.3,alpha = .3, position = position_jitter(seed = 1, width = 0, height = .1), col = "grey40", aes(x = canopy_percent, y = 1), data = filter(canopyplot, tract_string != "27037060716")) + labs(y = "", x = "Tree canopy cover (%)") + scale_x_continuous(labels = scales::percent_format(accuracy = 1)) + geom_point(aes(x = canopy_percent, y = 1), fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(canopyplot, tract_string == "27037060716")) } canopyhist
```r # We have chosen not to print an overview map in this space, because the time needed to generate the map adds considerably to the processing time of this report. Please note higher resolution images (and images with different underlying basemaps) can be obtained from the interactive tool - just zoom in to the desired level and take a screenshot. We recommend turning off the priority scores and using the "aerial imagery with roads" basemap. # map_path <- paste0(tempdir(), "/map.png") # # mapshot( # leaflet() %>% # addMapPane(name = "Aerial Imagery", zIndex = 100) %>% # addMapPane(name = "Aerial Imagery with roads", zIndex = 100) %>% # addMapPane(name = "Road outlines", zIndex = 151) %>% # addProviderTiles("Stamen.TonerLines", # options = pathOptions(pane = "Road outlines"), # group = "Aerial Imagery with roads") %>% # addProviderTiles("Stamen.TonerLabels", # options = c(zIndex = 600),# pathOptions(pane = "Stamen Toner"), # group = "Aerial Imagery with roads") %>% # addProviderTiles( # provider = providers$Esri.WorldImagery, # group = "Aerial Imagery with roads", # options = pathOptions(pane = "Aerial Imagery") # ) %>% # addRasterImage(trees %>% # raster::crop(filter(mn_tracts,#crop_tract_ctus, # # GEOID == "27053109100")), # GEOID == params$selected_tract)), # colors = "#238b45", #pal, # opacity = .8, # layerId = "Trees", # group = "Trees"#, # # project = FALSE) # ) %>% # addPolygons(data = filter(mn_tracts, # GEOID == params$selected_tract), # # GEOID == "27053109100"), # fill = NA, # opacity = 1, # color = councilR::colors$councilBlue) %>% # addLayersControl( # position = "bottomright", # baseGroups = c( # "Aerial Imagery with roads" # ), # overlayGroups = c( # "Trees"), # options = layersControlOptions(collapsed = TRUE) # ), # file = map_path, cliprect = "viewport") # # knitr::include_graphics(map_path)
\newpage
Priortization summary
Based on the r params$vars_used preset used, the selected area ranks r scaled_summed$RANK out of r params$rank_total (where a higher rank indicates a higher priority area) with an average priority score of r round(scaled_summed$MEAN, 2) (out of 10, with 10 indicating the highest priority).
The specific variables which went into this ranking include :
selectedvariables <- if (params$vars_used == "Custom") { params$vars_selected$value } else if (params$vars_used == "Environmental justice") { c(metadata[metadata$ej == 1, ])$name } else if (params$vars_used == "Public health") { c(metadata[metadata$ph == 1, ])$name } else if (params$vars_used == "Climate change") { c(metadata[metadata$cc == 1, ])$name } else if (params$vars_used == "Conservation") { c(metadata[metadata$cons == 1, ])$name } row_count <- nrow(params$vars_selected) if(!is.null(row_count)){ # write a function to create a list from the vector vectorBulletList <- function(vector) { if(length(vector > 1)) { paste0("<ul><li>", paste0( paste0(vector, collpase = ""), collapse = "</li><li>"), "</li></ul>") } } } HTML(paste0("<code>",vectorBulletList(selectedvariables), "</code>"))
Here is how the selected area compares to the regional average for the selected variables. The plot shows the scaled and standardized scores on the x-axis. The table shows the raw values. Please refer to the Methods tab for more detail. Please go to the Appendix section of this report for more information on all the variables.
```rA comparison of the selected area to regional averages with respect to the variables selected for this report. The value(s) of the selected geography are shown in green, while the regional averages are shown in blue."} testdf <- eva_data_main %>% full_join(metadata)#%>% filter(variable == "prim_flood") testtr <- if(params$selected_geo == "Selected tract") { params$selected_tract } else if (params$selected_geo == "City (MetCouncil region only)") { "27037060716"}
summary_table <- filter(testdf, tract_string == testtr) %>% mutate(overall_rank = as.factor(overall_rank)) %>% mutate(across(c(raw_value, MEANRAW), ~ifelse(str_detect(name, "%"), . * 100, .))) %>% mutate(across(where(is.numeric), round, 2))
# if (params$vars_used == "Custom"){
summary_table %>% ungroup() %>% select(name, MEANSCALED, weights_scaled) %>% filter(name %in% selectedvariables) %>% pivot_longer(names_to = "TYPE", values_to = "VALUES", -name) %>% mutate(TYPE = case_when(TYPE == "MEANSCALED" ~ "Regional average", TYPE == "weights_scaled" ~ "Selected area")) %>% ggplot(aes(y = name, x= VALUES, fill= TYPE)) + geom_bar(stat = "identity", position = position_dodge(width = .5), width = .5, size = .75) + # facet_grid(PRESETVAR ~., space = "free_y", scales = "free_y") + councilR::council_theme() + scale_y_discrete(labels = function(x) str_wrap(x, width = 40))+ xlim(0, 10)+ scale_fill_manual(values = c(councilR::colors$councilBlue, councilR::colors$cdGreen), name = "Geography") + # scale_color_manual(values = c(councilR::colors$mtsRed, "white")) + labs(y = "", x = "Score (out of 10)") + theme(panel.border = element_rect(colour = "black", fill = NA), # axis.text.y = element_text(size = 12), # axis.title.x = element_text(size = 12) strip.text = element_text(size = 12), panel.grid.major.x = element_blank()#, # legend.position = "bottom" )
# }
```rA table comparing of the selected area to regional averages with respect to the variables selected for this report."}
kableExtra::kbl(summary_table %>%
ungroup() %>%
select(name, raw_value, MEANRAW, overall_rank, n) %>%
filter(name %in% selectedvariables) %>%
rename(Variable = name,
`Selected area` = raw_value,
`Regional average` = MEANRAW,
`Ranking` = overall_rank,
`Total ranked areas` = n),
booktabs = TRUE) %>%
kableExtra::kable_styling(#latex_options = "striped",
full_width = FALSE) %>%
kableExtra::column_spec(1, width = "20em") %>%
kableExtra::column_spec(2, width = "5em") %>%
kableExtra::column_spec(3, width = "5em") %>%
kableExtra::column_spec(4, width = "5em") %>%
kableExtra::column_spec(5, width = "5em")
\newpage
Equity analysis
The goal of this section is to show how people and trees interact, and where the selected geography compares.
Research shows that trees are unevenly distributed across communities. In particular, neighborhoods with high BIPOC or low-income populations have less tree canopy (MacDonald 2021) than areas which were historically redlined (NPR news story, Locke et al. 2021, Namin et al. 2020). Addressing inequity in tree canopy cover may reduce heat-related deaths by up to 25% (Sinha 2021).
At the MetCouncil, we have shown that areas where the median income is <100,000 and areas with high BIPOC populations have less tree canopy and greenness. We are specifically calling out these variables in figures here. The selected tract is in green, and the regional trend is in blue. This relationship is falling apart a bit at the TRACT level. Ideally, it would be good to get down to the block group level, for everything in this report and in the tool
```rA figure showing how canopy coverage is related to race (A) and income (B). The selected area is shown in green and all other tracts are shown in grey. The regional trend line is blue."} equityplot<-eva_data_main %>% filter(variable %in% c("pbipoc", "canopy_percent", "ndvi", "mdhhincnow")) %>% select(tract_string, variable, raw_value) %>% pivot_wider(names_from = variable, values_from = raw_value)
race_equity <- if(params$selected_geo == "Selected tract") { equityplot%>% ggplot(aes(x = pbipoc, y = canopy_percent)) + geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != params$selected_tract)) + geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue, data = equityplot) + geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == params$selected_tract)) + councilR::council_theme() + scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + labs(x = "Tract people of color population\n(%)", y = "Canopy coverage in tract\n(%)") } else if (params$selected_geo == "City (MetCouncil region only)") { equityplot%>% ggplot(aes(x = pbipoc, y = canopy_percent)) + geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != "27037060716")) + geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue, data = equityplot) + geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == "27037060716")) + councilR::council_theme() + scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + labs(x = "Tract people of color population\n(%)", y = "Canopy coverage in tract\n(%)")}
inc_equity <- if(params$selected_geo == "Selected tract") { equityplot%>% ggplot(aes(x = mdhhincnow, y = (canopy_percent))) + geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != params$selected_tract)) + geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue) + scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == params$selected_tract)) + councilR::council_theme() + labs(x = "Block group median household income\n($)", y = "") } else if (params$selected_geo == "City (MetCouncil region only)") { equityplot%>% ggplot(aes(x = mdhhincnow, y = (canopy_percent))) + geom_point(col = "grey40", alpha = .3, data = filter(equityplot, tract_string != "27037060716")) + geom_smooth(method = "lm", fill = NA, col = councilR::colors$councilBlue) + scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + geom_point(fill = councilR::colors$cdGreen, size = 5, col = "black", pch = 21, data = filter(equityplot, tract_string == "27037060716")) + councilR::council_theme() + labs(x = "Block group median household income\n($)", y = "") }
fig_equity <- cowplot::plot_grid(race_equity, inc_equity, labels = "AUTO")
fig_equity
\newpage ## Other considerations The goal of this section is present information about biodiversity, management challenges, and other considerations for managing the tree canopy. Invasion by the Emerald ash borer (EAB) insect is a major threat to existing tree canopy. Data shows that EAB has infested ```r eabcount``` trees in the selected geography (<a href = 'https://mnag.maps.arcgis.com/apps/webappviewer/index.html?id=63ebb977e2924d27b9ef0787ecedf6e9' target = '_blank'>Minnesota DNR</a>). Please note that these data are not necessarily intended to identify every ash tree (infested or not), however we still believe this information to be useful. Low biodiversity is another threat to the tree canopy in the region. And knowing which species can adapt to a changing climate. Over the last 100 years, our region has seen a decline in oak trees, and an increase in ash, elm, and maple trees (<a href = 'https://gisdata.mn.gov/dataset/biota-original-pls-bearing-trees' target = '_blank'>Almendinger 1997</a>, <a href = 'https://www.nrs.fs.fed.us/data/urban/state/city/?city=6#ufore_data' target = '_blank'>Davey Resource Group 2004</a>). "Other" species make up a larger percent of the tree canopy today, but these species are mostly introduced species rather than a diverse assemblage of native species (as was the case before 1900). ```rThis figure shows changes observed in tree canopy species across the Twin Cities region. Point shape and size indicates species identity."} treebiodiv %>% ggplot(aes(x = (timepoint), y = percent, fill = spp_name, shape = spp_name)) + geom_line( position = position_dodge(width = 10))+#, aes(col = spp_name)) + geom_point(#aes(color = if_else(spp_name %in% c("oak", "ash", "elm"), "red", "")), #col = "black", size = 5, position = position_dodge(width = 10)) + scale_fill_brewer(palette = "Paired", name = "Species") + scale_color_brewer(palette = "Paired", name = "Species") + scale_shape_manual(values = rep(c(21:25), 3), name = "Species")+ councilR::council_theme() + labs(x = "Date", y = "Species composition (%)") # https://www.biorxiv.org/content/10.1101/026575v3
\newpage
What's next for Growing Shade?
This tool is under active development (probably). Can we have people sign up for an email list to be notified when more features are added?
- Underlying land use in map (talk to gis folks)
- tree canopy uploaded to mn geospatial commons
- tree biodiversity data on map (if it exists in decent coverage)
- expanding to entire state/midwest
- ability to make a report for cities?
- updating to 2021 tree canopy (or other years)
- including some canopy loss/gain metrics over time (5 year time span, or something)
- news or use cases highlighted?
- stories added on map? or call for new story submissions?
- drilling down to block groups (when equity considerations are updated)
- tree short course talk coming up
- base data updated for most recent years (equity considerations data)
- if we add something on "tree stress/status" for maintenance (variability in ndvi over time?)
Other resources
The Growing Shade is a unique tool offering users the ability to customize prioritization and see detailed maps of tree canopy gaps. However, there are other tools which may be of interest.
- American Forest's Tree Equity Score
- This tool ranks areas based on their tree equity. Their methods are very similar to our "environmental justice" preset.
- Use this tool to look at tree equity across the United States.
- Growing Shade might be better suited for your needs if you want to view the location of trees or if you want to customize the variables which go into creating a prioritization layer.
- The Vibrant Cities Lab
- Go here to read lots of stories about why trees are useful.
- Hennepin County's Tree canopy priority areas
- If you're interest is just in Hennepin County, this might be a good cross reference too.
- Etc
- Etc
Appendix
Because we believe that context is important, this is how the selected area compares to the regional average for all the presets available in the Growing Shade application. Do note that some variables are shared across presets.
# If the variable was used in the user-selected ranking, those bars are outlined in red. forplot <- summary_table %>% ungroup() %>% select(name, MEANSCALED, weights_scaled, ej, cc, ph, cons) %>% pivot_longer(names_to = "TYPE", values_to = "VALUES", -c(name, ej, cc, ph, cons)) %>% pivot_longer(names_to = "PRESETVAR", values_to = "PRESETVAL", -c(name, TYPE, VALUES)) %>% filter(PRESETVAL == 1) %>% mutate(PRESETVAR = case_when(PRESETVAR == "ej" ~ "Environmental justice", PRESETVAR == "cc" ~ "Climate change", PRESETVAR == "ph" ~ "Public health", PRESETVAR == "cons" ~ "Con-\nserv-\nation"), TYPE = case_when(TYPE == "MEANSCALED" ~ "Regional average", TYPE == "weights_scaled" ~ "Selected area")) forplot %>% # mutate(FLAG = case_when(name %in% params$vars_selected$value ~ "flag", # TRUE ~ NA_character_)) %>% ggplot(aes(y = name, x= VALUES, fill= TYPE))+#, col = FLAG)) + geom_bar(stat = "identity", position = position_dodge(width = .5), width = .5, size = .75) + # coord_flip() + facet_grid(PRESETVAR ~., space = "free_y", scales = "free_y") + councilR::council_theme() + scale_y_discrete(labels = function(x) str_wrap(x, width = 50))+ xlim(0, 10) + scale_fill_manual(values = c(councilR::colors$councilBlue, councilR::colors$cdGreen), name = "Geography") + # scale_color_manual(values = c(councilR::colors$mtsRed, "white")) + labs(y = "", x = "Score (out of 10)") + theme(panel.border = element_rect(colour = "black", fill = NA), # axis.text.y = element_text(size = 12), # axis.title.x = element_text(size = 12) strip.text = element_text(size = 12), panel.grid.major.x = element_blank())#, # legend.position = "bottom")# + # guides(color = FALSE)
\newpage
kableExtra::kbl(summary_table %>% ungroup() %>% select(name, raw_value, MEANRAW, overall_rank, n) %>% # filter(name %in% params$vars_selected$value) %>% rename(Variable = name, `Selected area` = raw_value, `Regional average` = MEANRAW, `Ranking` = overall_rank, `Total ranked areas` = n), booktabs = TRUE) %>% kableExtra::kable_styling(#latex_options = "striped", full_width = FALSE) %>% kableExtra::column_spec(1, width = "20em") %>% kableExtra::column_spec(2, width = "5em") %>% kableExtra::column_spec(3, width = "5em") %>% kableExtra::column_spec(4, width = "5em") %>% kableExtra::column_spec(5, width = "5em") # knitr::kable(summary_table %>% # ungroup() %>% # select(name, raw_value, MEANRAW, overall_rank, n) %>% # # filter(name %in% params$vars_selected$value) %>% # rename(Variable = name, # `Selected area` = raw_value, # `Regional average` = MEANRAW, # `Ranking (higher rank = higher priority)` = overall_rank, # `Total ranked areas` = n), "latex") %>% # kableExtra::column_spec(1, width = "20em") # kableExtra::kable_styling(full_width = FALSE) # (summary_table %>% # ungroup() %>% # select(name, raw_value, MEANRAW, overall_rank, n) %>% # # filter(name %in% params$vars_selected$value) %>% # rename(Variable = name, # `Selected area` = raw_value, # `Regional average` = MEANRAW, # `Ranking (higher rank = higher priority)` = overall_rank, # `Total ranked areas` = n)) %>% # kbl() %>% # kable_styling(full_width = FALSE)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.