R/undo_groups.R

In pjbouchet/espresso: Bayesian Inference For Multi-Species Behavioural Dose-response Functions

#' Dissolve groupings
#'
#' Undo species groupings generated by \code{\link{create_groups}}
#'
#' @export
#' @param dat.obj Input dataset. Must be an object of class \code{brsdata.grp}, as given by \code{\link{create_groups}}. 
#' @return A list object of class \code{brsdata}.
#' @author Phil J. Bouchet
#' @seealso \code{\link{create_groups}} \code{\link{summary.brsdata}}
#' @examples
#' \dontrun{
#' library(espresso)
#' 
#' # Import the example data
#' mydat <- read_data(file = NULL) 
#' summary(mydat)
#' 
#' # Group all beaked whales together
#' mydat.grouped <- create_groups(mydat, species.groups = list(beaked = c("Md", "Zc", "Ha")))
#' class(mydat.grouped)
#' summary(mydat.grouped)
#' 
#' # Undo groupings and revert back to the original data
#' mydat.ungrouped <- undo_groups(mydat.grouped)
#' class(mydat.ungrouped)
#' summary(mydat.ungrouped)
#' }
#' @keywords brs rjmcmc dose-response

undo_groups <- function(dat.obj){
  
  #' ---------------------------------------------
  # Perform function checks
  #' ---------------------------------------------
  
  if(!"brsdata.grp" %in% class(dat.obj)) stop("Input data must be of class <brsdata.grp>")
  
  #' ---------------------------------------------
  # Revert to original species
  #' ---------------------------------------------
  
  brsdat <- dat.obj$ddf %>% 
    dplyr::select(-species) %>% 
    dplyr::mutate(species = sp_orig)
  
  #' ---------------------------------------------
  # Update dataset and relevant parameters
  #' ---------------------------------------------
  
  n.species <- length(unique(brsdat$species))
  
  # Species to which each individual belongs
  species.id <- purrr::map_dbl(.x = unique(brsdat$tag_id),
                               .f = ~{tmp <- brsdat %>% 
                                 dplyr::filter(tag_id == .x)
                               which(unique(unlist(brsdat[, "species"])) == unique(unlist(tmp[, "species"])))})
  
  n.per.species <- as.numeric(table(species.id))
  
  # Total number of exposures
  n.trials <- nrow(brsdat)
  
  # Number of exposures per animal
  # Use factor trick here to conserve order of tag_id
  n.trials.per.whale <- brsdat %>% 
    dplyr::mutate(tag_f = factor(tag_id, levels = unique(tag_id))) %>% 
    dplyr::group_by(tag_f) %>% 
    dplyr::count(.) %>% 
    dplyr::pull(n)
  
  species.trials <- sapply(X = seq_along(species.id), 
                           FUN = function(x) rep(species.id[x], n.trials.per.whale[x])) %>% do.call(c, .)
  
  suppressWarnings(species.summary <- brsdat %>% 
                     dplyr::group_by(species) %>% 
                     dplyr::summarise(common_name = unique(common_name),
                                      N_ind = length(unique(tag_id)), 
                                      N_trials = dplyr::n(), 
                                      censored = sum(is.na(spl)), 
                                      mean = mean(spl, na.rm = TRUE),
                                      min = min(spl, na.rm = TRUE),
                                      max = max(spl, na.rm = TRUE), .groups = "keep") %>% 
                     dplyr::ungroup())
  
  #' ---------------------------------------------
  # Return output list
  #' ---------------------------------------------
  
  dat.obj$ddf <- brsdat
  dat.obj$species$groups <- NULL
  dat.obj$species$abbrev <- NULL
  dat.obj$species$names <- unique(brsdat$species)
  dat.obj$species$n <- n.species
  dat.obj$species$nper <- n.per.species
  dat.obj$species$id <- species.id
  dat.obj$species$summary <- species.summary %>% dplyr::arrange(common_name)
  dat.obj$species$trials <- species.trials
  
  class(dat.obj) <- class(dat.obj)[!class(dat.obj) %in% "brsdata.grp"]
  return(dat.obj)
  
}