#' @title Remove data still under QA/QC.
#'
#' @description
#' Removes records that are still undergoing QA/QC (latest 12 months)
#'
#' @param full_data Data.table of raw data.
#' @param trapping_table Data.table with QCflag
#'
#' @return Data.table with latest 12 months of data removed.
#'
#' @noRd
clean_data <- function(full_data, trapping_table, ...) {
columns_to_keep <- colnames(full_data)
full_data <- full_data %>%
dplyr::left_join(trapping_table, ...) %>%
dplyr::filter(.data$qcflag == 1) %>%
dplyr::select(dplyr::all_of(columns_to_keep)) %>%
unique()
return(full_data)
}
#' @title Filter plots
#'
#' @description
#' Removes plots not needed for analysis. Specific groups, such as "all" or
#' "longterm" can be specified, as well as manual selection of plots.
#'
#' @param data any data.frame with a plot column.
#' @param plots specify subset of plots; can be a vector of plots, or specific
#' sets: "all" plots or "Longterm" plots (plots that have had the same
#' treatment for the entire time series)
#' @return Data.table filtered to the desired subset of plots.
#'
#' @noRd
filter_plots <- function(data, plots = NULL)
{
if (is.character(plots))
{
plots <- tolower(plots)
if (plots %in% c("longterm", "long-term"))
{
plots <- c(3, 4, 10, 11, 14, 15, 16, 17, 19, 21, 23)
} else if (plots == "all") {
plots <- NULL
}
}
# if no selection then return unaltered data
return_if_null(x = plots, value = data)
# otherwise return filtered data
dplyr::filter(data, .data$plot %in% plots)
}
#' @title Join plots table
#' @description Adds treatment information to any data.frame with year, month,
#' and plot info, by joining the plots_table
#' @param df data.frame to which plot and treatment info should be joined
#' @param plots_table Data_table of treatments for the plots.
#'
#' @return Data.table of raw rodent data with treatment info added.
#'
#' @noRd
join_plots <- function(df, plots_table) {
plots_table <- plots_table %>%
dplyr::group_by(.data$year, .data$plot) %>%
dplyr::select(c("year", "month", "plot", "treatment"))
join_by <- c(year = "year", month = "month", plot = "plot")
dplyr::left_join(df, plots_table, by = join_by)
}
#' @title Add User-specified time column
#'
#' @description
#' period codes denote the number of censuses that have occurred, but are
#' not the same as the number of censuses that should have occurred. Sometimes
#' censuses are missed (weather, transport issues,etc). You can't pick this
#' up with the period code. Because censues may not always occur monthly due to
#' the newmoon - a new moon code was devised to give a standardized language
#' of time for forcasting in particular. This function allows the user to decide
#' if they want to use the rodent period code, the new moon code, the date of
#' the rodent census, or have their data with all three time formats
#'
#' @param summary_table Data.table with summarized rodent data.
#' @param newmoon_table Data_table linking newmoon codes with period codes.
#' @param time Character. Denotes whether newmoon codes, period codes,
#' and/or date are desired.
#'
#' @return Data.table of summarized rodent data with user-specified time format
#'
#' @noRd
add_time <- function(summary_table, newmoons_table, time = "period") {
newmoons_table$censusdate <- as.Date(newmoons_table$censusdate)
newmoons_table$newmoondate <- as.Date(newmoons_table$newmoondate)
if (time == "period")
{
join_summary_newmoon <- dplyr::right_join(newmoons_table, summary_table,
by = c("period" = "period")) %>%
dplyr::filter(.data$period <= max(.data$period, na.rm = TRUE))
} else {
newmoons_table$censusdate[is.na(newmoons_table$censusdate)] <-
newmoons_table$newmoondate[is.na(newmoons_table$censusdate)]
join_summary_newmoon <- dplyr::left_join(newmoons_table, summary_table,
by = "period")
}
date_vars <- c("newmoondate", "newmoonnumber", "period", "censusdate")
vars_to_keep <- switch(tolower(time),
"newmoon" = "newmoonnumber",
"date" = "censusdate",
"period" = "period",
c("newmoonnumber", "period", "censusdate"))
vars_to_drop <- setdiff(date_vars, vars_to_keep)
dplyr::select(join_summary_newmoon, -tidyselect::any_of(vars_to_drop))
}
#' @title Make Crosstab
#'
#' @description convert summarized rodent data to crosstab form
#'
#' @param summary_data summarized rodent data
#' @param variable_name what variable to spread (default is "abundance")
#' @param ... other arguments to pass on to tidyr::spread
#'
#' @noRd
make_crosstab <- function(summary_data,
variable_name = "abundance",
...)
{
species <- as.character(na.omit(unique(summary_data$species)))
vars_to_keep <- c(setdiff(names(summary_data), c("species", variable_name)),
sort(species))
summary_data %>%
tidyr::spread(.data$species, !!variable_name, ...) %>%
dplyr::ungroup() %>%
dplyr::select(tidyselect::all_of(vars_to_keep))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.