From 99ed26ec71bb5b1ebe8a56d9e752711eab81613b Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 19 Mar 2026 17:03:38 -0700 Subject: [PATCH 1/5] start of collapse_episodes() --- R/collapse.R | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 R/collapse.R diff --git a/R/collapse.R b/R/collapse.R new file mode 100644 index 0000000..b00ba3f --- /dev/null +++ b/R/collapse.R @@ -0,0 +1,39 @@ +collapse_episodes <- function(df) { + if (length(grep("antler_?class", names(df))) > 1) { + cli::cli_abort("More than one column with antler class data") + } + + df <- df |> + dplyr::filter( + .data$trigger_mode == "Motion Detection", + .data$species != "", + !is.na(.data$species) + ) |> + dplyr::rename( + "antler_class" = matches("antler_?class") + ) |> + dplyr::mutate( + episode_num = gsub("^([0-9]+).*", "\\1", episode) + ) + + df_collapsed <- df |> + dplyr::group_by(episode_num, species) |> + dplyr::summarise( + sample_station_label = dplyr::first(sample_station_label), # retain site + direction_of_travel = dplyr::first(direction_of_travel), # keep first travel dir + dplyr::across(dplyr::where(is.numeric), \(x) sum(x, na.rm = TRUE)), + first_date_time = min(date_time, na.rm = TRUE), + dplyr::across( + c( + dplyr::where(is.character), + -any_of(c("sample_station_label", "direction_of_travel", "episode")) + ), + ~ paste(unique(na.omit(.)), collapse = "; ") + ), + .groups = "drop", + total_count = sum(.data$total_count_episode, na.rm = TRUE) + ) |> + dplyr::arrange(as.POSIXct(first_date_time), episode_num, species) + + df_collapsed +} From c37c70441bd727dbb679d2278cb3a52850889009 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 19 Mar 2026 18:10:09 -0700 Subject: [PATCH 2/5] collapse_migration_episodes + documentation --- NAMESPACE | 1 + R/collapse.R | 34 +++++++++++++++++++++++++----- man/collapse_migration_episodes.Rd | 19 +++++++++++++++++ 3 files changed, 49 insertions(+), 5 deletions(-) create mode 100644 man/collapse_migration_episodes.Rd diff --git a/NAMESPACE b/NAMESPACE index 69eb621..37f9045 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ S3method(write_to_spi_sheet,default) S3method(write_to_spi_sheet,image_data) S3method(write_to_spi_sheet,sample_station_info) export(bccamtrapp) +export(collapse_migration_episodes) export(fill_spi_template) export(fill_spi_template_ff) export(make_deployments) diff --git a/R/collapse.R b/R/collapse.R index b00ba3f..8642395 100644 --- a/R/collapse.R +++ b/R/collapse.R @@ -1,4 +1,13 @@ -collapse_episodes <- function(df) { +#' Collapse motion detection events into episodes +#' +#' @param df a data frame of image data, read in with `read_image_data()`. +#' +#' @returns a data frame with motion detection events collapsed into 1 row per +#' episode, and summary information about each episode (e.g. duration, number +#' of triggers, total count). +#' +#' @export +collapse_migration_episodes <- function(df) { if (length(grep("antler_?class", names(df))) > 1) { cli::cli_abort("More than one column with antler class data") } @@ -21,17 +30,32 @@ collapse_episodes <- function(df) { dplyr::summarise( sample_station_label = dplyr::first(sample_station_label), # retain site direction_of_travel = dplyr::first(direction_of_travel), # keep first travel dir - dplyr::across(dplyr::where(is.numeric), \(x) sum(x, na.rm = TRUE)), first_date_time = min(date_time, na.rm = TRUE), + last_date_time = max(date_time, na.rm = TRUE), + duration_s = as.numeric(difftime( + last_date_time, + first_date_time, + units = "secs" + )), + n_triggers = dplyr::n(), + dplyr::across(dplyr::where(is.numeric), \(x) sum(x, na.rm = TRUE)), dplyr::across( c( dplyr::where(is.character), - -any_of(c("sample_station_label", "direction_of_travel", "episode")) + -any_of(c( + "sample_station_label", + "direction_of_travel", + "episode" + )) ), ~ paste(unique(na.omit(.)), collapse = "; ") ), - .groups = "drop", - total_count = sum(.data$total_count_episode, na.rm = TRUE) + total_count = sum(.data$total_count_episode, na.rm = TRUE), + antler_class_1 = any(grepl("Class 1", .data$antler_class)), + antler_class_2 = any(grepl("Class 2", .data$antler_class)), + antler_class_3 = any(grepl("Class 3", .data$antler_class)), + antler_class_4 = any(grepl("Class 4", .data$antler_class)), + .groups = "drop" ) |> dplyr::arrange(as.POSIXct(first_date_time), episode_num, species) diff --git a/man/collapse_migration_episodes.Rd b/man/collapse_migration_episodes.Rd new file mode 100644 index 0000000..5a2cbd0 --- /dev/null +++ b/man/collapse_migration_episodes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/collapse.R +\name{collapse_migration_episodes} +\alias{collapse_migration_episodes} +\title{Collapse motion detection events into episodes} +\usage{ +collapse_migration_episodes(df) +} +\arguments{ +\item{df}{a data frame of image data, read in with \code{read_image_data()}.} +} +\value{ +a data frame with motion detection events collapsed into 1 row per +episode, and summary information about each episode (e.g. duration, number +of triggers, total count). +} +\description{ +Collapse motion detection events into episodes +} From 5e661a0908e141e1f0180cb8910fdabffb865401 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 19 Mar 2026 18:37:29 -0700 Subject: [PATCH 3/5] Add migration map to collapse_migration_episodes * also fix global variables --- R/collapse.R | 68 +++++++++++++++++++++++++----- man/collapse_migration_episodes.Rd | 11 ++++- 2 files changed, 67 insertions(+), 12 deletions(-) diff --git a/R/collapse.R b/R/collapse.R index 8642395..c4f3ae5 100644 --- a/R/collapse.R +++ b/R/collapse.R @@ -1,13 +1,19 @@ #' Collapse motion detection events into episodes #' #' @param df a data frame of image data, read in with `read_image_data()`. +#' @param migration_map A small data.frame defining the upstream +#' direction(s) of travel for each sample station. Valid upstream values are: +#' `"L to R"`, `"R to L"`, `"T to B"`, `"B to T"`. +#' Columns must include: +#' - `sample_station_label` +#' - `upstream` #' #' @returns a data frame with motion detection events collapsed into 1 row per #' episode, and summary information about each episode (e.g. duration, number #' of triggers, total count). #' #' @export -collapse_migration_episodes <- function(df) { +collapse_migration_episodes <- function(df, migration_map) { if (length(grep("antler_?class", names(df))) > 1) { cli::cli_abort("More than one column with antler class data") } @@ -22,19 +28,19 @@ collapse_migration_episodes <- function(df) { "antler_class" = matches("antler_?class") ) |> dplyr::mutate( - episode_num = gsub("^([0-9]+).*", "\\1", episode) + episode_num = gsub("^([0-9]+).*", "\\1", .data$episode) ) df_collapsed <- df |> - dplyr::group_by(episode_num, species) |> + dplyr::group_by(.data$episode_num, .data$species) |> dplyr::summarise( - sample_station_label = dplyr::first(sample_station_label), # retain site - direction_of_travel = dplyr::first(direction_of_travel), # keep first travel dir - first_date_time = min(date_time, na.rm = TRUE), - last_date_time = max(date_time, na.rm = TRUE), + sample_station_label = dplyr::first(.data$sample_station_label), # retain site + direction_of_travel = dplyr::first(.data$direction_of_travel), # keep first travel dir + first_date_time = min(.data$date_time, na.rm = TRUE), + last_date_time = max(.data$date_time, na.rm = TRUE), duration_s = as.numeric(difftime( - last_date_time, - first_date_time, + .data$last_date_time, + .data$first_date_time, units = "secs" )), n_triggers = dplyr::n(), @@ -57,7 +63,47 @@ collapse_migration_episodes <- function(df) { antler_class_4 = any(grepl("Class 4", .data$antler_class)), .groups = "drop" ) |> - dplyr::arrange(as.POSIXct(first_date_time), episode_num, species) + dplyr::arrange(.data$first_date_time, .data$episode_num, .data$species) - df_collapsed + make_travel_direction(df_collapsed, migration_map) +} + +make_travel_direction <- function(df_collapsed, migration_map) { + if ( + !all( + c("sample_station_label", "upstream", "downstream") %in% + names(migration_map) + ) + ) { + cli::cli_abort( + "migration_map must have columns: sample_station_label, upstream, downstream" + ) + } + + df_collapsed <- df_collapsed |> + dplyr::mutate(direction_of_travel = tolower(.data$direction_of_travel)) |> + dplyr::left_join(migration_map, by = "sample_station_label") |> + dplyr::mutate( + migration_direction = dplyr::case_when( + .data$direction_of_travel == "unk" ~ NA_character_, + .data$direction_of_travel == "enters from top" & + .data$upstream == "T to B" ~ "upstream", + .data$direction_of_travel == "enters from bottom" & + .data$upstream == "T to B" ~ "downstream", + .data$direction_of_travel == "enters from top" & + .data$upstream == "B to T" ~ "downstream", + .data$direction_of_travel == "enters from bottom" & + .data$upstream == "B to T" ~ "upstream", + .data$direction_of_travel == "enters from left" & + .data$upstream == "L to R" ~ "upstream", + .data$direction_of_travel == "enters from right" & + .data$upstream == "L to R" ~ "downstream", + .data$direction_of_travel == "enters from left" & + .data$upstream == "R to L" ~ "downstream", + .data$direction_of_travel == "enters from right" & + .data$upstream == "R to L" ~ "upstream", + .default ~ NA_character_ + ) + ) |> + dplyr::select(-"upstream", -"downstream") } diff --git a/man/collapse_migration_episodes.Rd b/man/collapse_migration_episodes.Rd index 5a2cbd0..5127e1e 100644 --- a/man/collapse_migration_episodes.Rd +++ b/man/collapse_migration_episodes.Rd @@ -4,10 +4,19 @@ \alias{collapse_migration_episodes} \title{Collapse motion detection events into episodes} \usage{ -collapse_migration_episodes(df) +collapse_migration_episodes(df, migration_map) } \arguments{ \item{df}{a data frame of image data, read in with \code{read_image_data()}.} + +\item{migration_map}{A small data.frame defining the upstream +direction(s) of travel for each sample station. Valid upstream values are: +\code{"L to R"}, \code{"R to L"}, \code{"T to B"}, \code{"B to T"}. +Columns must include: +\itemize{ +\item \code{sample_station_label} +\item \code{upstream} +}} } \value{ a data frame with motion detection events collapsed into 1 row per From c6e994714bbe258ebae984d4715488a5e8936d91 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 19 Mar 2026 22:41:11 -0700 Subject: [PATCH 4/5] Add collapse_wallow_episodes, document --- NAMESPACE | 1 + R/collapse.R | 118 +++++++++++++++++++++++++---- man/collapse_migration_episodes.Rd | 4 +- man/collapse_wallow_episodes.Rd | 19 +++++ 4 files changed, 126 insertions(+), 16 deletions(-) create mode 100644 man/collapse_wallow_episodes.Rd diff --git a/NAMESPACE b/NAMESPACE index 37f9045..1697b7f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,7 @@ S3method(write_to_spi_sheet,image_data) S3method(write_to_spi_sheet,sample_station_info) export(bccamtrapp) export(collapse_migration_episodes) +export(collapse_wallow_episodes) export(fill_spi_template) export(fill_spi_template_ff) export(make_deployments) diff --git a/R/collapse.R b/R/collapse.R index c4f3ae5..999cb3b 100644 --- a/R/collapse.R +++ b/R/collapse.R @@ -1,6 +1,6 @@ #' Collapse motion detection events into episodes #' -#' @param df a data frame of image data, read in with `read_image_data()`. +#' @param df a data frame of migration image data, read in with `read_image_data()`. #' @param migration_map A small data.frame defining the upstream #' direction(s) of travel for each sample station. Valid upstream values are: #' `"L to R"`, `"R to L"`, `"T to B"`, `"B to T"`. @@ -10,15 +10,36 @@ #' #' @returns a data frame with motion detection events collapsed into 1 row per #' episode, and summary information about each episode (e.g. duration, number -#' of triggers, total count). +#' of triggers, total count, direction of travel, ...). #' #' @export collapse_migration_episodes <- function(df, migration_map) { + df <- prep_for_collapse(df) + df_collapsed <- collapse_episodes(df, "migration") + make_travel_direction(df_collapsed, migration_map) +} + +#' Collapse Wallow Episodes +#' +#' @param df a data frame of wallow image data, read in with `read_image_data()`. +#' +#' @returns a data frame with wallow image data collapsed into 1 row per +#' episode, and summary information about each episode (e.g. duration, number +#' of triggers, total count, social and wallow behaviour, ...). +#' +#' @export +collapse_wallow_episodes <- function(df) { + df <- prep_for_collapse(df) + df_collapsed <- collapse_episodes(df, "wallow") + make_wallow_behaviour_columns(df_collapsed) +} + +prep_for_collapse <- function(df) { if (length(grep("antler_?class", names(df))) > 1) { cli::cli_abort("More than one column with antler class data") } - df <- df |> + df |> dplyr::filter( .data$trigger_mode == "Motion Detection", .data$species != "", @@ -30,12 +51,15 @@ collapse_migration_episodes <- function(df, migration_map) { dplyr::mutate( episode_num = gsub("^([0-9]+).*", "\\1", .data$episode) ) +} + +collapse_episodes <- function(df, which = c("migration", "wallow")) { + which <- match.arg(which) - df_collapsed <- df |> + collapsed_df <- df |> dplyr::group_by(.data$episode_num, .data$species) |> dplyr::summarise( - sample_station_label = dplyr::first(.data$sample_station_label), # retain site - direction_of_travel = dplyr::first(.data$direction_of_travel), # keep first travel dir + sample_station_label = dplyr::first(.data$sample_station_label), first_date_time = min(.data$date_time, na.rm = TRUE), last_date_time = max(.data$date_time, na.rm = TRUE), duration_s = as.numeric(difftime( @@ -44,6 +68,21 @@ collapse_migration_episodes <- function(df, migration_map) { units = "secs" )), n_triggers = dplyr::n(), + wallow_behaviour_list = if (which == "wallow") { + list(unique(stats::na.omit(unlist(strsplit( + .data$elk_behaviour_wallow, + ",(\\s*)?" + ))))) + }, + social_behaviour_list = if (which == "wallow") { + list(unique(stats::na.omit(unlist(strsplit( + .data$elk_behaviour_social, + ",(\\s*)?" + ))))) + }, + direction_of_travel = if (which == "migration") { + dplyr::first(.data$direction_of_travel) + }, dplyr::across(dplyr::where(is.numeric), \(x) sum(x, na.rm = TRUE)), dplyr::across( c( @@ -54,8 +93,9 @@ collapse_migration_episodes <- function(df, migration_map) { "episode" )) ), - ~ paste(unique(na.omit(.)), collapse = "; ") + combine_strings ), + dplyr::across(dplyr::where(is.logical), \(x) any(x, na.rm = TRUE)), total_count = sum(.data$total_count_episode, na.rm = TRUE), antler_class_1 = any(grepl("Class 1", .data$antler_class)), antler_class_2 = any(grepl("Class 2", .data$antler_class)), @@ -65,22 +105,29 @@ collapse_migration_episodes <- function(df, migration_map) { ) |> dplyr::arrange(.data$first_date_time, .data$episode_num, .data$species) - make_travel_direction(df_collapsed, migration_map) + collapsed_df +} + +combine_strings <- function(x) { + x <- paste(unique(stats::na.omit(x)), collapse = "; ") + if (x == "") { + return(NA_character_) + } + x } make_travel_direction <- function(df_collapsed, migration_map) { if ( !all( - c("sample_station_label", "upstream", "downstream") %in% - names(migration_map) + c("sample_station_label", "upstream") %in% names(migration_map) ) ) { cli::cli_abort( - "migration_map must have columns: sample_station_label, upstream, downstream" + "migration_map must have columns: sample_station_label, upstream" ) } - df_collapsed <- df_collapsed |> + df_collapsed |> dplyr::mutate(direction_of_travel = tolower(.data$direction_of_travel)) |> dplyr::left_join(migration_map, by = "sample_station_label") |> dplyr::mutate( @@ -102,8 +149,51 @@ make_travel_direction <- function(df_collapsed, migration_map) { .data$upstream == "R to L" ~ "downstream", .data$direction_of_travel == "enters from right" & .data$upstream == "R to L" ~ "upstream", - .default ~ NA_character_ + .default = NA_character_ ) ) |> - dplyr::select(-"upstream", -"downstream") + dplyr::select(-"upstream", ) +} + +make_wallow_behaviour_columns <- function(df_collapsed) { + df_collapsed <- df_collapsed |> + dplyr::mutate( + wallow_behaviour_list = list_to_named_logical( + .data$wallow_behaviour_list, + prefix = "wallow_" + ), + social_behaviour_list = list_to_named_logical( + .data$social_behaviour_list, + prefix = "social_" + ) + ) + + df_collapsed |> + dplyr::relocate( + "wallow_behaviour_list", + "social_behaviour_list", + .after = "total_count" + ) |> + tidyr::unnest_wider( + .data$wallow_behaviour_list, + names_repair = janitor::make_clean_names, + transform = \(x) ifelse(is.na(x), FALSE, x) + ) |> + tidyr::unnest_wider( + .data$social_behaviour_list, + names_repair = janitor::make_clean_names, + transform = \(x) ifelse(is.na(x), FALSE, x) + ) +} + +list_to_named_logical <- function(x, prefix) { + lapply( + x, + \(y) { + nm <- y + y <- rep(TRUE, length(y)) + names(y) <- if (length(nm) == 0) character(0) else paste0(prefix, nm) + y + } + ) } diff --git a/man/collapse_migration_episodes.Rd b/man/collapse_migration_episodes.Rd index 5127e1e..ffe9465 100644 --- a/man/collapse_migration_episodes.Rd +++ b/man/collapse_migration_episodes.Rd @@ -7,7 +7,7 @@ collapse_migration_episodes(df, migration_map) } \arguments{ -\item{df}{a data frame of image data, read in with \code{read_image_data()}.} +\item{df}{a data frame of migration image data, read in with \code{read_image_data()}.} \item{migration_map}{A small data.frame defining the upstream direction(s) of travel for each sample station. Valid upstream values are: @@ -21,7 +21,7 @@ Columns must include: \value{ a data frame with motion detection events collapsed into 1 row per episode, and summary information about each episode (e.g. duration, number -of triggers, total count). +of triggers, total count, direction of travel, ...). } \description{ Collapse motion detection events into episodes diff --git a/man/collapse_wallow_episodes.Rd b/man/collapse_wallow_episodes.Rd new file mode 100644 index 0000000..6b21ed6 --- /dev/null +++ b/man/collapse_wallow_episodes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/collapse.R +\name{collapse_wallow_episodes} +\alias{collapse_wallow_episodes} +\title{Collapse Wallow Episodes} +\usage{ +collapse_wallow_episodes(df) +} +\arguments{ +\item{df}{a data frame of wallow image data, read in with \code{read_image_data()}.} +} +\value{ +a data frame with wallow image data collapsed into 1 row per +episode, and summary information about each episode (e.g. duration, number +of triggers, total count, social and wallow behaviour, ...). +} +\description{ +Collapse Wallow Episodes +} From 90bfac37f3dd4dbe5180606ee457277ad50c63b2 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 19 Mar 2026 22:42:37 -0700 Subject: [PATCH 5/5] Update scratch --- inst/scratch-templates.R | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/inst/scratch-templates.R b/inst/scratch-templates.R index 154749f..a305a0e 100644 --- a/inst/scratch-templates.R +++ b/inst/scratch-templates.R @@ -1,5 +1,6 @@ # devtools::install_github("bcgov/bccamtrap") library(bccamtrap) +library(dplyr) migration_data <- read_image_data( "inst/extdata/example-data/Example-input-CSV_migration-cams_Migration_v1.csv" @@ -16,7 +17,23 @@ migration_data_qa <- qa_image_data( exclude_human_use = FALSE ) -migration_data_qa +migration_map <- tribble( + ~sample_station_label , ~upstream , + "Kay-A" , "R to L" , + "Kay-B" , "R to L" , + "UpperAdam-A" , "L to R" , + "UpperAdam-B" , "R to L" , + "SwampLake-A" , "L to R" , + "SwampLaKe-B" , "R to L" , + "SwampLake-B" , "T to B" , + "MerrillLk-A" , "L to R" , + "Salmon4-A" , "R to L" , + "Salmon-A" , "R to L" , + "Salmon-B" , "L to R" , + "Memekay-A" , "L to R" +) + +collapse_migration_episodes(migration_data_qa, migration_map = migration_map) wallow_elk_data <- read_image_data( "inst/extdata/example-data/Example-input-CSV_wallow-cams_Elk_Template_Wallows_v1.csv" @@ -33,7 +50,8 @@ wallow_elk_data_qa <- qa_image_data( exclude_human_use = FALSE ) -wallow_elk_data_qa + +collapse_wallow_episodes(wallow_elk_data) new_wallow_elk_data <- read_image_data( "inst/extdata/example-data/Example-input-CSV_wallow-cams_updated_approach.csv" @@ -49,4 +67,5 @@ new_wallow_elk_data_qa <- qa_image_data( exclude_human_use = FALSE ) -new_wallow_elk_data_qa + +collapse_wallow_episodes(new_wallow_elk_data)