R/write_summary_qc.R

In IMOS-AnimalTracking/remora: Rapid Extraction of Marine Observations for Roving Animals

##' @title extract summary statistics by tag & write to text file
##'
##' @description extracts tag-deployment-specific QC summary statistics and writes all to a single text file
##'
##' @param x a nested tibble with class `remora_QC` generated by \code{tag_qc})
##' @param path path to write QCsummary.csv file
##'
##' @return summary outcome text file is written to user-specified path
##'
##' @importFrom readr write_delim
##' @importFrom dplyr %>% filter
##'
##' @keywords internal
##'

write_summary <- function(x, path = NULL) {

  if(!inherits(x, "remora_QC")) stop("x must be a nested tibble with class `remora_QC`")
  
 outcome <- lapply(1:nrow(x), function(i) {
    isdf.x <- is.data.frame(x$QC[[i]])
    tmp <- c()
    ##### Extract summary statistics for each tag
    tmp[1] <- ifelse(length(as.character(unique(as.character(x$QC[[i]]$transmitter_id)))) == 1,
                          as.character(unique(x$QC[[i]]$transmitter_id)),
                          paste(as.character(unique(x$QC[[i]]$transmitter_id)), collapse = "/"))
    tmp[2] <- unique(as.character(x$QC[[i]]$tag_id))
    tmp[3] <- unique(as.character(x$QC[[i]]$transmitter_deployment_id))
    tmp[4] <- as.character(unique(x$QC[[i]]$species_scientific_name))
    if(isdf.x) {
    tmp[5] <- nrow(x$QC[[i]]) # Total number of detections
    tmp[6] <- length(which(x$QC[[i]]$ReleaseDate_QC == 2)) ## Number of detections prior to release date
    tmp[7] <- x$QC[[i]]$ReleaseLocation_QC[1] == 2 ## Is tag release outside ALA/FishMap"s expert distribution map or farther than 500 km from first detection location?
    tmp[8] <- length(which(x$QC[[i]]$DetectionDistribution_QC == 2)) ## Number of detections outside the ALA/FishMap"s expert distribution map
    tmp[9] <- length(which(x$QC[[i]]$Detection_QC < 3)) ## Total number of "valid" or "likely valid" detections
    tmp[10] <- round(as.numeric(difftime(x$QC[[i]]$detection_datetime[nrow(x$QC[[i]])],
                                        x$QC[[i]]$detection_datetime[1], units = "days")), 2) ## Time difference, in days, between 1st and last detections
    tmp[11] <- length(which(x$QC[[i]]$Velocity_QC == 2)) ## Number of detections associated with unrealistic velocities
    } else {
      ## need to add NA values for any cases (tags) where shortest_dist.R failed
      tmp[5:11] <- NA
    }

    tmp

  }) %>%
   do.call(rbind, .) %>%
   as.data.frame()


 names(outcome) <- c("transmitter_id",
                     "tag_id",
                     "transmitter_deployment_id",
                     "species_scientific_name",
                     "total_detections",
                     "detections_before_deployment", # number of detections prior to deployment date
                     "invalid_deployment_location",  # tag deployment outside ALA/FishMap expert distribution map, or > 500 km from first detection
                     "detections_outside_species_range",
                     "valid_detections", # total of `valid` (QC flag 1) + `likely valid` (QC flag 2) detections
                     "tracking_duration_days", # time difference in days b/w first and last detections
                     "invalid_velocity") # number of detections associated with unrealistic travel rates

  outcome <- outcome %>%
    filter(!is.na(transmitter_id) & !duplicated(.))

  ##### write summary statistics to text file
  file <- file.path(path, "QCsummary.csv")
  write_delim(outcome,
              file = file,
              delim = ',',
              col_names = TRUE,
              quote_escape = FALSE)

}