nick/tree-tracker-report
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Create map plot function and replace map scripts with function.

Browse Source
This commit is contained in:
Nick Heppler 2025-03-13 12:04:51 -04:00
parent 7474d8ac8c
commit 0a4e5bc9ab
1 changed files with 236 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

317
report.Rmd
View File

@ -23,12 +23,17 @@ knitr::opts_chunk$set(
message = FALSE,
warning = FALSE
)
# Load necessary libraries
library(ggplot2)
#library(dplyr)
#library(ggplot2)
library(knitr)
library(lubridate)
library(RColorBrewer)
library(scales)
library(sf)
library(tidyverse)
library(tigris)
library(viridis)
# Load survey data files from CSV as tibbles.
survey_data <- read_csv("data/_25_Million_Trees_Initiative_Survey_0.csv")
@ -38,8 +43,9 @@ participant_organizations <- read_csv("data/participant_organizations_3.csv")
species_planted <- read_csv("data/species_planted_4.csv")
vendors <- read_csv("data/vendors_5.csv")
# Transform date stored as character or numeric vectors to POSIXct objects.
survey_data <- survey_data %>%
mutate(CreationDate = mdy_hm(CreationDate))
mutate(CreationDate = mdy_hms(CreationDate))
# Count the records to be excluded (Exclude Result == 1)
excluded_count <- survey_data %>%
@ -69,6 +75,7 @@ subtitle: "`r format(min(survey_data$CreationDate, na.rm = TRUE), "%B %d, %Y")`
---
# Report Overview {.tabset}
[Back to Top](#)
## Background
@ -110,7 +117,6 @@ To ensure data integrity, several validation steps are applied to survey submiss
- **Start Date of Planting**: The date when planting began.
- **End Date of Planting**: The date when planting was completed.
- **Location**: Geographic coordinates (latitude and longitude).
- **Response Validation**:
- **Geographic Validation**: Once geographic coordinates are entered, they are checked against official civil boundaries to provide an accurate nominal locality, county, and region data. In rare cases, this check may fail due to service dependency, but such records are corrected before inclusion in the analysis.
- **Date Validation and Logic**: Users cannot enter planting dates prior to the start date of the initiative. The system enforces this restriction, and any records with such dates are not allowed to be submitted. Additionally, users cannot enter a planting end date that occurs before the planting start date.
@ -120,6 +126,7 @@ To ensure data integrity, several validation steps are applied to survey submiss
By applying these validation checks, the integrity and consistency of the data is ensured, allowing for meaningful analysis of tree planting surveys.
# Submission Analysis {.tabset}
[Back to Top](#)
```{r func-create_histogram, echo=TRUE, message=FALSE}
@ -167,6 +174,7 @@ create_histogram <- function(data, field, x_labels = NULL, color_palette = c("#1
```
## Day of Week
The histogram presented below visualizes the number of survey submissions based on the day of the week. Each bar represents the frequency of submissions for a particular day, with the x-axis displaying the days (Monday through Sunday) and the y-axis showing the number of submissions for each corresponding day.
This chart helps identify any trends in survey participation, such as whether submissions are more frequent at the beginning or end of the week. This could be valuable for understanding user behavior and improving survey timing or outreach strategies.
@ -182,6 +190,7 @@ create_histogram(
x_title = "Day",
color_palette = c("#233f2b", "#7e9084", "#d9e1dd", "#face00"))
```
```{r func-plot_submission_trends, echo=TRUE}
plot_submission_trends <- function(data, days_ago = 30, color_palette = c("#154973", "#457aa5", "#eff6fb", "#face00"),
title = NULL, subtitle = NULL, x_title = "Submission Date", y_title = "Number of Submissions") {
@ -228,6 +237,7 @@ plot_submission_trends <- function(data, days_ago = 30, color_palette = c("#1549
```
## 30 Day Trend
The plot below visualizes the survey submission trends for the past 30 days. It shows the number of submissions made each day, highlighting variations over the last month. This type of plot is helpful for understanding trends in user activity, such as identifying peak submission days, periods of low activity, or gradual changes over time.
The data used for this plot is filtered to include only submissions made in the last 30 days, with the submission count for each date represented by both the line and the points on the graph. A smoothed trend line (dashed) has been added to help visualize the overall submission pattern over this period.
@ -245,6 +255,7 @@ plot_submission_trends(survey_data,
```
## 90 Day Trend
The plot below visualizes the survey submission trends for the past 90 days. It shows the number of submissions made each day, highlighting variations over the last month. This type of plot is helpful for understanding trends in user activity, such as identifying peak submission days, periods of low activity, or gradual changes over time.
The data used for this plot is filtered to include only submissions made in the last 90 days, with the submission count for each date represented by both the line and the points on the graph. A smoothed trend line (dashed) has been added to help visualize the overall submission pattern over this period.
@ -262,6 +273,7 @@ plot_submission_trends(survey_data,
```
## Optional Question Response Rates
```{r func-calculate_response_rates, echo=TRUE, message=FALSE}
# Function to calculate response rates for selected fields
calculate_response_rates <- function(survey_data, fields, caption) {
@ -303,7 +315,7 @@ calculate_response_rates <- function(survey_data, fields, caption) {
The table below summarizes the response rates for optional top-level questions in the survey. These are the questions that all participants are asked, with some triggering additional follow-up questions based on responses. The response rate is the percentage of participants who provided an answer for each question.
The "Total Number of Species Planted" question has special handling—only responses greater than 0 are considered valid, whereas for other questions, any non-NA value counts as a response.
The "Total Number of Species Planted" question has special handling—only responses greater than 0 are considered valid, whereas for other questions, any non-NA value counts as a response.
```{r response-rate-table-optional, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
fields <- c("Planter Contact Email", "Funding Source", "Land Ownership",
@ -321,6 +333,7 @@ The following provides additional context for each survey question/field, detail
- **Total Number of Species Planted** : The percentage of respondents who provided the species of tree(s) they planted.
# Participant Analysis {.tabset}
[Back to Top](#)
The following section contains an analysis of tree planting by participant type.
@ -346,6 +359,7 @@ create_histogram(
```
## Trees Planted
This plot visualizes the total number of trees planted by each participant type, helping to evaluate the overall impact of different groups in the tree planting program.
```{r func-create_bar_chart, echo=TRUE, message=FALSE}
@ -422,93 +436,6 @@ create_bar_chart(
color_palette = c("#233f2b", "#7e9084", "#d9e1dd", "#face00"))
```
The following table provides a breakdown of the total number of trees planted by participant type. It shows both the total number of trees planted by each group and their proportional contribution to the overall planting efforts. This information helps assess which participant types have contributed the most to the tree planting program.
```{r participant-type-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
# Summarize the data to calculate the total number of trees planted by participant type
summary_data <- survey_data %>%
group_by(`Who Planted The Tree(s)?`) %>%
summarise(total_trees = sum(`Number of Trees Planted`, na.rm = TRUE))
# Replace the participant type values with more readable labels
summary_data <- summary_data %>%
mutate(
`Who Planted The Tree(s)?` = recode(`Who Planted The Tree(s)?`,
"agency" = "State Agency",
"community" = "Community Organization",
"landowner" = "Private Landowner",
"municipality" = "Municipal Government",
"professional" = "Paid Professional")
)
# Add percentage column
summary_data <- summary_data %>%
mutate(percentage = total_trees / sum(total_trees) * 100)
# Format the table to display the number of trees and percentage
summary_data_formatted <- summary_data %>%
mutate(
total_trees = scales::comma(total_trees), # Add commas to the total number of trees
percentage = paste0(round(percentage, 1), "%") # Round percentage and append '%'
)
summary_data_formatted %>%
knitr::kable(col.names = c("Participant Type", "Total Trees Planted", "Percentage of Total Trees"),
caption = "Breakdown of Total Trees Planted by Participant Type and Their Contribution to the Overall Tree Planting Effort",
align = c("l", "c", "c")) %>% # Align Participant Type left, and others center
kableExtra::kable_styling(
full_width = F,
position = "center",
bootstrap_options = c("striped", "hover"),
font_size = 14,
fixed_thead = TRUE
) %>%
kableExtra::column_spec(1, width = "20em", bold = TRUE) %>% # Participant Type column bold and wider
kableExtra::column_spec(2, width = "12em", color = "black") %>% # Total Trees column
kableExtra::column_spec(3, width = "12em", color = "black") %>% # Percentage column
kableExtra::add_footnote("Total number of trees and percentage represent each participant's contribution to the overall tree planting effort.")
```
## Named User Activity
```{r named-user-activity-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
user_activity <- survey_data %>%
mutate(Creator = ifelse(is.na(Creator), "Public User", Creator)) %>%
group_by(Creator) %>%
summarise(
`Submissions` = n(),
`Total Trees Panted` = sum(`Number of Trees Planted`, na.rm = TRUE)
)
knitr::kable(user_activity, caption = "Named User Activity Table", align = "l")
```
## Unique E-mail Activity
```{r unique-email-activity-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
user_activity_email <- survey_data %>%
mutate(Creator = ifelse(is.na(`Planter Contact Email`), "Not Provided", `Planter Contact Email`)) %>%
group_by(`Planter Contact Email`) %>%
summarise(
`Submissions` = n(),
`Total Trees Panted` = sum(`Number of Trees Planted`, na.rm = TRUE)
)
knitr::kable(user_activity_email, caption = "Unique E-mail Activity Table", align = "l")
```
## Municipal Activity
```{r}
survey_data %>%
mutate(`Participant Municipality` = case_when(
str_starts(`Participant Municipality`, "c_") ~ str_replace(`Participant Municipality`, "^c_", "") %>% paste0(" (city)"),
str_starts(`Participant Municipality`, "v_") ~ str_replace(`Participant Municipality`, "^v_", "") %>% paste0(" (village)"),
str_starts(`Participant Municipality`, "t_") ~ str_replace(`Participant Municipality`, "^t_", "") %>% paste0(" (town)"),
TRUE ~ `Participant Municipality`
)) %>%
create_summary_table("Participant Municipality", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## Organizaiton Activity
# Location Analysis{.tabset}
```{r func-create_summary_table, echo=TRUE}
create_summary_table <- function(data, field, sum_field, remove_na = TRUE, table_font_size = 14) {
# Input validation
@ -565,14 +492,153 @@ create_summary_table <- function(data, field, sum_field, remove_na = TRUE, table
kableExtra::add_footnote("The proportions represent the percentage of submissions and sum of the field for each category relative to the overall dataset.")
}
```
The following table provides a breakdown of the total number of trees planted by participant type. It shows both the total number of trees planted by each group and their proportional contribution to the overall planting efforts. This information helps assess which participant types have contributed the most to the tree planting program.
```{r participant-type-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
survey_data %>%
mutate(
`Who Planted The Tree(s)?` = recode(`Who Planted The Tree(s)?`,
"agency" = "State Agency",
"community" = "Community Organization",
"landowner" = "Private Landowner",
"municipality" = "Municipal Government",
"professional" = "Paid Professional")
) %>%
create_summary_table("Who Planted The Tree(s)?", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## Named User Activity
```{r named-user-activity-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
survey_data %>%
mutate(Creator = ifelse(is.na(Creator), "Public User", Creator)) %>%
create_summary_table("Creator", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## Unique E-mail Activity
```{r unique-email-activity-table, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
survey_data %>%
mutate(Creator = ifelse(is.na(`Planter Contact Email`), "Not Provided", `Planter Contact Email`)) %>%
create_summary_table("Planter Contact Email", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## Municipal Activity
```{r}
survey_data %>%
mutate(`Participant Municipality` = case_when(
str_starts(`Participant Municipality`, "c_") ~ str_replace(`Participant Municipality`, "^c_", "") %>% paste0(" (city)"),
str_starts(`Participant Municipality`, "v_") ~ str_replace(`Participant Municipality`, "^v_", "") %>% paste0(" (village)"),
str_starts(`Participant Municipality`, "t_") ~ str_replace(`Participant Municipality`, "^t_", "") %>% paste0(" (town)"),
TRUE ~ `Participant Municipality`
)) %>%
create_summary_table("Participant Municipality", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## Organizaiton Activity
# Location Analysis {.tabset}
```{r func-plot_geographic_data, echo=TRUE}
plot_geographic_data <- function(joined_data,
title,
legend,
fill_option = "plasma",
subtitle = NULL,
theme_options = theme_minimal(),
legend_position = "right",
color_scale = "viridis",
save_path = NULL,
na_fill_color = "lightgrey") {
current_date <- format(Sys.Date(), "%B %d, %Y")
# If subtitle is not provided, use the current date as subtitle
subtitle_text <- ifelse(is.null(subtitle), paste("Date:", current_date), subtitle)
# Handle missing data by filling with a specified color
joined_data[is.na(joined_data$total_trees), "total_trees"] <- NA
# Select the color scale based on the user's input
if (color_scale == "viridis") {
fill_color <- scale_fill_viridis_c(option = fill_option, na.value = na_fill_color) # Use na.value to fill NA
} else if (color_scale == "RColorBrewer") {
fill_color <- scale_fill_brewer(palette = "Set3") # Default RColorBrewer palette
} else {
fill_color <- scale_fill_manual(values = color_scale) # Custom color scale
}
# Create the plot
plot <- ggplot(data = joined_data) +
geom_sf(aes(fill = total_trees), color = "white") +
fill_color + # Color scale for the plot
theme_options + # Apply custom theme
labs(title = title,
subtitle = subtitle_text, # Subtitle is handled here
fill = legend) +
theme(axis.text = element_blank(), axis.title = element_blank(),
legend.position = legend_position)
# If save_path is provided, save the plot to file
if (!is.null(save_path)) {
ggsave(save_path, plot = plot, width = 10, height = 6)
}
# Return the plot
return(plot)
}
```
[Back to Top](#)
## By Region
This map displays the **total number of trees planted** across each economic region in **New York State**. The counties are color-coded, with darker shades representing areas where more trees have been planted. This allows users to quickly see which counties have had the most extensive tree planting efforts.
- **What to look for**:
- **Dark colors**: Indicate regions with a higher number of trees planted.
- **Lighter colors**: Represent regions with fewer trees planted.
The map provides a visual overview of tree planting distribution across New York, making it easier to identify areas with the highest impact or need for further action.
```{r create-region-choropleth-map, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
survey_data_aggregated <- survey_data %>%
group_by(Region) %>%
summarise(total_trees = sum(`Number of Trees Planted`, na.rm = TRUE))
shapefile_path <- "/home/nick/gitea/tree-tracker-report/data/redc/redc.shp"
geographic_data <- st_read(shapefile_path) %>%
mutate(
REDC = str_replace(REDC, "Western NY", "Western New York"),
REDC = str_replace(REDC, "Central NY", "Central New York"),
REDC = str_replace(REDC, "Mid-Hudson", "Hudson Valley"),
REDC = str_replace(REDC, "Capital Region", "Capital District"),
) %>%
st_as_sf()
survey_data_joined <- geographic_data %>%
left_join(survey_data_aggregated, by = c("REDC" = "Region"))
plot_geographic_data(joined_data = survey_data_joined,
title = "Number of Trees Planted by Region in New York",
legend = "Total Trees Planted",
fill_option = "plasma",
subtitle = "Generated: March 13, 2025",
theme_options = theme_minimal(),
legend_position = "right",
color_scale = "viridis",
na_fill_color = "lightgrey")
```
```{r create-summary-table-region, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
create_summary_table(survey_data, "Region", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## By County
This map displays the **total number of trees planted** across each county in **New York State**. The counties are color-coded, with darker shades representing areas where more trees have been planted. This allows users to quickly see which counties have had the most extensive tree planting efforts.
- **What to look for**:
@ -582,34 +648,27 @@ This map displays the **total number of trees planted** across each county in **
The map provides a visual overview of tree planting distribution across New York, making it easier to identify areas with the highest impact or need for further action.
```{r create-county-choropleth-map, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
library(tigris) # For geographic data
library(sf) # For handling spatial data
library(dplyr) # For data manipulation
library(ggplot2) # For plotting
library(viridis) # For a color palette in the map
# Download New York State counties shapefile
ny_counties <- counties(state = "NY", cb = TRUE, progress = FALSE) %>% st_as_sf()
survey_data_aggregated <- survey_data %>%
group_by(County) %>%
summarise(total_trees = sum(`Number of Trees Planted`, na.rm = TRUE))
ny_counties_merged <- ny_counties %>%
geographic_data <- counties(state = "NY", cb = TRUE, progress = FALSE) %>%
st_as_sf() %>%
mutate(NAME = str_replace(NAME, "\\.", "")) # Remove period from "St. Lawrence"
survey_data_joined <- geographic_data %>%
left_join(survey_data_aggregated, by = c("NAME" = "County"))
# Get the system date and format it
current_date <- format(Sys.Date(), "%B %d, %Y") # Format as "Month Day, Year"
ggplot(data = ny_counties_merged) +
geom_sf(aes(fill = total_trees), color = "white") +
scale_fill_viridis_c(option = "plasma") + # Use a color scale like viridis
theme_minimal() +
labs(title = "Number of Trees Planted by County in New York",
fill = "Total Trees Planted") +
theme(axis.text = element_blank(), axis.title = element_blank()) +
annotate("text", x = -77.25, y = 45.25, label = paste("Date:", current_date), size = 4, hjust = 1, color = "black")
# Example of calling the function with enhancements
plot_geographic_data(joined_data = survey_data_joined,
title = "Number of Trees Planted by County in New York",
legend = "Total Trees Planted",
fill_option = "plasma",
subtitle = "Generated: March 13, 2025",
theme_options = theme_minimal(),
legend_position = "right",
color_scale = "viridis", # Default viridis scale
na_fill_color = "lightgrey") # Color for NA values
```
```{r create-summary-table-county, echo=TRUE, message=FALSE, , fig.height=6, fig.width=8}
@ -618,7 +677,9 @@ create_summary_table(survey_data, "County", "Number of Trees Planted", remove_na
```
# Tree Analysis {.tabset}
[Back to Top](#)
```{r func-create_species_summary_table, echo=TRUE}
create_species_summary_table <- function(data, field, field_label = NULL) {
# Replace empty strings and NA values with "Not Provided" before summarization
@ -700,3 +761,31 @@ These figures provide an understanding of which species are most commonly report
```{r create-summary-table-species, echo=TRUE, message=FALSE, fig.height=6, fig.width=8}
create_species_summary_table(species_planted, "Precise Species of Tree", "Tree Species")
```
# Disadvantaged Communities {.tabset}
## By Region
```{r create-summary-table-region-dac, echo=TRUE, message=FALSE, , fig.height=6, fig.width=8}
survey_data %>%
filter(`Disadvantaged Communities Indicator` == "Designated as DAC", na.rm = TRUE) %>%
create_summary_table("Region", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## By County
```{r create-summary-table-county-dac, echo=TRUE, message=FALSE, , fig.height=6, fig.width=8}
survey_data %>%
filter(`Disadvantaged Communities Indicator` == "Designated as DAC", na.rm = TRUE) %>%
create_summary_table("County", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```
## By Municipality
```{r create-summary-table-county-municipality, echo=TRUE, message=FALSE, , fig.height=6, fig.width=8}
survey_data %>%
filter(`Disadvantaged Communities Indicator` == "Designated as DAC", na.rm = TRUE) %>%
create_summary_table("Municipality", "Number of Trees Planted", remove_na = FALSE, table_font_size = 16)
```