# Load necessary libraries
library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(readxl)
library(tidyr)
library(stringr)
library(tigris)
## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.
library(sf)
## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
library(forcats)
library(knitr)


# Load and clean main dataset
wg_data <- read_excel("cleaned all data but virtual code.xlsx", sheet = "Sheet1") %>%
mutate(
  year = case_when(
    str_detect(date_submission, "^\\d{4}$") ~ as.numeric(date_submission),
    TRUE ~ as.numeric(format(as.Date(date_submission, format = "%m/%d/%Y"), "%Y"))
  ),
  county = tolower(County),
  participated = tolower(participated),
  spanish_home = str_detect(tolower(lang), "spanish")
)

Standardize key variables

wg_data <- wg_data %>%
  mutate(race_ethnicity_standardized = case_when(
    str_detect(race_n_ethnicity, "\\n| and ") ~ "Multiracial",
    grepl("White", race_n_ethnicity, ignore.case = TRUE) ~ "White",
    grepl("Black|African American", race_n_ethnicity, ignore.case = TRUE) ~ "Black or African American",
    grepl("American Indian|Alaska Native", race_n_ethnicity, ignore.case = TRUE) ~ "American Indian or Alaska Native",
    grepl("Asian", race_n_ethnicity, ignore.case = TRUE) ~ "Asian",
    grepl("Native Hawaiian|Other Pacific Islander", race_n_ethnicity, ignore.case = TRUE) ~ "Native Hawaiian or Other Pacific Islander",
    grepl("Hispanic|Latino", race_n_ethnicity, ignore.case = TRUE) ~ "Hispanic or Latino",
    grepl("Other", race_n_ethnicity, ignore.case = TRUE) ~ "Other",
    grepl("Prefer not to answer|Decline to answer", race_n_ethnicity, ignore.case = TRUE) ~ "Prefer not to answer",
    TRUE ~ "Multiracial"
  )) %>%
  mutate(hear_wg_standardized = paste(
    ifelse(str_detect(hear_wg, regex("returning hiker|Past Participant", ignore_case = TRUE)), "Previous Participant", NA),
    ifelse(str_detect(hear_wg, regex("hospice social worker|counselor|pediatrician|case manager|saint peter's hospital", ignore_case = TRUE)), "Provider", NA),
    ifelse(str_detect(hear_wg, regex("facebook|fb advert|instagram|social media", ignore_case = TRUE)), "Social Media", NA),
    ifelse(str_detect(hear_wg, regex("don’t remember|not sure|just did|applied to wild grief", ignore_case = TRUE)), "Unsure", NA),
    ifelse(str_detect(hear_wg, regex("bridges program at mary bridge|other grief group|weekly goldstar emails|thru another group", ignore_case = TRUE)), "Other Grief Org", NA),
    ifelse(str_detect(hear_wg, regex("friend|word of mouth|my daughter|through a friend|coworker|work|a family member|rebecca atkins|sariney mourng|marisol morales|karen kirsch", ignore_case = TRUE)) & 
             !str_detect(hear_wg, regex("social worker", ignore_case = TRUE)), "Word of Mouth", NA),
    ifelse(str_detect(hear_wg, regex("school", ignore_case = TRUE)), "School", NA),
    ifelse(str_detect(hear_wg, regex("web search|googled|internet|wild grief website|parent|email / online|searching for grief support online", ignore_case = TRUE)), "Internet Search", NA),
    ifelse(str_detect(hear_wg, regex("newsletter|wg newsletter|we have been on your mailing list", ignore_case = TRUE)), "Newsletter", NA),
    ifelse(str_detect(hear_wg, regex("flyer", ignore_case = TRUE)), "Flyer", NA),
    ifelse(str_detect(hear_wg, regex("dcyf|cys", ignore_case = TRUE)), "DCYF", NA),
    ifelse(str_detect(hear_wg, regex("church", ignore_case = TRUE)), "Church", NA),
    ifelse(str_detect(hear_wg, regex("bipoc outdoor group", ignore_case = TRUE)), "BIPOC Outdoor Group", NA),
    ifelse(str_detect(hear_wg, regex("resource center|multicultural center", ignore_case = TRUE)), "Resource Center/Org", NA),
    sep = ", "
  )) %>%
  mutate(hear_wg_standardized = str_replace_all(hear_wg_standardized, "NA, |, NA|NA", "")) %>%
  mutate(hear_wg_standardized = ifelse(hear_wg_standardized == "", NA, hear_wg_standardized)) %>%
  mutate(who_died_standardized = paste(
    ifelse(str_detect(who_died, regex("son", ignore_case = TRUE)), "Son", NA),
    ifelse(str_detect(who_died, regex("daughter", ignore_case = TRUE)), "Daughter", NA),
    ifelse(str_detect(who_died, regex("husband", ignore_case = TRUE)), "Husband", NA),
    ifelse(str_detect(who_died, regex("wife", ignore_case = TRUE)), "Wife", NA),
    ifelse(str_detect(who_died, regex("father", ignore_case = TRUE)), "Father", NA),
    ifelse(str_detect(who_died, regex("mother", ignore_case = TRUE)), "Mother", NA),
    ifelse(str_detect(who_died, regex("brother", ignore_case = TRUE)), "Brother", NA),
    ifelse(str_detect(who_died, regex("sister", ignore_case = TRUE)), "Sister", NA),
    ifelse(str_detect(who_died, regex("grandfather", ignore_case = TRUE)), "Grandfather", NA),
    ifelse(str_detect(who_died, regex("grandmother", ignore_case = TRUE)), "Grandmother", NA),
    ifelse(str_detect(who_died, regex("uncle", ignore_case = TRUE)), "Uncle", NA),
    ifelse(str_detect(who_died, regex("aunt", ignore_case = TRUE)), "Aunt", NA),
    ifelse(str_detect(who_died, regex("partner", ignore_case = TRUE)), "Partner", NA),
    ifelse(str_detect(who_died, regex("stepfather", ignore_case = TRUE)), "Stepfather", NA),
    ifelse(str_detect(who_died, regex("stepmother", ignore_case = TRUE)), "Stepmother", NA),
    ifelse(str_detect(who_died, regex("teacher", ignore_case = TRUE)), "Teacher", NA),
    ifelse(str_detect(who_died, regex("friend", ignore_case = TRUE)), "Friend", NA),
    ifelse(str_detect(who_died, regex("nephew", ignore_case = TRUE)), "Nephew", NA),
    ifelse(str_detect(who_died, regex("niece", ignore_case = TRUE)), "Niece", NA),
    ifelse(str_detect(who_died, regex("family friend", ignore_case = TRUE)), "Family Friend", NA),
    sep = ", "
  )) %>%
  mutate(who_died_standardized = str_replace_all(who_died_standardized, "NA, |, NA|NA", "")) %>%
  mutate(who_died_standardized = ifelse(who_died_standardized == "", NA, who_died_standardized)) %>%
  mutate(how_died_standardized = paste(
    ifelse(str_detect(how_died, regex("accident", ignore_case = TRUE)), "Accident (Other)", NA),
    ifelse(str_detect(how_died, regex("car|vehicle|motorcycle|bike", ignore_case = TRUE)), "Accident (Vehicle)", NA),
    ifelse(str_detect(how_died, regex("fire", ignore_case = TRUE)), "Accident (Fire)", NA),
    ifelse(str_detect(how_died, regex("illness|disease|chronic condition|health problems", ignore_case = TRUE)), "Illness", NA),
    ifelse(str_detect(how_died, regex("cancer", ignore_case = TRUE)), "Cancer", NA),
    ifelse(str_detect(how_died, regex("suicide", ignore_case = TRUE)), "Suicide", NA),
    ifelse(str_detect(how_died, regex("homicide|murder", ignore_case = TRUE)), "Homicide", NA),
    ifelse(str_detect(how_died, regex("overdose|drug overdose", ignore_case = TRUE)), "Overdose", NA),
    ifelse(str_detect(how_died, regex("sudden|unexpected", ignore_case = TRUE)), "Sudden/Unexpected", NA),
    ifelse(str_detect(how_died, regex("old age|natural causes", ignore_case = TRUE)), "Natural Causes", NA),
    ifelse(str_detect(how_died, regex("heart attack|heart failure|stroke|seizure", ignore_case = TRUE)), "Cardiac Event", NA),
    ifelse(str_detect(how_died, regex("covid", ignore_case = TRUE)), "COVID", NA),
    ifelse(str_detect(how_died, regex("medical complications|medical malpractice", ignore_case = TRUE)), "Medical Complications", NA),
    ifelse(str_detect(how_died, regex("drowned|drowning", ignore_case = TRUE)), "Drowning", NA),
    sep = ", "
  )) %>%
  mutate(how_died_standardized = str_replace_all(how_died_standardized, "NA, |, NA|NA", "")) %>%
  mutate(how_died_standardized = ifelse(how_died_standardized == "", NA, how_died_standardized))

palette colors

# Define green color palette
green_palette <- scale_fill_manual(values = c(
  # Greens
  "#66c2a5", "#41ae76", "#238b45", "#005a32", "#a1d99b",
  "#74c476", "#00441b", "#78c679", "#c2e699", "#006d2c",
  # Blues
  "#6baed6", "#3182bd", "#08519c", "#c6dbef",
  # Yellows
  "#fdd835", "#fbc02d", "#f9a825", "#f57f17"
))

Request 1: Line graph - % Spanish spoken at home by year

# Request 1: Line graph - % Spanish spoken at home by year
spanish_by_year <- wg_data %>%
  filter(participated == "yes", year <= 2024) %>%
  group_by(year) %>%
  summarise(
    total = n(),
    spanish_speakers = sum(spanish_home, na.rm = TRUE),
    percent_spanish = 100 * spanish_speakers / total
  )

ggplot(spanish_by_year, aes(x = year, y = percent_spanish)) +
  geom_line(color = "#238b45") +
  geom_point(color = "#005a32") +
  labs(title = "% Participants Speaking Spanish at Home by Year",
       x = "Year", y = "% Spanish Speakers") +
  theme_minimal()

# Table
kable(spanish_by_year, caption = "Table: % of Participants Speaking Spanish at Home by Year (Only Participated = Yes, through 2024)")
Table: % of Participants Speaking Spanish at Home by Year (Only Participated = Yes, through 2024)
year total spanish_speakers percent_spanish
2021 7 0 0.000000
2022 94 8 8.510638
2023 155 32 20.645161
2024 187 35 18.716577

Request 2 & 3: Bar graph + Table - Age Set by Year

# Request 2: Bar Graph – Participation by Age Set and Year
wg_data <- wg_data %>%
  mutate(age_set = case_when(
    program_type %in% c("Teen Day Hike", "Teen Backpack") ~ "Teen Programs",
    program_type %in% c("YA Backpack") ~ "YA Programs",
    program_type %in% c("All Ages/Family Day Hike", "Family Camp", "Camp Rosey Hike", "Spanish Language Hike") ~ "Family Programs",
    TRUE ~ NA_character_
  ))

age_set_year <- wg_data %>%
  filter(participated == "yes", !is.na(age_set)) %>%
  count(year, age_set)

ggplot(age_set_year, aes(x = factor(year), y = n, fill = age_set)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Participation by Age Set and Year", x = "Year", y = "Count") +
  theme_minimal() +
  green_palette

# Request 3: Table – Participation by Age Set and Year
# Pivot to wide format
age_set_year_wide <- age_set_year %>%
  pivot_wider(names_from = year, values_from = n, values_fill = 0)

# Display with kable
kable(age_set_year_wide, caption = "Table: Participation by Age Set and Year (Wide Format, Participants Only)")
Table: Participation by Age Set and Year (Wide Format, Participants Only)
age_set 2021 2022 2023 2024 2025
Teen Programs 5 15 23 22 1
Family Programs 0 17 46 64 0
YA Programs 0 6 8 6 0

Request 4-7 WA counties applicants vs participants

# Load WA counties shapefile
wa_counties <- counties(state = "WA", cb = TRUE, class = "sf") %>%
  mutate(county = tolower(NAME))
## Retrieving data for the year 2022
##   |                                                                              |                                                                      |   0%  |                                                                              |                                                                      |   1%  |                                                                              |=                                                                     |   1%  |                                                                              |=                                                                     |   2%  |                                                                              |==                                                                    |   3%  |                                                                              |=======                                                               |  11%  |                                                                              |============                                                          |  18%  |                                                                              |==================                                                    |  25%  |                                                                              |=======================                                               |  33%  |                                                                              |============================                                          |  40%  |                                                                              |=================================                                     |  47%  |                                                                              |======================================                                |  54%  |                                                                              |===========================================                           |  62%  |                                                                              |================================================                      |  69%  |                                                                              |=====================================================                 |  76%  |                                                                              |===========================================================           |  84%  |                                                                              |================================================================      |  91%  |                                                                              |===================================================================== |  98%  |                                                                              |======================================================================| 100%
# Request 4: Map – Counties for Applicants Only (Did Not Participate)
applicants_by_county <- wg_data %>%
  filter(participated == "no", !is.na(county), county != "") %>%
  mutate(county = str_to_title(county)) %>%
  group_by(county) %>%
  summarise(count = n(), .groups = 'drop')

wa_map_applicants <- left_join(wa_counties %>% mutate(county = str_to_title(county)), applicants_by_county, by = "county")

ggplot(wa_map_applicants) +
  geom_sf(aes(fill = count), color = "black") +
  geom_text(aes(x = st_coordinates(st_centroid(geometry))[,1],
                y = st_coordinates(st_centroid(geometry))[,2],
                label = toupper(county)), size = 2) +
  labs(title = "Counties of Applicants Only (Did Not Participate)", fill = "Applicant Count") +
  theme_minimal() +
  scale_fill_gradient(low = "#c2e699", high = "#006d2c", na.value = "gray90") +
  theme(axis.title = element_blank(), axis.text = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank())

# Request 5: Top 10 Counties Each Year (Applicants Only, Ranked Format)
top_county_ranks_applicants <- wg_data %>%
  filter(participated == "no", !is.na(county), county != "", year <= 2024) %>%
  mutate(county = str_to_title(county)) %>%
  group_by(year, county) %>%
  summarise(n = n(), .groups = 'drop') %>%
  group_by(year) %>%
  arrange(desc(n)) %>%
  slice_head(n = 10) %>%
  mutate(rank = row_number()) %>%
  select(year, rank, county) %>%
  pivot_wider(names_from = year, values_from = county)

kable(top_county_ranks_applicants, caption = "Request 5: Top 10 Counties Each Year (Applicants Only, Ranked by Count, Through 2024)")
Request 5: Top 10 Counties Each Year (Applicants Only, Ranked by Count, Through 2024)
rank 2021 2022 2023 2024
1 Thurston Thurston Thurston Thurston
2 Pierce Pierce Pierce Pierce
3 King King King King
4 Clark Out Of State (Or) Out Of State (Or) Mason
5 NA Lewis Snohomish Adams
6 NA Whatcom Clark Clark
7 NA Snohomish Mason Grays Harbor
8 NA Grays Harbor Benton Cowlitz
9 NA Mason Columbia Kitsap
10 NA Clark Grays Harbor Out Of State (Or) 
# Request 6: Map – Counties of Participants Only
participants_by_county <- wg_data %>%
  filter(participated == "yes", !is.na(county), county != "") %>%
  mutate(county = str_to_title(county)) %>%
  group_by(county) %>%
  summarise(count = n(), .groups = 'drop')

wa_map_participants <- left_join(wa_counties %>% mutate(county = str_to_title(county)), participants_by_county, by = "county")

ggplot(wa_map_participants) +
  geom_sf(aes(fill = count), color = "black") +
  geom_text(aes(x = st_coordinates(st_centroid(geometry))[,1],
                y = st_coordinates(st_centroid(geometry))[,2],
                label = toupper(county)), size = 2) +
  labs(title = "Counties of Participants Only", fill = "Participant Count") +
  theme_minimal() +
  scale_fill_gradient(low = "#a1d99b", high = "#005a32", na.value = "gray90") +
  theme(axis.title = element_blank(), axis.text = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank())

# Request 7: Top 10 Counties Each Year (Participants Only, Ranked Format)
top_county_ranks_participants <- wg_data %>%
  filter(participated == "yes", !is.na(county), county != "", year <= 2024) %>%
  mutate(county = str_to_title(county)) %>%
  group_by(year, county) %>%
  summarise(n = n(), .groups = 'drop') %>%
  group_by(year) %>%
  arrange(desc(n)) %>%
  slice_head(n = 10) %>%
  mutate(rank = row_number()) %>%
  select(year, rank, county) %>%
  pivot_wider(names_from = year, values_from = county)

kable(top_county_ranks_participants, caption = "Request 7: Top 10 Counties Each Year (Participants Only, Ranked by Count, Through 2024)")
Request 7: Top 10 Counties Each Year (Participants Only, Ranked by Count, Through 2024)
rank 2021 2022 2023 2024
1 Mason Thurston Thurston Thurston
2 Pierce King Pierce Pierce
3 Skamania Pierce King King
4 Thurston Snohomish Grays Harbor Kitsap
5 Whatcom Clallam Snohomish Mason
6 NA Grays Harbor Lewis Out Of State (Or)
7 NA Jefferson Clark Clallam
8 NA Lewis Mason Grays Harbor
9 NA Mason Out Of State (Or) Snohomish
10 NA Out Of State (Or) Out Of State Ca Adams

Request 8: Bar graph - Assistance Program by Year

# Request 8: Bar graph - Assistance Program by Year
assist_by_year <- wg_data %>%
filter(participated == "yes", year <= 2024) %>%
  count(year, assistance_program)

ggplot(assist_by_year, aes(x = factor(year), y = n, fill = assistance_program)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Participants Receiving Assistance by Year", x = "Year", y = "Count") +
  theme_minimal()

Request 9: Race/Ethnicity for Participants w/ diffrent ways to view

# Request 9: Race/Ethnicity for Participants
race_dist <- wg_data %>%
  filter(participated == "yes", !is.na(race_ethnicity_standardized)) %>%
  count(race_ethnicity_standardized)

ggplot(race_dist, aes(x = fct_reorder(race_ethnicity_standardized, n), y = n, fill = race_ethnicity_standardized)) +
  geom_col() +
  coord_flip() +
  labs(title = "Race/Ethnicity of Participants", x = "Race/Ethnicity", y = "Count") +
  theme_minimal()

#stacked by year
race_by_year <- wg_data %>%
  filter(participated == "yes", !is.na(race_ethnicity_standardized), year <= 2024) %>%
  group_by(year, race_ethnicity_standardized) %>%
  summarise(n = n(), .groups = "drop")

ggplot(race_by_year, aes(x = factor(year), y = n, fill = race_ethnicity_standardized)) +
  geom_bar(stat = "identity", position = "stack") +
  labs(title = "Race/Ethnicity of Participants by Year",
       x = "Year", y = "Count", fill = "Race/Ethnicity") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set2")  # You could also try "Paired" or "Dark2"
## Warning in RColorBrewer::brewer.pal(n, pal): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors

# Pie Chart: No Labels
race_overall <- wg_data %>%
  filter(participated == "yes", !is.na(race_ethnicity_standardized), year <= 2024) %>%
  group_by(race_ethnicity_standardized) %>%
  summarise(n = n(), .groups = "drop")

ggplot(race_overall, aes(x = "", y = n, fill = race_ethnicity_standardized)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  labs(title = "Race/Ethnicity of Participants (All Years Through 2024)",
       fill = "Race/Ethnicity") +
  theme_void() +
  scale_fill_brewer(palette = "Set3")

  # No geom_text = no labels

# Table: Race/Ethnicity by Year (Counts and %)
race_year_table <- wg_data %>%
  filter(participated == "yes", !is.na(race_ethnicity_standardized), year <= 2024) %>%
  group_by(year, race_ethnicity_standardized) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(year) %>%
  mutate(percent = round(100 * n / sum(n), 1),
         summary = paste0(n, " (", percent, "%)")) %>%
  ungroup() %>%
  select(year, race_ethnicity_standardized, summary) %>%
  arrange(race_ethnicity_standardized, year) %>%  # sort rows by race, then year
  pivot_wider(names_from = year, values_from = summary, values_fill = "0 (0%)") %>%
  select(race_ethnicity_standardized, sort(names(.)[-1]))  # sort year columns chronologically

kable(race_year_table, caption = "Table: Race/Ethnicity of Participants by Year (Counts and Percentages)")
Table: Race/Ethnicity of Participants by Year (Counts and Percentages)
race_ethnicity_standardized 2021 2022 2023 2024
American Indian or Alaska Native 0 (0%) 0 (0%) 4 (2.6%) 22 (11.8%)
Asian 0 (0%) 1 (1.1%) 3 (1.9%) 7 (3.7%)
Black or African American 0 (0%) 4 (4.3%) 7 (4.5%) 3 (1.6%)
Hispanic or Latino 0 (0%) 15 (16%) 35 (22.6%) 43 (23%)
Multiracial 2 (28.6%) 27 (28.7%) 26 (16.8%) 24 (12.8%)
Native Hawaiian or Other Pacific Islander 0 (0%) 0 (0%) 0 (0%) 2 (1.1%)
Other 0 (0%) 0 (0%) 2 (1.3%) 0 (0%)
Prefer not to answer 1 (14.3%) 8 (8.5%) 7 (4.5%) 3 (1.6%)
White 4 (57.1%) 39 (41.5%) 71 (45.8%) 83 (44.4%)

Request 10: Bar Graphs by Program w/ Camp Rosey and Spanish Language Hike into All Ages/Family Day Hike

# Request 10: Bar Graphs by Program
# Recode program types to merge Camp Rosey and Spanish Language Hike into All Ages/Family Day Hike
wg_data <- wg_data %>%
  mutate(program_type_grouped = case_when(
    program_type %in% c("All ages/Family Day Hike", "Camp Rosey Hike", "Spanish Language Hike") ~ "All Ages/Family Day Hike",
    TRUE ~ program_type
  ))

# Prepare data: participants only, through 2024
race_by_program_year <- wg_data %>%
  filter(participated == "yes",
         !is.na(race_ethnicity_standardized),
         !is.na(program_type_grouped),
         year <= 2024) %>%
  group_by(program_type_grouped, year, race_ethnicity_standardized) %>%
  summarise(n = n(), .groups = "drop")

# Plot: One stacked bar graph per program type
ggplot(race_by_program_year, aes(x = factor(year), y = n, fill = race_ethnicity_standardized)) +
  geom_bar(stat = "identity", position = "stack") +
  facet_wrap(~ program_type_grouped, scales = "free_y") +
  labs(title = "Race/Ethnicity by Program and Year",
       x = "Year", y = "Count", fill = "Race/Ethnicity") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set3")

race_table <- wg_data %>%
  filter(participated == "yes",
         !is.na(race_ethnicity_standardized),
         !is.na(program_type_grouped),
         year <= 2024) %>%
  group_by(program_type_grouped, year, race_ethnicity_standardized) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(program_type_grouped, year) %>%
  mutate(percent = round(100 * n / sum(n), 1),
         summary = paste0(n, " (", percent, "%)")) %>%
  ungroup() %>%
  select(program_type_grouped, race_ethnicity_standardized, year, summary) %>%
  mutate(race_ethnicity_standardized = factor(race_ethnicity_standardized,
                                              levels = sort(unique(race_ethnicity_standardized)))) %>%
  arrange(program_type_grouped, race_ethnicity_standardized, year) %>%
  pivot_wider(names_from = year, values_from = summary, values_fill = "0 (0%)") %>%
  relocate(sort(names(.)[!(names(.) %in% c("program_type_grouped", "race_ethnicity_standardized"))]),
           .after = race_ethnicity_standardized)

kable(race_table, caption = "Table: Race/Ethnicity by Program and Year (Counts and Percentages, Alphabetical Rows, Chronological Columns)")
Table: Race/Ethnicity by Program and Year (Counts and Percentages, Alphabetical Rows, Chronological Columns)
program_type_grouped race_ethnicity_standardized 2021 2022 2023 2024
All Ages/Family Day Hike American Indian or Alaska Native 0 (0%) 0 (0%) 1 (2.6%) 17 (30.9%)
All Ages/Family Day Hike Black or African American 0 (0%) 0 (0%) 0 (0%) 1 (1.8%)
All Ages/Family Day Hike Hispanic or Latino 0 (0%) 6 (42.9%) 29 (74.4%) 33 (60%)
All Ages/Family Day Hike Multiracial 0 (0%) 8 (57.1%) 2 (5.1%) 0 (0%)
All Ages/Family Day Hike Prefer not to answer 0 (0%) 0 (0%) 1 (2.6%) 0 (0%)
All Ages/Family Day Hike White 0 (0%) 0 (0%) 6 (15.4%) 4 (7.3%)
Family Camp American Indian or Alaska Native 0 (0%) 0 (0%) 2 (11.1%) 0 (0%)
Family Camp Asian 0 (0%) 0 (0%) 0 (0%) 1 (6.7%)
Family Camp Black or African American 0 (0%) 0 (0%) 2 (11.1%) 1 (6.7%)
Family Camp Hispanic or Latino 0 (0%) 0 (0%) 1 (5.6%) 1 (6.7%)
Family Camp Multiracial 0 (0%) 11 (100%) 4 (22.2%) 1 (6.7%)
Family Camp Other 0 (0%) 0 (0%) 1 (5.6%) 0 (0%)
Family Camp Prefer not to answer 0 (0%) 0 (0%) 1 (5.6%) 0 (0%)
Family Camp White 0 (0%) 0 (0%) 7 (38.9%) 11 (73.3%)
Hike Habit American Indian or Alaska Native 0 (0%) 0 (0%) 0 (0%) 3 (3.8%)
Hike Habit Asian 0 (0%) 0 (0%) 3 (6.2%) 3 (3.8%)
Hike Habit Black or African American 0 (0%) 3 (7.5%) 3 (6.2%) 1 (1.3%)
Hike Habit Hispanic or Latino 0 (0%) 5 (12.5%) 3 (6.2%) 3 (3.8%)
Hike Habit Multiracial 0 (0%) 4 (10%) 3 (6.2%) 9 (11.4%)
Hike Habit Native Hawaiian or Other Pacific Islander 0 (0%) 0 (0%) 0 (0%) 1 (1.3%)
Hike Habit Prefer not to answer 0 (0%) 7 (17.5%) 2 (4.2%) 3 (3.8%)
Hike Habit White 0 (0%) 21 (52.5%) 34 (70.8%) 56 (70.9%)
Tean Day Hike American Indian or Alaska Native 0 (0%) 0 (0%) 1 (5.3%) 0 (0%)
Tean Day Hike Asian 0 (0%) 0 (0%) 0 (0%) 2 (20%)
Tean Day Hike Black or African American 0 (0%) 1 (12.5%) 2 (10.5%) 0 (0%)
Tean Day Hike Hispanic or Latino 0 (0%) 2 (25%) 1 (5.3%) 0 (0%)
Tean Day Hike Multiracial 1 (50%) 0 (0%) 4 (21.1%) 2 (20%)
Tean Day Hike Other 0 (0%) 0 (0%) 1 (5.3%) 0 (0%)
Tean Day Hike Prefer not to answer 1 (50%) 1 (12.5%) 0 (0%) 0 (0%)
Tean Day Hike White 0 (0%) 4 (50%) 10 (52.6%) 6 (60%)
Teen Backpack American Indian or Alaska Native 0 (0%) 0 (0%) 0 (0%) 2 (9.1%)
Teen Backpack Asian 0 (0%) 0 (0%) 0 (0%) 1 (4.5%)
Teen Backpack Hispanic or Latino 0 (0%) 1 (6.7%) 1 (4.3%) 2 (9.1%)
Teen Backpack Multiracial 1 (20%) 3 (20%) 12 (52.2%) 10 (45.5%)
Teen Backpack Native Hawaiian or Other Pacific Islander 0 (0%) 0 (0%) 0 (0%) 1 (4.5%)
Teen Backpack Prefer not to answer 0 (0%) 0 (0%) 3 (13%) 0 (0%)
Teen Backpack White 4 (80%) 11 (73.3%) 7 (30.4%) 6 (27.3%)
YA Backpack Asian 0 (0%) 1 (16.7%) 0 (0%) 0 (0%)
YA Backpack Hispanic or Latino 0 (0%) 1 (16.7%) 0 (0%) 4 (66.7%)
YA Backpack Multiracial 0 (0%) 1 (16.7%) 1 (12.5%) 2 (33.3%)
YA Backpack White 0 (0%) 3 (50%) 7 (87.5%) 0 (0%)

Request 11: Table of Counts and Percentages for participated vs applied and 11.5 family vs teen programing as percantages

# Request 11: Table of Counts and Percentages for participated vs applied 
# Recode program type to merge Camp Rosey & Spanish Language Hike under Family Day Hike
wg_data <- wg_data %>%
  mutate(program_type_grouped = case_when(
    program_type %in% c("All Ages/Family Day Hike", "Camp Rosey Hike", "Spanish Language Hike") ~ "All Ages/Family Day Hike",
    TRUE ~ program_type
  ))

# Create race/ethnicity table by participation and grouped program
race_program_summary <- wg_data %>%
  filter(!is.na(race_ethnicity_standardized),
         !is.na(participated),
         !is.na(program_type_grouped),
         year <= 2024) %>%
  group_by(program_type_grouped, participated, race_ethnicity_standardized) %>%
  summarise(count = n(), .groups = 'drop') %>%
  group_by(program_type_grouped, participated) %>%
  mutate(percent = round(100 * count / sum(count), 1),
         summary = paste0(count, " (", percent, "%)")) %>%
  ungroup() %>%
  select(program_type_grouped, race_ethnicity_standardized, participated, summary) %>%
  pivot_wider(names_from = participated, values_from = summary, values_fill = "0 (0%)") %>%
  arrange(program_type_grouped, race_ethnicity_standardized)

# Display table
kable(race_program_summary, caption = "Request 11: Race/Ethnicity by Participation and Program (Counts and Percentages, with Merged Family Hikes)")
Request 11: Race/Ethnicity by Participation and Program (Counts and Percentages, with Merged Family Hikes)
program_type_grouped race_ethnicity_standardized yes no
All Ages/Family Day Hike American Indian or Alaska Native 17 (20.5%) 0 (0%)
All Ages/Family Day Hike Hispanic or Latino 66 (79.5%) 0 (0%)
All ages/Family Day Hike American Indian or Alaska Native 1 (4%) 1 (1.6%)
All ages/Family Day Hike Asian 0 (0%) 1 (1.6%)
All ages/Family Day Hike Black or African American 1 (4%) 2 (3.1%)
All ages/Family Day Hike Hispanic or Latino 2 (8%) 1 (1.6%)
All ages/Family Day Hike Multiracial 10 (40%) 40 (62.5%)
All ages/Family Day Hike Prefer not to answer 1 (4%) 1 (1.6%)
All ages/Family Day Hike White 10 (40%) 18 (28.1%)
Family Camp American Indian or Alaska Native 2 (4.5%) 0 (0%)
Family Camp Asian 1 (2.3%) 1 (1.2%)
Family Camp Black or African American 3 (6.8%) 7 (8.8%)
Family Camp Hispanic or Latino 2 (4.5%) 1 (1.2%)
Family Camp Multiracial 16 (36.4%) 27 (33.8%)
Family Camp Native Hawaiian or Other Pacific Islander 0 (0%) 1 (1.2%)
Family Camp Other 1 (2.3%) 1 (1.2%)
Family Camp Prefer not to answer 1 (2.3%) 3 (3.8%)
Family Camp White 18 (40.9%) 39 (48.8%)
Hike Habit American Indian or Alaska Native 3 (1.8%) 1 (0.9%)
Hike Habit Asian 6 (3.6%) 2 (1.7%)
Hike Habit Black or African American 7 (4.2%) 2 (1.7%)
Hike Habit Hispanic or Latino 11 (6.6%) 3 (2.6%)
Hike Habit Multiracial 16 (9.6%) 9 (7.7%)
Hike Habit Native Hawaiian or Other Pacific Islander 1 (0.6%) 1 (0.9%)
Hike Habit Prefer not to answer 12 (7.2%) 7 (6%)
Hike Habit White 111 (66.5%) 92 (78.6%)
Tean Day Hike American Indian or Alaska Native 1 (2.6%) 0 (0%)
Tean Day Hike Asian 2 (5.1%) 0 (0%)
Tean Day Hike Black or African American 3 (7.7%) 3 (7%)
Tean Day Hike Hispanic or Latino 3 (7.7%) 4 (9.3%)
Tean Day Hike Multiracial 7 (17.9%) 12 (27.9%)
Tean Day Hike Other 1 (2.6%) 1 (2.3%)
Tean Day Hike Prefer not to answer 2 (5.1%) 4 (9.3%)
Tean Day Hike White 20 (51.3%) 19 (44.2%)
Teen Backpack American Indian or Alaska Native 2 (3.1%) 2 (2%)
Teen Backpack Asian 1 (1.5%) 2 (2%)
Teen Backpack Black or African American 0 (0%) 9 (9%)
Teen Backpack Hispanic or Latino 4 (6.2%) 4 (4%)
Teen Backpack Multiracial 26 (40%) 28 (28%)
Teen Backpack Native Hawaiian or Other Pacific Islander 1 (1.5%) 0 (0%)
Teen Backpack Prefer not to answer 3 (4.6%) 0 (0%)
Teen Backpack White 28 (43.1%) 55 (55%)
YA Backpack Asian 1 (5%) 3 (7.9%)
YA Backpack Black or African American 0 (0%) 4 (10.5%)
YA Backpack Hispanic or Latino 5 (25%) 2 (5.3%)
YA Backpack Multiracial 4 (20%) 5 (13.2%)
YA Backpack White 10 (50%) 24 (63.2%) 
#11.5 family vs teen programing as percantages 
green_paletteyn <- scale_fill_manual(values = c(
  "yes" = "#66c2a5",
  "no" = "#41ae76"
))

# Ensure age_set is assigned
wg_data <- wg_data %>%
  mutate(age_set = case_when(
    program_type %in% c("Teen Day Hike", "Teen Backpack") ~ "Teen Programs",
    program_type %in% c("YA Backpack") ~ "YA Programs",
    program_type %in% c("All Ages/Family Day Hike", "Family Camp", "Camp Rosey Hike", "Spanish Language Hike") ~ "Family Programs",
    TRUE ~ NA_character_
  ))

# Prepare percentage data
race_pct_participation <- wg_data %>%
  filter(age_set %in% c("Teen Programs", "Family Programs"),
         !is.na(race_ethnicity_standardized),
         !is.na(participated)) %>%
  group_by(age_set, race_ethnicity_standardized, participated) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(age_set, race_ethnicity_standardized) %>%
  mutate(percent = 100 * n / sum(n)) %>%
  ungroup()

# Plot: Stacked bar chart with green palette
ggplot(race_pct_participation,
       aes(x = race_ethnicity_standardized, y = percent, fill = participated)) +
  geom_bar(stat = "identity", position = "stack") +
  facet_wrap(~ age_set) +
  labs(title = "Race/Ethnicity: % Participants vs Applicants in Family & Teen Programs",
       x = "Race/Ethnicity", y = "Percent", fill = "Participation Status") +
  theme_minimal() +
  green_paletteyn +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Request 12: Types of Bereavement in Relation to Children

# Request 12: Types of Bereavement in Relation to Children (Expanded List)
child_loss <- wg_data %>%
  filter(participated == "yes",
         program_type %in% c("Teen Day Hike", "Teen Backpack",
                             "All Ages/Family Day Hike", "Family Camp",
                             "Camp Rosey Hike", "Spanish Language Hike"),
         !is.na(who_died_standardized)) %>%
  separate_rows(who_died_standardized, sep = ", ") %>%
  filter(who_died_standardized %in% c(
    "Mother", "Father", "Grandmother", "Grandfather",
    "Stepfather", "Stepmother", "Brother", "Sister",
    "Aunt", "Uncle", "Friend"
  )) %>%
  count(who_died_standardized)

# Plot
ggplot(child_loss, aes(x = who_died_standardized, y = n)) +
  geom_col(fill = "#74c476") +
  labs(title = "Types of Bereavement in Relation to Children",
       x = "Relation", y = "Count") +
  theme_minimal()

Request 13: Type of Death by Year

# Request 13: Type of Death by Year
how_died_data <- wg_data %>%
  filter(!is.na(how_died_standardized), year <= 2024) %>%
  separate_rows(how_died_standardized, sep = ", ") %>%
  count(year, how_died_standardized)

ggplot(how_died_data, aes(x = factor(year), y = n, fill = how_died_standardized)) +
  geom_bar(stat = "identity") +
  labs(title = "Types of Death by Year", x = "Year", y = "Count", fill = "Type") +
  theme_minimal() +
  green_palette

Request 14: How Heard About Us

# Request 14: How Heard About Us
hear_data <- wg_data %>%
  filter(!is.na(hear_wg_standardized)) %>%
  separate_rows(hear_wg_standardized, sep = ", ") %>%
  count(hear_wg_standardized)

ggplot(hear_data, aes(x = fct_reorder(hear_wg_standardized, n), y = n, fill = hear_wg_standardized)) +
  geom_col() +
  coord_flip() +
  labs(title = "How Participants Heard About Wild Grief", x = "Source", y = "Count") +
  theme_minimal() +
  green_palette

Request 15: Income by Program

# Request 15: Income by Program
income_levels <- c("<$30,000", "$30,000-$50,000", "$50,000-$80,000", ">$80,000")

income_plot <- wg_data %>%
  filter(participated == "yes", !is.na(income), !is.na(program_type)) %>%
  mutate(income = factor(income, levels = income_levels)) %>%
  count(program_type, income)

ggplot(income_plot, aes(x = income, y = n, fill = program_type)) +
  geom_col(position = "dodge") +
  theme_minimal() +
  labs(title = "Income by Program (Participants Only)",
       x = "Income", y = "Count", fill = "Program Type") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  green_palette

cat("Note: Income data is only available for programs with complete responses in the 'income' field.")
## Note: Income data is only available for programs with complete responses in the 'income' field.

#Request 16 Race and Ethnicity of the State of Washington

#request 16 Race and Ethnicity of the State of Washington 
library(readr)
library(dplyr)
library(ggplot2)
library(tigris)
library(sf)
library(stringr)

options(tigris_use_cache = TRUE)

# Load and clean the data
race_data <- read_csv("Data Table_data.csv")
## Rows: 320 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Geography, Selection Filter, Selection Value
## dbl (4): Year, Max. % Total Population, Max. Sub-Population, Max. Total Popu...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Filter and standardize
race_data_clean <- race_data %>%
  filter(
    Geography != "Washington State",
    `Selection Value` != "All",
    !is.na(`Max. Sub-Population`)
  ) %>%
  mutate(
    county = tolower(Geography),
    race_ethnicity = str_to_title(`Selection Value`)
  )

# Load WA counties shapefile
wa_counties <- counties(state = "WA", cb = TRUE, class = "sf") %>%
  mutate(county = tolower(NAME))
## Retrieving data for the year 2022
# Define green palette
green_palette <- scale_fill_gradient(low = "#c2e699", high = "#006d2c", na.value = "gray90")

# Get unique race/ethnicity values
unique_races <- unique(race_data_clean$race_ethnicity)

# Loop through and map each group
for (race in unique_races) {
  cat("Generating map for:", race, "\n")
  
  race_subset <- race_data_clean %>%
    filter(race_ethnicity == race) %>%
    group_by(county) %>%
    summarise(population = sum(`Max. Sub-Population`, na.rm = TRUE), .groups = "drop")
  
  map_data <- left_join(wa_counties, race_subset, by = "county")
  
  print(
    ggplot(map_data) +
      geom_sf(aes(fill = population), color = "black") +
      green_palette +
      labs(
        title = paste("Population by County –", race),
        fill = "Population Count"
      ) +
      theme_minimal() +
      theme(
        axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank()
      )
  )
}
## Generating map for: White Only-Nh

## Generating map for: Pacific Islander Only-Nh

## Generating map for: Multi-Race-Nh

## Generating map for: Hispanic As Race

## Generating map for: Black Only-Nh

## Generating map for: Asian Only-Nh

## Generating map for: American Indian/Alaska Native Only-Nh