Wisconsin ATV Association Survey Analysis

Author

Daniel Lee Consulting LLC

Published

March 14, 2024

The economic impact study carried out by Daniel Lee Consulting LLC for the Wisconsin ATV Association uncovered a significant finding: ATV/UTV riders collectively spent $4.2 billion in Wisconsin during 2023. This report delves into the survey analysis results, providing insights into rider spending habits and other intriguing characteristics.

The NOHVIS Group, in collaboration with the Wisconsin ATV Association, undertook an in-person survey at trailheads from April 2023 to October 2023 to collect data on ATV/UTV riders. A total of 1,072 riders participated in the survey, out of which 948 responses were deemed usable for the purposes of this study.

Code

library(tidyverse)
library(tidyquant) # For graphing format
library(kableExtra) # For styling table

riders_raw <- read_csv("../00_data/data_raw/WATVA_survey.csv")

# riders_raw %>% skimr::skim()

1.0 Clean Data

1.1 Rename and Convert Variables

Code

riders_renamed <- riders_raw %>%
  #filter for actual survey responses
  # filter(!Status %in% c("Survey Preview", "{\"ImportId\":\"status\"}", "Response Type")) %>%
  # filter for actual questions
    select(7:(ncol(.)-2)) %>%
    set_names("ride_for_recreation",
              "participate_2023",
              "age",
              "state",
              "state_other",
              "income",
              "second_home",
              "day_trips",
              "overnight_trips",
              "overnight_trips_n",
              "overnight_trips_food",
              "overnight_trips_transport",
              "overnight_trips_recreate",
              "overnight_trips_souvenir",
              "overnight_trips_entrance",
              "overnight_trips_lodging",
              "day_trips_food",
              "day_trips_transport",
              "day_trips_recreate",
              "day_trips_souvenir",
              "day_trips_entrance",
              "ATV_UTV",
              "ATV_UTV_new",
              "ATV_new_n",
              "UTV_new_n",
              "ATV_UTV_new_dollar",
              "ATV_UTV_new_pct",
              "ATV_UTV_used",
              "ATV_used_n",
              "UTV_used_n",
              "ATV_UTV_used_dollar",
              "ATV_UTV_used_pct",
              "Towing",
              "Towing_new",
              "Towing_new_dollar",
              "Towing_new_pct",
              "Towing_used",
              "Towing_used_dollar",
              "Towing_used_pct",
              "spend_prep_for_trip",
              "spend_prep_for_trip_apparel",
              "spend_prep_for_trip_accessories",
              "spend_prep_for_trip_maintenance",
              "spend_prep_for_trip_insurance",
              "spend_prep_for_trip_govt",
              "spend_prep_for_trip_other",
              "winter_riding_pct",
              "road_route_touring_pct",
              "ATV_owned",
              "UTV_owned",
              "ATV_UTV_purposes",
              "Trail_Riding",
              "Road_Route_Touring",
              "Commuting_to_Work",
              "Farming",
              "Hunting",
              "Shopping",
              "ATV_UTV_purposes_Other") %>%
    
    # NA in State should other than Big Six
    mutate(state = replace_na(state, "Other")) %>%
    
    mutate(across(c(starts_with(c("overnight_trips", "day_trips", "spend_prep_for_trip_")), 
                  contains(c("_new_", "_used_")),
                  ends_with(c("_pct", "_owned"))), as.numeric)) %>%
    mutate(across(c(where(is.character), -ATV_UTV_purposes, -ATV_UTV_purposes_Other), factor)) %>% 
    mutate(income = factor(income, 
                           levels = c("$150,000 or more","$125,000 to $149,999",
                                      "$100,000 to $124,999","$75,000 to $99,999",
                                      "$50,000 to $74,999","$35,000 to $49,999",
                                      "$25,000 to $34,999","Less than $25,000","Prefer not to answer"))) %>%
    
    # Add unique identification # to each response
    mutate(ID = as.factor(row_number()))

1.2 Remove Unusable Responses

Code

# Breakouts by recreational rider and participation in 2023
riders_renamed %>% count(ride_for_recreation, participate_2023)

# Breakouts by day_trips and overnight_trips
riders_renamed %>% 
    group_by(day_trips > 0, overnight_trips > 0) %>% 
    summarise(n = n()) %>% 
    filter(`day_trips > 0` == TRUE | `overnight_trips > 0` == TRUE) %>% 
    ungroup() %>% 
    add_tally(wt = n)

Code

# Remove unusable responses.

rec_riders_2023 <- riders_renamed %>%
    
    # Reduces to 1,023 from 1,072
    filter(ride_for_recreation == "Yes", participate_2023 == "Yes") %>%
    
    # Reduces to 948 from 1,023
    filter(day_trips > 0 | overnight_trips > 0) %>%
    
    # Move ID to the first column
    select(ID, everything(), -ride_for_recreation, -participate_2023, 
           -age, -state_other, -income, -second_home, - ATV_UTV_purposes, 
           -c(winter_riding_pct:ATV_UTV_purposes_Other))

1.3 Clean Up Reporting Errors

Code

# Correct the reporting errors.

riders_clean <- rec_riders_2023 %>%
    
    # Drop ATV_UTV and Towing 
    select(-ATV_UTV, -Towing) %>%
    
    # Replace responses with NA for the follow-up Q for Riders who reported no purchase of new ATV/UTV
    mutate(ATV_new_n          = if_else(str_detect(ATV_UTV_new, "No"), NA, ATV_new_n )) %>%
    mutate(UTV_new_n          = if_else(str_detect(ATV_UTV_new, "No"), NA, UTV_new_n )) %>%
    mutate(ATV_UTV_new_dollar = if_else(str_detect(ATV_UTV_new, "No"), NA, ATV_UTV_new_dollar)) %>%
    mutate(ATV_UTV_new_pct    = if_else(str_detect(ATV_UTV_new, "No"), NA, ATV_UTV_new_pct)) %>%
    
    # Replace responses with NA for the follow-up Q for Riders who reported no purchase of used ATV/UTV
    mutate(ATV_used_n          = if_else(str_detect(ATV_UTV_used, "No"), NA, ATV_used_n )) %>%
    mutate(UTV_used_n          = if_else(str_detect(ATV_UTV_used, "No"), NA, UTV_used_n )) %>%
    mutate(ATV_UTV_used_dollar = if_else(str_detect(ATV_UTV_used, "No"), NA, ATV_UTV_used_dollar)) %>%
    mutate(ATV_UTV_used_pct    = if_else(str_detect(ATV_UTV_used, "No"), NA, ATV_UTV_used_pct)) %>%
    
    # Replace responses with NA for the follow-up Q for Riders who reported no purchase of new Towing T
    mutate(Towing_new_dollar = if_else(str_detect(Towing_new, "No"), NA, Towing_new_dollar)) %>%
    mutate(Towing_new_pct    = if_else(str_detect(Towing_new, "No"), NA, Towing_new_pct)) %>%
    
    # Replace responses with NA for the follow-up Q for Riders who reported no purchase of used Towing T
    mutate(Towing_used_dollar = if_else(str_detect(Towing_used, "No"), NA, Towing_used_dollar)) %>%
    mutate(Towing_used_pct    = if_else(str_detect(Towing_used, "No"), NA, Towing_used_pct))

1.4 Remove Outliers

To ensure the precision of spending estimates, a rigorous process of outlier removal was implemented on spending-related survey data subsequent to applying the cubic transformation.

Outliers typically exhibit extreme values, either significantly larger than the median plus 1.5 times the interquartile range (IQR) or considerably smaller than the median minus 1.5 times the IQR.

Utilizing the cubic transformation results in a more normalized distribution of spending, thus providing a more conservative approach to outlier identification. This method helps to enhance the reliability of the data analysis process.

Code

riders_outlierRemoved <- riders_clean %>%
    
    # Revise ATV price  to be per unit
    # replace_na(list(ATV_new_n = 0, UTV_new_n = 0, ATV_used_n = 0, UTV_used_n = 0)) %>%
    # mutate(ATV_UTV_new_dollar  = ATV_UTV_new_dollar  / (ATV_new_n + UTV_new_n),
    #        ATV_UTV_used_dollar = ATV_UTV_used_dollar / (ATV_used_n + UTV_used_n)) %>%
    
    # Outlier removal step2: Tukey’s procedure
    pivot_longer(names_to = "categories", values_to = "spending", where(is.numeric)) %>%
    group_by(categories)  %>%
    mutate(spending_cubed = spending ^ (1/3), 
           upper_whisker = boxplot.stats(spending_cubed)$stats[5],
           lower_whisker = boxplot.stats(spending_cubed)$stats[1],
           spending = ifelse(spending_cubed > upper_whisker | spending_cubed < lower_whisker, 
                             NA, spending)) %>%
    ungroup() %>% 
    select(-spending_cubed,-upper_whisker,-lower_whisker) %>%
    
    pivot_wider(names_from = categories, values_from = spending)


# Save the wrangled data
write_rds(riders_outlierRemoved, "../00_data/data_wrangled/01_riders_outlierRemoved.rds")

Code

fig_outlier <- rec_riders_2023 %>%
  select(starts_with("overnight_trips_"), -overnight_trips_n) %>%
  
  #outlier removel 
  pivot_longer(names_to = "categories", values_to = "spending", everything())  %>%
  group_by(categories) %>%
  mutate(spending_median = median(spending, na.rm = TRUE)) %>%
  ungroup() %>%
  
  # Remove "overnight_trips_" from texts 
  mutate(categories = str_remove(categories, "overnight_trips_")) %>% 
  ggplot(aes(spending^(1/3), fct_reorder(categories, spending_median), fill = categories)) +
  geom_boxplot(show.legend = NULL) +
  labs(title = "with cubic transformation") +
  scale_fill_tq() +
  scale_x_continuous(labels = scales::dollar, breaks = seq(0,80,10)) +
  theme_tq() +
  labs(
    title = "Figure 5: Expenditure Outlier Example",
    subtitle = "Distributions of Overnight Trip Expenditures",
    x = "Expenditure ^ (1/3) (i.e., Cubic Root)",
    y = ""
  )
  
fig_outlier

Code

write_rds(fig_outlier, "../00_data/figures/01_fig_outlier.rds")

The dots in the figure indicate outliers, with those on the right side of the box representing extremely large values exceeding the median plus 1.5 times the IQR. These outliers were excluded from the calculation of average expenditure by category. For instance, expenditures of $1,000 or more per trip were deemed outliers and excluded when estimating the average overnight trip spending on food. Conversely, dots on the left side of the box represent extremely small values below the median minus 1.5 times the IQR, which were also removed. For example, instances of $0 spending (indicating no expenditure) were considered outliers and excluded when estimating overnight trip spending on food. This process ensures that outliers do not unduly influence the calculation of average expenditure, leading to more accurate and reliable results.

2.0 Estimate Spending

2.1 Estimate Number of Trips

In 2023, Wisconsin residents reported an average of 21.9 day trips and 5 overnight trips. Conversely, non-residents reported an average of 10.6 day trips and 6.3 overnight trips during the same period.

An intriguing finding is that non-resident riders indicated more day trips than overnight trips, despite the distances from their homes to ATV trails. This observation suggests that non-residents may predominantly select ATV trails situated near the border, which are not far from their residences.

Code

n_trips <- riders_outlierRemoved %>%
  #create profiles by trip types
  mutate(state = case_when(
    state == "Wisconsin" ~ "Wisconsin",
    state != "Wisconsin" ~ "Out of State"
  )) %>%
  mutate(state = factor(state, levels = c("Wisconsin", "Out of State"))) %>%
  group_by(state) %>%
  summarise(avg_day_trips = mean(day_trips, na.rm = TRUE),
            avg_overnight_trips = mean(overnight_trips, na.rm = TRUE),
            se_day_trips = sd(day_trips, na.rm = TRUE)/sqrt(n()),
            se_overnight_trips = sd(overnight_trips, na.rm = TRUE)/sqrt(n()),
            sample_size = n()) 

# save the file
write_rds(n_trips, "../00_data/data_wrangled/01_n_trips.rds")

n_trips %>%
    set_names("State", "Day", "Overnight", "Day", "Overnight", "Sample Size") %>%
    knitr::kable(digits = 1, caption = "Average Number of Trips per Year") %>% 
    add_header_above(c(" " = 1, "Estimate" = 2, "Standard Error" = 2, " " = 1), align = "c")

Average Number of Trips per Year
	Estimate		Standard Error
State	Day	Overnight	Day	Overnight	Sample Size
Wisconsin	21.9	5.0	0.8	0.2	831
Out of State	10.6	6.3	1.3	0.7	117

2.2 Spending While on Trip

Code

# Estimate spending, standard errors, and sample size
exp_trip <- riders_outlierRemoved %>%
  #select trip expenditure
  select(!starts_with("ATV") & !starts_with("UTV") & !starts_with("Tow") & !starts_with("spend")) %>%
  #create profiles by trip types
  mutate(state = case_when(
    state == "Wisconsin" ~ "Wisconsin",
    state != "Wisconsin" ~ "Out of State"
  )) %>%
  mutate(state = fct_relevel(state, "Wisconsin")) %>%
  select(-day_trips,-overnight_trips,-overnight_trips_n) %>% 
  pivot_longer(-c(ID, state), names_to = "categories", values_to = "spending") %>%
  group_by(state, categories) %>%
  summarise(estimate = mean(spending, na.rm = TRUE),
            se = sd(spending, na.rm = TRUE)/sqrt(n()),
            sample_size = n()) %>%
  ungroup() 

# Save the data
write_rds(exp_trip, "../00_data/data_wrangled/01_exp_trip.rds")

Code

# Get total
total <- exp_trip %>% 
    filter(str_detect(categories, "day")) %>% 
    group_by(state) %>% 
    summarise(total = sum(estimate))

# Table for day trip expenditure
exp_trip %>%
  pivot_wider(names_from = state,
              names_sep = ".", 
              values_from = c(estimate, se, sample_size)) %>%
  filter(str_detect(categories, "day")) %>%
  mutate(categories = str_remove(categories, "day_trips_")) %>%
  arrange(desc(`estimate.Wisconsin`)) %>% 
    
    # Add row of total
    tibble::add_row(categories = "total", 
                    estimate.Wisconsin = total$total[total$state == "Wisconsin"],
                    `estimate.Out of State` = total$total[total$state == "Out of State"]) %>%
    
    set_names("Categories", "Resident", "Nonresident",
              "Resident", "Nonresident", 
              "Resident", "Nonresident") %>%
  knitr::kable(digits = 1, caption = "Day Trip Spending per Trip") %>% 
    add_header_above(c(" " = 1, "Estimate" = 2, "Standard Error" = 2, "Sample Size" = 2), align = "c")

Day Trip Spending per Trip
	Estimate		Standard Error		Sample Size
Categories	Resident	Nonresident	Resident	Nonresident	Resident	Nonresident
food	95.0	106.0	2.0	4.9	831	117
transport	71.0	87.9	1.8	5.7	831	117
recreate	55.9	52.4	2.2	5.0	831	117
souvenir	31.2	32.9	1.4	4.1	831	117
entrance	27.6	14.4	1.9	2.0	831	117
total	280.6	293.7	NA	NA	NA	NA

Code

# Get total
total <- exp_trip %>% 
    filter(str_detect(categories, "overnight")) %>% 
    group_by(state) %>% 
    summarise(total = sum(estimate))

# Table for overnight trip expenditure
exp_trip %>%
    pivot_wider(names_from = state,
                names_sep = ".", 
                values_from = c(estimate, se, sample_size)) %>%
    filter(str_detect(categories, "overnight")) %>%
    mutate(categories = str_remove(categories, "overnight_trips_")) %>%
    arrange(desc(`estimate.Wisconsin`)) %>% 
    
    # Add row of total
    tibble::add_row(categories = "total", 
                    estimate.Wisconsin = total$total[total$state == "Wisconsin"],
                    `estimate.Out of State` = total$total[total$state == "Out of State"]) %>%
    
    set_names("Categories", "Resident", "Nonresident",
              "Resident", "Nonresident", 
              "Resident", "Nonresident")  %>%
    knitr::kable(digits = 1, caption = "Overnight Trip Spending per Trip") %>% 
    add_header_above(c(" " = 1, "Estimate" = 2, "Standard Error" = 2, "Sample Size" = 2), align = "c")

Overnight Trip Spending per Trip
	Estimate		Standard Error		Sample Size
Categories	Resident	Nonresident	Resident	Nonresident	Resident	Nonresident
food	229.8	250.2	5.6	14.2	831	117
lodging	202.6	231.8	7.8	27.3	831	117
transport	153.1	149.7	4.0	10.1	831	117
recreate	113.7	110.4	4.4	9.8	831	117
souvenir	61.0	84.0	3.2	12.2	831	117
entrance	33.0	35.1	1.9	7.3	831	117
total	793.2	861.1	NA	NA	NA	NA

During day trips, resident riders in Wisconsin spent an average of $281, while nonresident riders spent slightly more at $294. The breakdown of itemized spending by residency is illustrated in the plot above.

Among day-trip expenses, ATV/UTV riders allocate the majority of their spending to gasoline and food. Notably, non-residents tend to spend more per trip compared to residents.

Code

# Graph for day trip expenditure
fig_spending_per_day_trip <- exp_trip %>%
  filter(str_detect(categories, "day_trips")) %>%
  mutate(categories = str_remove(categories, "day_trips_")) %>%
  ggplot(aes(estimate, fct_reorder(categories, estimate))) +
  geom_point() +
  geom_errorbar(aes(xmin = estimate - 1.96*se,
                    xmax = estimate + 1.96*se)) +
  scale_x_continuous(labels = scales::dollar) +
  facet_wrap(~state) +
  labs(
    title = "Figure 6: Day Trip Spending per Trip",
    subtitle = "95 Confidence Interval",
    x = NULL,
    y = NULL
  ) +
  tidyquant::theme_tq()

fig_spending_per_day_trip

Code

write_rds(fig_spending_per_day_trip, "../00_data/figures/01_fig_spending_per_day_trip.rds")

During overnight trips, resident riders in Wisconsin spent an average of $793, while nonresident riders spent slightly more at $861. The breakdown of itemized spending by residency is illustrated in the plot above.

On overnight trips, ATV/UTV riders tend to spend more compared to their day trips, with lodging and food being the primary expenses. Similar to day trips, non-residents likely spend more per trip compared to residents.

Code

# Graph for overnight trip expenditure
fig_spending_per_overnight_trip <- exp_trip %>%
  filter(str_detect(categories, "overnight_trips")) %>%
  mutate(categories = str_remove(categories, "overnight_trips_")) %>%
  ggplot(aes(estimate, fct_reorder(categories, estimate))) +
  geom_point() +
  geom_errorbar(aes(xmin = estimate - 1.96*se,
                    xmax = estimate + 1.96*se)) +
  scale_x_continuous(labels = scales::dollar) +
  facet_wrap(~state) +
  labs(
    title = "Figure 7: Overnight Trip Spending per Trip",
    subtitle = "95 Confidence Interval",
    x = NULL,
    y = NULL
  ) +
  tidyquant::theme_tq()

fig_spending_per_overnight_trip

Code

write_rds(fig_spending_per_overnight_trip, "../00_data/figures/01_fig_spending_per_overnight_trip.rds")

2.3 Spending on Equipment

Code

# Estimate spending, standard errors, and sample size
exp_equipment <- riders_outlierRemoved %>%
  #create profiles by trip types
  mutate(state = case_when(
    state == "Wisconsin" ~ "Wisconsin",
    state != "Wisconsin" ~ "Out of State"
  )) %>%
  mutate(state = fct_relevel(state, "Wisconsin")) %>%
  # Count all riders by state
  add_count(state, name = "n_state_all") %>%
  #filter for only those who spend $ on equipment
  filter(spend_prep_for_trip == "Yes") %>%
  # Count those riders who bought equipment
  add_count(state, name = "n_state_spend") %>%
  #select trip expenditure
  select(state, starts_with("n_"), starts_with("spend"), -spend_prep_for_trip) %>% 
  pivot_longer(starts_with("spend"), names_to = "categories", values_to = "spending") %>%
  mutate(categories = str_remove(categories, "spend_prep_for_trip_")) %>%
  group_by(state, categories) %>%
  summarise(estimate = mean(spending, na.rm = TRUE),
            se = sd(spending, na.rm = TRUE)/sqrt(n()),
            pct_buying = mean(n_state_spend)/mean(n_state_all),
            sample_size = mean(n_state_spend)) %>%
  ungroup() 

# Save the data
write_rds(exp_equipment, "../00_data/data_wrangled/01_exp_equipment.rds")

Resident ATV/UTV owners in Wisconsin allocate an average of $1,867 annually on equipment, while nonresident ATV/UTV owners spend slightly less at $1,444. The breakdown of itemized spending by residency is illustrated in the plot above.

In contrast to trip expenditures, Wisconsin residents tend to invest more in equipment and accessories compared to non-residents. This disparity in spending patterns may be explained by non-resident ATV/UTV owners choosing to purchase equipment items such as accessories and vehicle maintenance services closer to their homes, within their own state.

Regarding spending on equipment and accessories for their trips, nearly half of the ATV/UTV owners made purchases within Wisconsin in 2023. Specifically, 54.3% (451 out of 831) of residents and 39.3% (46 out of 117) of non-residents made purchases within Wisconsin during the same period.

Code

# Get total
total <- exp_equipment %>% 
    group_by(state) %>% 
    summarise(total = sum(estimate))

# Create a table
exp_equipment %>%
  pivot_wider(names_from = state,
              names_sep = "_", 
              values_from = c(estimate, se,pct_buying, sample_size)) %>%
  arrange(desc(`estimate_Wisconsin`)) %>% 
    
    # Add row of total
    tibble::add_row(categories = "total", 
                    estimate_Wisconsin = total$total[total$state == "Wisconsin"],
                    `estimate_Out of State` = total$total[total$state == "Out of State"])  %>%
    
  set_names(names(.) %>% str_replace_all("_", " ") %>% str_replace("se", "Standard Error") %>% str_to_title()) %>%
  mutate(across(c(starts_with("Estimate"), starts_with("Standard")), ~scales::dollar(., accuracy = 1)),
         across(starts_with("Pct"), ~scales::percent(., accuracy = 0.1))) %>%
    set_names("Categories", "Resident", "Nonresident",
              "Resident", "Nonresident", 
              "Resident", "Nonresident", 
              "Resident", "Nonresident")  %>%
  knitr::kable(digits = 1, align = c("lrrrrrrrr"), caption = "Annual Equipment Spending per ATV/UTV Owner") %>% 
    add_header_above(c(" " = 1, "Estimate" = 2, "Standard Error" = 2, "Percent of riders who bought equipment" = 2, "Sample Size" = 2), align = "c")

Annual Equipment Spending per ATV/UTV Owner
	Estimate		Standard Error		Percent of riders who bought equipment		Sample Size
Categories	Resident	Nonresident	Resident	Nonresident	Resident	Nonresident	Resident	Nonresident
accessories	$806	$484	$44	$74	48.7%	39.3%	405	46
maintenance	$404	$336	$17	$37	48.7%	39.3%	405	46
insurance	$300	$321	$10	$30	48.7%	39.3%	405	46
apparel	$203	$189	$12	$25	48.7%	39.3%	405	46
govt	$86	$76	$3	$8	48.7%	39.3%	405	46
other	$68	$38	$4	$5	48.7%	39.3%	405	46
total	$1,867	$1,444	NA	NA	NA	NA	NA	NA

Code

# Create a graph
library(tidytext) # For reorder_within()

fig_spending_equipment_per_rider <- exp_equipment %>%
  ggplot(aes(estimate, 
             tidytext::reorder_within(categories, estimate, state))) +
  geom_point() +
  geom_errorbar(aes(xmin = estimate - 1.96*se,
                    xmax = estimate + 1.96*se)) +
  scale_x_continuous(labels = scales::dollar) +
  facet_wrap(~state, scales = "free_y") +
  scale_y_reordered() +
  labs(
    title = "Figure 8: Annual Equipment Spending per ATV/UTV Owner",
    subtitle = "95 Confidence Interval",
    x = NULL,
    y = NULL
  ) +
  tidyquant::theme_tq()

fig_spending_equipment_per_rider

Code

write_rds(fig_spending_equipment_per_rider, "../00_data/figures/01_fig_spending_equipment_per_rider.rds")

2.4 Spending on Vehicles

Code

#ATV_UTV spending
exp_ATV_UTV <- riders_outlierRemoved %>%
  # Count all responses
  add_tally(name = "n_all") %>%
  #filter for only those who spend $ on ATV_UTV
  filter(ATV_UTV_new_dollar > 0 | ATV_UTV_used_dollar > 0) %>%
  #select trip expenditure
  select(ID, starts_with("n_"), (ends_with("dollar") & contains("ATV_UTV"))) %>% 
  pivot_longer(ends_with("dollar"), names_to = "categories", values_to = "spending", values_drop_na = TRUE) %>%
  group_by(categories) %>%
  summarise(estimate = mean(spending),
            se = sd(spending)/sqrt(n()),
            pct_buying = n()/mean(n_all),
            sample_size = n()) %>%
  ungroup() 

#Towing truck spending
exp_Towing <- riders_outlierRemoved %>%
  # Count all responses
  add_tally(name = "n_all") %>%
  #filter for only those who spend $ on OHRV
  filter(Towing_new_dollar > 0 | Towing_used_dollar > 0) %>%
  #select trip expenditure
  select(ID, starts_with("n_"), (ends_with("dollar") & contains("Towing"))) %>% 
  pivot_longer(ends_with("dollar"), names_to = "categories", values_to = "spending", values_drop_na = TRUE) %>%
  group_by(categories) %>%
  summarise(estimate = mean(spending, na.rm = TRUE),
            se = sd(spending, na.rm = TRUE)/sqrt(n()),
            pct_buying = n()/mean(n_all),
            sample_size = n()) %>%
  ungroup() 

# Combine spending on OHRV and towing truck
exp_vehicle <- rbind(exp_ATV_UTV, exp_Towing) %>%
  mutate(categories = str_remove(categories, "_dollar")) %>%
  mutate(categories = case_when(
    categories == "ATV_UTV_new" ~ "New ATV_UTV",
    categories == "ATV_UTV_used" ~ "Used ATV_UTV",
    categories == "Towing_new" ~ "New Towing Truck",
    categories == "Towing_used" ~ "Used Towing Truck"
  ))

# Save the data
write_rds(exp_vehicle, "../00_data/data_wrangled/01_exp_vehicle.rds")

Code

# Create table
exp_vehicle %>%
  mutate(across(c(estimate, se), ~scales::dollar(.,accuracy = 1)),
         pct_buying = scales::percent(pct_buying, accuracy = 0.1)) %>%
    set_names("Categories", "Spending", "Standard Error",
              "Pct Buying", "Sample Size")  %>%
  knitr::kable(digits = 1, caption = "Spending on Vehicle per Buyer")

Spending on Vehicle per Buyer
Categories	Spending	Standard Error	Pct Buying	Sample Size
New ATV_UTV	$28,136	$1,234	7.6%	72
Used ATV_UTV	$10,977	$1,542	3.9%	37
New Towing Truck	$60,882	$2,725	4.3%	41
Used Towing Truck	$36,571	$3,440	1.5%	14

Code

# Create graph
fig_spending_vehicle_per_rider <- exp_vehicle %>%
  ggplot(aes(estimate, 
             fct_reorder(categories, estimate))) +
  geom_point() +
  geom_errorbar(aes(xmin = estimate - 1.96*se,
                    xmax = estimate + 1.96*se)) +
  scale_x_continuous(labels = scales::dollar) +
  labs(
    title = "Figure 9: Spending on Vehicle per Buyer",
    subtitle = "95 Confidence Interval",
    x = NULL,
    y = NULL
  ) +
  tidyquant::theme_tq()

fig_spending_vehicle_per_rider

Code

write_rds(fig_spending_vehicle_per_rider, "../00_data/figures/01_fig_spending_vehicle_per_rider.rds")

The survey revealed that 7.6% of riders purchased a new ATV or UTV in Wisconsin during 2023, with an average expenditure of $28,000 per person. Furthermore, 3.9% of respondents acquired a used ATV or UTV, spending an average of $11,000.

In addition to ATV/UTV purchases, the survey identified that 4.3% of participants bought a new towing truck, spending an average of $61,000 per person. Similarly, 1.5% of respondents opted for a used towing truck, with an average expenditure of $37,000.

These spending figures represent a significant increase of over 80% compared to the findings reported in the 2020 New Hampshire study¹. It’s important to note that while spending per person does not necessarily equate to the price per unit, as individuals may purchase multiple units, this substantial increase between the two studies likely reflects inflation, particularly in vehicle prices since the pandemic.

The inflation in vehicle prices may also explain the notable decrease in the proportion of respondents who purchased vehicles, as reported in the 2020 New Hampshire study, with most proportions declining by nearly half. This decline in vehicle purchases can be attributed to the considerable increases in vehicle prices.

2.5 Usage of Vehicles

Code

#ATV_UTV usage
usage_ATV_UTV <- riders_outlierRemoved %>%

  filter(ATV_UTV_new_pct > 0 | ATV_UTV_used_pct > 0) %>%
  # Count riders who bought either new or used ATV/UTV
  add_tally(name = "n_ATV_UTV_new_used") %>%
  #select trip expenditure
  select(ID, starts_with("n_"), matches("ATV.*_pct")) %>% 
  pivot_longer(ends_with("pct"), names_to = "categories", values_to = "usage", values_drop_na = TRUE) %>%
  group_by(categories) %>%
  summarise(estimate = mean(usage),
            se = sd(usage)/sqrt(n()),
            sample_size = n()) %>%
  ungroup() 

#Towing truck usage
usage_Towing <- riders_outlierRemoved %>%

  filter(Towing_new_pct > 0 | Towing_used_pct > 0) %>%
  # Count riders who bought either new or used ATV/UTV
  add_tally(name = "n_Towing_new_used") %>%
  #select trip expenditure
  select(ID, starts_with("n_"), matches("Towing.*_pct")) %>% 
  pivot_longer(ends_with("pct"), names_to = "categories", values_to = "usage", values_drop_na = TRUE) %>%
  group_by(categories) %>%
  summarise(estimate = mean(usage),
            se = sd(usage)/sqrt(n()),
            sample_size = n()) %>%
  ungroup() 

# Combine usages of ATV_UTV and towing truck
usage_vehicle <- rbind(usage_ATV_UTV, usage_Towing) %>%
  mutate(categories = str_remove(categories, "_pct")) %>%
  mutate(categories = case_when(
    categories == "ATV_UTV_new" ~ "New ATV_UTV",
    categories == "ATV_UTV_used" ~ "Used ATV_UTV",
    categories == "Towing_new" ~ "New Towing Truck",
    categories == "Towing_used" ~ "Used Towing Truck"
  ))

# Save the data
write_rds(usage_vehicle, "../00_data/data_wrangled/01_usage_vehicle.rds")

Code

# Create table
usage_vehicle %>%
  # mutate(across(c(estimate, se), ~scales::percent(.,accuracy = 0.1))) %>%
    set_names("Categories", "Pct Trail Riding", "Standard Error", "Sample Size") %>%
  knitr::kable(digits = 1, caption = "Usage of Vehicles")

Usage of Vehicles
Categories	Pct Trail Riding	Standard Error	Sample Size
New ATV_UTV	75.1	2.7	80
Used ATV_UTV	66.0	5.0	43
New Towing Truck	35.2	5.1	45
Used Towing Truck	30.7	7.3	16

Code

# Create graph
fig_usage_vehicle_per_rider <- usage_vehicle %>%
  ggplot(aes(estimate, 
             fct_reorder(categories, estimate))) +
  geom_point() +
  geom_errorbar(aes(xmin = estimate - 1.96*se,
                    xmax = estimate + 1.96*se)) +
  # scale_x_continuous(labels = scales::percent) +
  labs(
    title = "Figure 10: Usage of Vehicles",
    subtitle = "95 Confidence Interval",
    y = NULL,
    x = "Percent Use for Trail Riding",
    caption = "The survey asked, ' Thinking of the usage in 2023 of the NEW ATV or UTV
    you bought or will buy, what percentage is for trail riding?'
    A similar question was asked regarding the towing truck usage."
  ) +
  tidyquant::theme_tq()

fig_usage_vehicle_per_rider

Code

write_rds(fig_usage_vehicle_per_rider, "../00_data/figures/01_fig_usage_vehicle_per_rider.rds")

Vehicles serve purposes beyond recreational riding activity, necessitating careful consideration when estimating the economic contributions of ATV/UTV riders. To ensure accuracy, vehicle spending should only be attributed to recreational riding activity, excluding other uses like commuting, shopping, or other outdoor recreational pursuits such as hunting.

Respondents who purchased a new ATV/UTV in Wisconsin during 2023 reported using the vehicle for recreational riding 75.1% of the time. Similarly, individuals who purchased a new towing truck in Wisconsin during the same period reported allocating the vehicle for recreational riding 35.2% of the time. These percentages provide valuable insights for refining economic estimations, facilitating more accurate assessments of economic contributions.

3.0 Rider Characteristics

The survey also inquired about rider characteristics beyond their spending behaviors. Unlike the spending data presented earlier, the data in this section have not been adjusted for outliers. They represent raw data collected from the survey. However, obvious reporting errors were rectified. For instance, if someone reported a value exceeding 100% for a question regarding the percentage of their winter riding compared to their total riding time, that data point was excluded. It’s important to note that the data presented in this section are not utilized in measuring the economic contribution of riders.

* Clean Data

Code

riders <- riders_outlierRemoved %>% 
    left_join(riders_renamed %>% 
                  select(ID, age, state_other, income, second_home, 
                         c(winter_riding_pct:ATV_UTV_purposes_Other)))

numeric_vec <- c("winter_riding_pct", "road_route_touring_pct", "ATV_owned", "UTV_owned")
factor_vec  <- c("state", "state_other", "age", "income", "second_home", "Trail_Riding", "Road_Route_Touring", 
                 "Commuting_to_Work", "Farming", "Hunting", "Shopping")
    
riders_clean <- riders %>% 
    select(ID, state, age:ATV_UTV_purposes_Other, -ATV_UTV_purposes, -ATV_UTV_purposes_Other) %>%
    
    # Set max at 100% where it must not be higher than 100%
    
    mutate(across(contains("pct"), function(x) if_else(x > 100, NA, x))) %>%
    
    # Set max # of vehicles owned at 20
    
    # mutate(across(contains("own"), function(x) if_else(x > 20, NA, x))) %>%
    
    # State: Wisconsin versus Others
    mutate(state = case_when(
      state == "Wisconsin" ~ "Resident",
      state != "Wisconsin" ~ "nonResident"
    )) %>%
    
    # Convert character to numeric
    mutate(across(all_of(numeric_vec), as.numeric)) %>%
    
    # Convert character to factor
    mutate(across(all_of(factor_vec), as_factor))

3.1 Age

Riders typically fall within the middle age range. Age groups under 35 constitute less than 7% of both resident and nonresident riders. The largest age demographic falls within the 55-64 years old bracket.

Code

fig_rider_age <- riders_clean %>%
    filter(!is.na(age), age != "invalid") %>%
    
    group_by(state) %>%
    count (age) %>%
    add_tally(wt = n) %>%
    mutate(pct = (n/nn*100) %>% round(1),
           pct_txt = paste0(pct, "%")) %>%
    ungroup() %>% 
    
    ggplot(aes(n, age, fill = state)) + 
    geom_col() +
    geom_text(aes(label = pct_txt), hjust = -0.1) +
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    expand_limits(x = c(0,350)) +
    facet_wrap(~state, scales = "free_x") +
    labs(
      title = "Age Distribution of Riders",
      y = "Age Categories",
      x = "Number of Survey Responses",
      caption = "The survey asked, 'What is your age?'"
    )

fig_rider_age

Code

write_rds(fig_rider_age, "../00_data/figures/01_fig_rider_age.rds")

3.2 State of Origin

The overwhelming majority of riders originate from within Wisconsin, with 87.7% reporting residency within the state. The second-largest group, comprising only 5.4% of riders, hails from Illinois, a statistic likely reflective of residents from Chicago and its surrounding areas. It’s noteworthy that nonresident riders in Wisconsin predominantly come from neighboring states.

Code

fig_rider_state_of_origin <- riders %>% 
    count(state, sort = T) %>%
    add_tally(wt = n) %>%
    mutate(pct = (n/nn*100) %>% round(1),
           pct_txt = paste0(pct, "%")) %>%

    ggplot(aes(n, fct_reorder(state, n))) +
    geom_col(fill = "midnightblue") +
    geom_text(aes(label = pct_txt), hjust = -0.1) +
    theme_tq() +
    expand_limits(x = c(0, 1000))  +
    labs(title = "State of Origin",
         subtitle = "ATVing in Wisconsin during 2020",
         y = NULL,
         x = "Number of Survey Responses",
         caption = "Other includes Florida, Pennsylvania, Tennessee, New York, and Arizona.
         The survey asked, 'In which state do you current reside?'")

fig_rider_state_of_origin

Code

write_rds(fig_rider_state_of_origin, "../00_data/figures/01_fig_rider_state_of_origin.rds")

3.3 Second Home

Many riders possess second homes, indicating a propensity for multiple residences within the riding community. Approximately 25% of resident riders reported owning a second home. Notably, this percentage is even higher among nonresident riders, suggesting a greater prevalence of secondary residences among those who ride in Wisconsin but reside elsewhere.

Code

fig_rider_second_home <- riders_clean %>%
    
    filter(!is.na(second_home)) %>%

    ggplot(aes(state, fill = second_home)) +
    geom_bar(position = "fill") +
    theme_tq() +
    scale_fill_tq() +
    scale_y_continuous(labels = scales::percent_format()) +
    # expand_limits(x = c(0, 5))  +
    labs(title = "Second Home Ownership",
         subtitle = "ATVing in Wisconsin during 2023",
         y = "Proportion",
         x = NULL, fill = NULL,
         caption = "The survey asked, 'Do you own a second home in Wisconsin?'")

fig_rider_second_home

Code

write_rds(fig_rider_second_home, "../00_data/figures/01_fig_rider_second_home.rds")

3.4 Household Income

Riders tend to have higher household incomes. Among both resident and nonresident riders, the highest income group, earning $150,000 or more per year, ranks at the top. However, while this income bracket is the highest for both groups, it constitutes a significantly larger proportion of the total among nonresidents compared to residents.

Code

fig_rider_income <- riders_clean %>%
    
    filter(!is.na(income), income != "Prefer not to answer") %>%
    mutate(income = fct_rev(income)) %>%

    group_by(state) %>%
    count(income, sort = T) %>%
    add_tally(wt = n) %>%
    mutate(pct = (n/nn*100) %>% round(1),
           pct_txt = paste0(pct, "%"))%>%
    ungroup() %>%

    ggplot(aes(n, income, fill = state)) +
    geom_text(aes(label = pct_txt), hjust = -0.01) + 
    geom_col() +
    facet_wrap(~state) + 
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    expand_limits(x = c(0, 220))  +
    labs(title = "Houehold Income of Riders",
         subtitle = "ATVing in Wisconsin during 2023",
         y = NULL,
         x = "Number of Survey Responses",
         caption = "The survey asked, 'What is your total household income?'")

fig_rider_income

Code

write_rds(fig_rider_income, "../00_data/figures/01_fig_rider_income.rds")

3.5 Winter Riding

Among surveyed riders, a substantial majority, accounting for 75%, reported that their winter riding activities constitute less than 20% of their total riding time. Interestingly, winter riding seems to be even less common among nonresident riders. For instance, the median nonresident rider, as indicated by the horizontal line in the box of the plot, reported no winter riding at all. In contrast, the median resident rider indicated that winter riding comprises approximately 10% of their total riding time.

Code

fig_rider_winter_riding <- riders_clean %>%
    
    # Remove reporting errors
    filter(winter_riding_pct <= 100) %>% 
    
    ggplot(aes(state, winter_riding_pct, fill = state)) +
    geom_boxplot() +
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    labs(title = "Percent of Winter Riding in Total",
         subtitle = "ATVing in Wisconsin during 2023",
         y = "Percent of Winter Riding",
         x = NULL,
         caption = "The survey asked, 'Thinking of ATV/UTV recreational riding in 2023, 
         what percentage will be for winter riding?'")

fig_rider_winter_riding

Code

write_rds(fig_rider_winter_riding, "../00_data/figures/01_fig_rider_winter_riding.rds")

3.6 Road Route Touring

Road route touring appears to be highly popular among surveyed riders. For resident riders, 50% indicated that road route touring constitutes between 20% and 60% of their total riding time, as depicted by the height of the box in the plot. Similarly, nonresident riders exhibit a comparable distribution, albeit slightly lower. The median resident rider, represented by the horizontal line in the box of the plot, reported that road route touring makes up approximately 30% of their total riding time.

Code

fig_rider_road_route_touring <- riders_clean %>%
    
    # Remove reporting errors
    filter(road_route_touring_pct <= 100) %>% 
    
    ggplot(aes(state, road_route_touring_pct, fill = state)) +
    geom_boxplot() +
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    labs(title = "Percent of Road Route Touring in Total",
         subtitle = "ATVing in Wisconsin during 2023",
         y = "Percent of Road Route Touring",
         x = NULL,
         caption = "The survey asked, 'Thinking of ATV / UTV riding in 2023, 
         what percentage will be for only road route touring?'")

fig_rider_road_route_touring

Code

write_rds(fig_rider_road_route_touring, "../00_data/figures/01_fig_rider_road_route_touring.rds")

3.7 Number of ATV/UTVs Owned

The majority of riders, regardless of residence status, own one or two vehicles. However, there are outliers within the resident group. For instance, one rider reported owning 65 vehicles, while another reported owning 25 vehicles. These outliers likely represent rental businesses. It’s worth noting that rental businesses are not within the scope of this study and are not considered in measuring the economic contribution of riders.

Code

fig_rider_n_ATV_UTV_owned <- riders_clean %>%
    
    group_by(state) %>%
    mutate(ATV_UTV_owned = ATV_owned + UTV_owned) %>%
    count(ATV_UTV_owned) %>%
    filter(!is.na(ATV_UTV_owned)) %>% 
    add_tally(wt = n) %>% 
    mutate(pct = (n/nn * 100) %>% round(1)) %>%
    mutate(pct_txt = paste0(pct,"%")) %>%
    ungroup() %>%
    
    ggplot(aes(n, ATV_UTV_owned %>% as.factor() %>% fct_rev(), fill = state)) +
    geom_col() +
    geom_text(aes(label = pct_txt), hjust = -0.1)+
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    expand_limits(x = c(0, 160)) +
    facet_wrap(~state) +
    
    labs(title = "Number of ATV/UTVs Owned",
         subtitle = "ATVing in Wisconsin during 2023",
         y = "Number of ATVs or UTVs",
         x = "Number of Survey Responses",
         caption = "The survey asked, 'How many ATVs do you, or will you own in 2023?' 
         The same question was asked for UTVs.")

fig_rider_n_ATV_UTV_owned

Code

write_rds(fig_rider_n_ATV_UTV_owned, "../00_data/figures/01_fig_rider_n_ATV_UTV_owned.rds")

3.8 Purposes of ATV

Among ATV/UTV riders, trail riding emerges as the most prevalent usage, closely followed by road route touring. In response to inquiries about the various uses of their ATV/UTVs, a vast majority of riders indicated a preference for trail riding, with 94% of residents and 97% of nonresidents reporting enjoyment in this activity. Additionally, 79% of surveyed riders identified road route touring as a favored activity, while 74% of nonresident riders shared this sentiment.

Furthermore, hunting emerged as a significant activity for riders, alongside other notable purposes such as shopping, farming, and commuting to work. In the survey’s “other” category, respondents mentioned engaging in activities like fishing and plowing, further illustrating the diverse range of purposes for which ATV/UTVs are utilized.

Code

fig_rider_purposes_of_riding <- riders_clean %>%
    select(ID, state, Trail_Riding:Shopping) %>%
    pivot_longer(-c(ID, state)) %>%
    mutate(value = value %>% as.character() %>% as.integer() %>% as.logical()) %>%
    
    group_by(state, name) %>%
    summarise(#n = sum(value),
              #total = n(),
              pct = (mean(value, na.rm = TRUE) * 100) %>% round(0)) %>%
    ungroup() %>%
    mutate(pct_txt = paste0(pct,"%")) %>%
    mutate(name = name  %>% str_replace_all("_", " ") %>% stringr::str_to_title()) %>% 
    
    ggplot(aes(pct, fct_reorder(name, pct), fill = state)) +
    geom_col() +
    facet_wrap(~state) +
    geom_text(aes(label = pct_txt), hjust = -0.1) +
    theme_tq() +
    theme(legend.position = "none") +
    scale_fill_tq() +
    expand_limits(x = c(0, 120)) +
    
    labs(title = "Purposes of ATV/UTV Riding",
         subtitle = "ATVing in Wisconsin during 2023",
         x = "Percent in Total Survey Responses",
         y = NULL,
         caption = "The survey asked, 'Thinking of the usage in 2023 
         of your ATV(s) or UTV(s), check all that applies.'")

fig_rider_purposes_of_riding

Code

write_rds(fig_rider_purposes_of_riding, "../00_data/figures/01_fig_rider_purposes_of_riding.rds")

Footnotes

Accessed on 2/26/2024 at https://www.nhstateparks.org/getmedia/d0c3e291-63e1-463c-9c2c-37e7b1b0a8fc/2020-OHRV-Economic-Study-2021.aspx#:~:text=It%20was%20estimated%20that%20OHRV,during%20the%20calendar%20year%202020.↩︎