## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----season-data, message = FALSE--------------------------------------------- library(tidycreel) set.seed(2024) # Full season: May 1 – September 30 (184 days) all_dates <- seq(as.Date("2024-05-01"), as.Date("2024-09-30"), by = "1 day") day_types <- ifelse( as.integer(format(all_dates, "%u")) %in% c(6L, 7L), "weekend", "weekday" ) season_calendar <- data.frame( date = all_dates, day_type = day_types ) # Stratified random sample: 30% of weekdays, 50% of weekends set.seed(2024) sampled <- ave( seq_along(all_dates), day_types, FUN = function(i) { rate <- if (day_types[i[1]] == "weekend") 0.50 else 0.30 as.integer(runif(length(i)) < rate) } ) sampled_calendar <- season_calendar[as.logical(sampled), ] # Generate plausible effort counts (angler-hours per count) # Weekend counts higher than weekday sampled_counts <- data.frame( date = sampled_calendar$date, day_type = sampled_calendar$day_type, n_anglers = ifelse( sampled_calendar$day_type == "weekend", round(rnorm(sum(sampled), mean = 55, sd = 18)), round(rnorm(sum(sampled), mean = 28, sd = 12)) ) ) sampled_counts$n_anglers <- pmax(sampled_counts$n_anglers, 0L) nrow(sampled_calendar) # Number of sampled days ## ----season-effort, message = FALSE------------------------------------------- season_design <- creel_design( sampled_calendar, date = date, strata = day_type ) season_design <- add_counts(season_design, sampled_counts) season_effort <- estimate_effort(season_design) season_effort$estimates ## ----monthly-effort, message = FALSE------------------------------------------ months <- 5:9 month_labels <- c("May", "June", "July", "August", "September") monthly_effort <- lapply(seq_along(months), function(i) { m <- months[i] cal_m <- sampled_calendar[format(sampled_calendar$date, "%m") == sprintf("%02d", m), ] cnt_m <- sampled_counts[format(sampled_counts$date, "%m") == sprintf("%02d", m), ] if (nrow(cal_m) == 0) { return(NULL) } des_m <- creel_design(cal_m, date = date, strata = day_type) des_m <- add_counts(des_m, cnt_m) est <- estimate_effort(des_m)$estimates cbind(month = month_labels[i], est) }) do.call(rbind, monthly_effort) ## ----season-from-months, message = FALSE-------------------------------------- monthly_df <- do.call(rbind, monthly_effort) season_from_months <- data.frame( stratum = "Season total", estimate = sum(monthly_df$estimate), se = sqrt(sum(monthly_df$se^2)) ) season_from_months ## ----interview-data, message = FALSE------------------------------------------ set.seed(2024) # Three interviews per sampled day (ensures ≥10 complete trips per month) n_per_day <- 3L n_int <- nrow(sampled_calendar) * n_per_day catch_total <- rpois(n_int, lambda = 1.8) interviews <- data.frame( date = rep(sampled_calendar$date, each = n_per_day), day_type = rep(sampled_calendar$day_type, each = n_per_day), trip_status = "complete", hours_fished = round(rnorm(n_int, mean = 3.5, sd = 1.2), 1), catch_total = catch_total, catch_kept = pmin(rpois(n_int, lambda = 0.6), catch_total) ) interviews$hours_fished <- pmax(interviews$hours_fished, 0.5) ## ----monthly-catch, message = FALSE------------------------------------------- monthly_catch <- lapply(seq_along(months), function(i) { m <- months[i] cal_m <- sampled_calendar[format(sampled_calendar$date, "%m") == sprintf("%02d", m), ] cnt_m <- sampled_counts[format(sampled_counts$date, "%m") == sprintf("%02d", m), ] int_m <- interviews[format(interviews$date, "%m") == sprintf("%02d", m), ] if (nrow(cal_m) == 0) { return(NULL) } des_m <- creel_design(cal_m, date = date, strata = day_type) des_m <- add_counts(des_m, cnt_m) des_m <- add_interviews(des_m, int_m, trip_status = trip_status, catch = catch_total, effort = hours_fished, n_anglers = 1, # every interview is a single angler harvest = catch_kept ) effort_est <- estimate_effort(des_m) catch_est <- estimate_total_catch(des_m) cbind(month = month_labels[i], catch_est$estimates) }) do.call(rbind, monthly_catch) ## ----season-catch------------------------------------------------------------- catch_df <- do.call(rbind, monthly_catch) season_catch <- data.frame( stratum = "Season total", estimate = sum(catch_df$estimate), se = sqrt(sum(catch_df$se^2)) ) season_catch ## ----season-summary, message = FALSE------------------------------------------ # Collect effort and catch estimates for each month into named lists effort_list <- list() catch_list <- list() for (i in seq_along(months)) { m <- months[i] label <- month_labels[i] cal_m <- sampled_calendar[format(sampled_calendar$date, "%m") == sprintf("%02d", m), ] cnt_m <- sampled_counts[format(sampled_counts$date, "%m") == sprintf("%02d", m), ] int_m <- interviews[format(interviews$date, "%m") == sprintf("%02d", m), ] if (nrow(cal_m) == 0) next des_m <- creel_design(cal_m, date = date, strata = day_type) des_m <- add_counts(des_m, cnt_m) des_m <- add_interviews(des_m, int_m, trip_status = trip_status, catch = catch_total, effort = hours_fished, n_anglers = 1, # every interview is a single angler harvest = catch_kept ) effort_list[[label]] <- estimate_effort(des_m) catch_list[[label]] <- estimate_total_catch(des_m) } # Assemble effort report effort_summary <- season_summary(effort_list) effort_summary$table ## ----catch-summary, message = FALSE------------------------------------------- catch_summary <- season_summary(catch_list) catch_summary$table ## ----multi-year, eval = FALSE------------------------------------------------- # # Conceptual pattern — replace with actual data per year # year_effort <- list() # # for (yr in c(2022, 2023, 2024)) { # cal_yr <- subset(full_calendar, format(date, "%Y") == yr) # cnt_yr <- subset(full_counts, format(date, "%Y") == yr) # # des_yr <- creel_design(cal_yr, date = date, strata = day_type) # des_yr <- add_counts(des_yr, cnt_yr) # # year_effort[[as.character(yr)]] <- estimate_effort(des_yr) # } # # # Multi-year report table # season_summary(year_effort)$table ## ----export, eval = FALSE----------------------------------------------------- # write_schedule(effort_summary$table, "effort_by_month_2024.csv") # write_schedule(effort_summary$table, "effort_by_month_2024.xlsx")