Nothing
#' Summarize DAS effort
#'
#' Chop DAS data into effort segments
#'
#' @param x an object of class \code{das_df},
#' or a data frame that can be coerced to class \code{das_df}
#' @param method character; method to use to chop DAS data into effort segments
#' Can be "condition", "equallength", "section",
#' or any partial match thereof (case sensitive)
#' @param conditions character vector of names of conditions to include in segdata output.
#' These values must be column names from the output of \code{\link{das_process}},
#' e.g. 'Bft', 'SwellHght', etc.
#' If \code{method == "condition"}, then these also are the conditions which
#' trigger segment chopping when they change. Only the following conditions can be used for chopping:
#' 'Bft', 'SwellHght', 'RainFog', 'HorizSun', 'VertSun', 'Glare', 'Vis', 'Course', 'SpdKt'
#' @param strata.files list of path(s) of the CSV file(s) with points defining each stratum.
#' The CSV files must contain headers and be a closed polygon.
#' The list should be named; see the Details section.
#' If \code{NULL} (the default), then no effort segments are not classified by strata.
#' @param distance.method character;
#' method to use to calculate distance between lat/lon coordinates.
#' Can be "greatcircle", "lawofcosines", "haversine", "vincenty",
#' or any partial match thereof (case sensitive).
#' Default is "greatcircle"
#' @param seg0.drop logical; flag indicating whether or not to drop segments
#' of length 0 that contain no sighting (S, K, M, G, t) events.
#' Default is \code{FALSE}
#' @param comment.drop logical; flag indicating if comments ("C" events)
#' should be ignored (i.e. position information should not be used)
#' when segment chopping. Default is \code{FALSE}
#' @param event.touse character vector of events to use to determine
#' segment lengths; overrides \code{comment.drop}.
#' If \code{NULL} (the default), then all on effort events are used.
#' If used, this argument must include at least R, E, S, and A events,
#' and cannot include ? or 1:8 events
#' @param num.cores Number of CPUs to over which to distribute computations.
#' Defaults to \code{NULL}, which uses one fewer than the number of cores
#' reported by \code{\link[parallel]{detectCores}}.
#' Using 1 core likely will be faster for smaller datasets
#' @param ... arguments passed to the specified chopping function,
#' such as \code{seg.km} or \code{seg.min.km}
#'
#' @details This is the top-level function for chopping processed DAS data
#' into modeling segments (henceforth 'segments'), and assigning sightings
#' and related information (e.g., weather conditions) to each segment.
#' This function returns data frames with all relevant information for the
#' effort segments and associated sightings ('segdata' and 'sightinfo', respectively).
#' Before chopping, the DAS data is filtered for events (rows) where either
#' the 'OnEffort' column is \code{TRUE} or the 'Event' column "E".
#' In other words, the data is filtered for continuous effort sections (henceforth 'effort sections'),
#' where effort sections run from "R" to "E" events (inclusive),
#' and then passed to the chopping function specified using \code{method}.
#' Note that while B events immediately preceding an R are on effort,
#' they are ignored during effort chopping.
#' In addition, all on effort events (other than ? and numeric events)
#' with \code{NA} DateTime, Lat, or Lon values are verbosely removed.
#'
#' If \code{strata.files} is not \code{NULL}, then the effort lines
#' will be split by the user-provided stratum (strata).
#' In this case, a column 'stratum' will be added to the end of the segdata
#' data frame with the user-provided name of the stratum that the segment was in,
#' or \code{NA} if the segment was not in any of the strata.
#' If no name was provided for the stratum in \code{strata.files},
#' then the value will be "Stratum#",
#' where "#" is the index of the applicable stratum in \code{strata.files}.
#' While the user can provide as many strata as they want,
#' these strata can share boundaries but they cannot overlap.
#' See \code{\link{das_effort_strata}} for more details.
#'
#' The following chopping methods are currently available:
#' "condition", "equallength", and "section.
#' When using the "condition" method, effort sections are chopped
#' into segments every time a condition changes,
#' thereby ensuring that the conditions are consistent across the entire segment.
#' See \code{\link{das_chop_condition}} for more details about this method,
#' including arguments that must be passed to it via the argument \code{...}
#'
#' The "equallength" method consists of
#' chopping effort sections into equal-length segments of length \code{seg.km},
#' and doing a weighted average of the conditions for the length of that segment.
#' See \code{\link{das_chop_equallength}} for more details about this method,
#' including arguments that must be passed to it via the argument \code{...}
#'
#' The "section" method involves 'chopping' the effort into continuous effort sections,
#' i.e. each continuous effort section is a single effort segment.
#' See \code{\link{das_chop_section}} for more details about this method.
#'
#' The distance between the lat/lon points of subsequent events
#' is calculated using the method specified in \code{distance.method}.
#' If "greatcircle", \code{\link{distance_greatcircle}} is used,
#' while \code{\link[swfscMisc]{distance}} is used otherwise.
#' See \code{\link{das_sight}} for how the sightings are processed.
#'
#' The sightinfo data frame includes the column 'included',
#' which is used in \code{\link{das_effort_sight}} when summarizing
#' the number of sightings and animals for selected species.
#' \code{\link{das_effort_sight}} is a separate function to allow users to
#' personalize the included values as desired for their analysis.
#' By default, i.e. in the output of this function, 'included' is \code{TRUE} if:
#' the sighting was made when on effort,
#' by a standard observer (see \code{\link{das_sight}}),
#' and in a Beaufort sea state less than or equal to five.
#'
#' @return List of three data frames:
#' \itemize{
#' \item segdata: one row for every segment, and columns for information including
#' unique segment number (segnum), the corresponding effort section (section_id),
#' the segment index within the corresponding effort section (section_sub_id),
#' the starting and ending line of the segment in the DAS file (stlin, endlin),
#' start/end/midpoint coordinates(lat1/lon1, lat2/lon2, and mlat/mlon, respectively),
#' the start/end/midpoint date/time of the segment (DateTime1, DateTime2, and mDateTime, respectively;
#' mDateTime is the average of DateTime1 and DateTime2), segment length (dist),
#' conditions (e.g. Beaufort), and, if applicable, stratum (InStratumName).
#' \item sightinfo: details for all sightings in \code{x}, including:
#' the unique segment number it is associated with, segment mid points (lat/lon),
#' the 'included' column described in the 'Details' section,
#' and the output information described in \code{\link{das_sight}} for \code{return.format} is "default"
#' \item randpicks: see \code{\link{das_chop_equallength}};
#' \code{NULL} if using "condition" method
#' }
#'
#' @seealso Internal functions called by \code{das_effort}:
#' \code{\link{das_chop_condition}}, \code{\link{das_chop_equallength}},
#' \code{\link{das_chop_section}}, \code{\link{das_segdata}}
#'
#' @examples
#' y <- system.file("das_sample.das", package = "swfscDAS")
#' y.proc <- das_process(y)
#'
#' # Using "condition" method
#' das_effort(
#' y.proc, method = "condition", conditions = c("Bft", "SwellHght", "Vis"),
#' seg.min.km = 0.05, num.cores = 1
#' )
#'
#' # Using "section" method
#' das_effort(y.proc, method = "section", num.cores = 1)
#'
#' \donttest{
#' # Using "equallength" method
#' y.rand <- system.file("das_sample_randpicks.csv", package = "swfscDAS")
#' das_effort(
#' y.proc, method = "equallength", seg.km = 10, randpicks.load = y.rand,
#' num.cores = 1
#' )
#'
#' # Using "section" method and chop by strata
#' stratum.file <- system.file("das_sample_stratum.csv", package = "swfscDAS")
#' das_effort(
#' y.proc, method = "section", strata.files = list(Poly1 = stratum.file),
#' num.cores = 1
#' )
#' }
#'
#' @export
das_effort <- function(x, ...) UseMethod("das_effort")
#' @name das_effort
#' @export
das_effort.data.frame <- function(x, ...) {
das_effort(as_das_df(x), ...)
}
#' @name das_effort
#' @export
das_effort.das_df <- function(x, method = c("condition", "equallength", "section"),
conditions = NULL, strata.files = NULL,
distance.method = c("greatcircle", "lawofcosines", "haversine", "vincenty"),
seg0.drop = FALSE, comment.drop = FALSE, event.touse = NULL,
num.cores = NULL, ...) {
#----------------------------------------------------------------------------
# Input checks
if (!(inherits(seg0.drop, "logical") & inherits(comment.drop, "logical")))
stop("seg0.drop and comment.drop must both be logicals (either TRUE or FALSE)")
method <- match.arg(method)
distance.method <- match.arg(distance.method)
conditions <- .das_conditions_check(conditions, method)
event.tmp <- c("?", 1:8)
if (!is.null(event.touse)) {
if (comment.drop) warning("comment.drop is ignored because event.touse is not NULL")
if (!all(c("R", "E", "S", "A") %in% event.touse))
stop("event.use must include at least the following events: ",
paste(c("R", "E", "S", "A"), collapse = ", "))
if (any(event.tmp %in% event.touse))
stop("event.use cannot include the following events: ",
paste(event.tmp, collapse = ", "))
}
#----------------------------------------------------------------------------
# Prep for chop functions
# Remove comments if specified
if (is.null(event.touse) & comment.drop) x <- x %>% filter(.data$Event != "C")
# Add index column for adding back in ? and 1:8 events, and extract those events
x$idx_eff <- seq_len(nrow(x))
# Filter for continuous effort sections; extract ? and 1:8 events
# 'on effort + 1' is to capture O/E event.
x.B.preEff <- which(x$Event == "B")
x.B.preEff <- x.B.preEff[(x.B.preEff %in% c(1, which(!x$OnEffort) + 1))]
# Don't use Event == "E" in case there are rogue E events
x.oneff.which <- sort(unique(c(which(x$OnEffort), which(x$OnEffort) + 1)))
x.oneff.which <- x.oneff.which[!(x.oneff.which %in% x.B.preEff)]
if (!all(between(x.oneff.which, 1, nrow(x))))
stop("Error processing index values. ",
"Please make sure there are no issues flagged by das_check, ",
"and then report this as an issue.")
rm(x.B.preEff)
x.oneff.all <- x[x.oneff.which, ]
x.oneff <- x.oneff.all %>% filter(!(.data$Event %in% event.tmp) )
x.oneff.tmp <- x.oneff.all %>%
filter(.data$Event %in% event.tmp) %>%
mutate(cont_eff_section = NA, dist_from_prev = NA, seg_idx = NA, segnum = NA)
rownames(x.oneff) <- rownames(x.oneff.tmp) <- NULL
if (!all(x.oneff[!x.oneff$OnEffort, "Event"] == "E"))
stop("Within the continuous effort sections, ",
"some events other than 'E' events are off effort. ",
"This may because of time/time zone issues, ",
"e.g. if continuous effort sections span multiple days ",
"and das_process was run with 'reset.day = TRUE'")
if (sum(c(nrow(x.oneff), nrow(x.oneff.tmp))) != nrow(x.oneff.all))
stop("Error in row numbers - please report this as an issue")
# Filter for specified events, if applicable
if (!is.null(event.touse)) x.oneff <- x.oneff %>% filter(.data$Event %in% event.touse)
# Verbosely remove remaining data without Lat/Lon/DateTime info
if (any(is.na(x.oneff$Lat) | is.na(x.oneff$Lon) | is.na(x.oneff$DateTime))) {
x.nacheck <- x.oneff %>%
mutate(ll_dt_na = is.na(.data$Lat) | is.na(.data$Lon) | is.na(.data$DateTime),
eff_na = .data$ll_dt_na & (.data$Event %in% c("R", "E")),
sight_na = .data$ll_dt_na & (.data$Event %in% c("S", "K", "M", "G", "t", "A")))
# Check that no sightings have NA lat/lon/dt info
if (any(x.nacheck$sight_na))
stop("One or more sightings ",
"have NA Lat/Lon/DateTime values at the following line number(s); ",
"please fix or remove before processing:\n",
.print_file_line(x.nacheck$file_das, x.nacheck$line_num, which(x.nacheck$sight_na)))
# Check that no R/E events have NA lat/lon/dt info
if (any(x.nacheck$eff_na))
stop("One or more effort events (R/E events)",
"have NA Lat/Lon/DateTime values at the following line number(s); ",
"please fix or remove before processing:\n",
.print_file_line(x.nacheck$file_das, x.nacheck$line_num, which(x.nacheck$sight_na)))
# Remove events with NA lat/lon/dt info
x.oneff <- x.oneff %>% filter(!is.na(.data$Lat) & !is.na(.data$Lon) & !is.na(.data$DateTime))
message(paste0("There were ", sum(x.nacheck$ll_dt_na), " on effort ",
ifelse(comment.drop, "(non-C) ", ""), "events ",
"with NA Lat/Lon/DateTime values that will ignored ",
"during segment chopping"))
rm(x.nacheck)
}
# Add in 'events' where effort crosses strata boundary
if (!is.null(strata.files)) {
# Check names - add as needed
if (any(names(strata.files) == "")) {
noname <- names(strata.files) == ""
names(strata.files)[noname] <- paste0("Stratum", seq_along(strata.files)[noname])
} else { #is.null(names(strata.files))
names(strata.files) <- paste0("Stratum", seq_along(strata.files))
}
# Call helper, and sanity check
x.oneff <- das_effort_strata(x.oneff, strata.files)
stopifnot(
all(!is.na(x.oneff$Lon[x.oneff$Event == "strata"])),
all(!is.na(x.oneff$Lat[x.oneff$Event == "strata"]))
)
}
# For each event, calculate distance to previous event
x.oneff$dist_from_prev <- .dist_from_prev(x.oneff, distance.method)
# Determine continuous effort sections
x.oneff$cont_eff_section <- cumsum(x.oneff$Event %in% c("R", "strataR"))
# If specified, verbosely remove cont eff sections with length 0 and no sighting events
if (seg0.drop) {
x.ces.summ <- x.oneff %>%
group_by(.data$cont_eff_section) %>%
summarise(dist_sum = sum(.data$dist_from_prev[-1]),
has_sight = any(c("S", "K", "M", "G", "t") %in% .data$Event),
line_min = min(.data$line_num))
ces.keep <- filter(x.ces.summ, .data$has_sight | .data$dist_sum > 0)[["cont_eff_section"]]
x.oneff <- x.oneff %>% filter(.data$cont_eff_section %in% ces.keep)
x.oneff$cont_eff_section <- cumsum(x.oneff$Event %in% c("R", "strataR"))
message(paste("There were", nrow(x.ces.summ) - length(ces.keep),
"continuous effort sections removed because they have a",
"length of 0 and contain no sighting events"))
rm(x.ces.summ, ces.keep)
}
if (length(unique(x.oneff$cont_eff_section)) != sum(x.oneff$Event %in% c("R", "strataR")) |
max(x.oneff$cont_eff_section) != sum(x.oneff$Event %in% c("R", "strataR")))
stop("Error in processing continuous effort sections - ",
"please report this as an issue")
#----------------------------------------------------------------------------
# Chop and summarize effort using specified method
func.chop <- if (method == "equallength") {
das_chop_equallength
} else if (method == "condition") {
das_chop_condition
} else if (method == "section") {
das_chop_section
} else {
stop("method is not an accepted value")
}
eff.list <- func.chop(
as_das_df(x.oneff), conditions = conditions, num.cores = num.cores, ...
)
x.eff <- eff.list[[1]]
segdata <- eff.list[[2]]
randpicks <- eff.list[[3]]
# Add strata info to segdata as needed - easiest to do this here
if (!is.null(strata.files)) {
x.strata.summ <- x.eff %>%
group_by(.data$segnum) %>%
summarise(strata_which = unique(.data$strata_which),
stratum = ifelse(.data$strata_which == 0, NA,
names(strata.files)[.data$strata_which])) %>%
select(.data$segnum, .data$stratum)
if (nrow(x.strata.summ) != nrow(segdata))
stop("Error processing strata and segdata - please report this as an issue")
segdata <- segdata %>% left_join(x.strata.summ, by = "segnum")
x.eff <- x.eff %>% select(-!!c(names(strata.files), "strata_which"))
}
# Check that things are as expected
x.eff.names <- c(
names(x), "dist_from_prev", "cont_eff_section", "seg_idx", "segnum"
# if (is.null(strata.files)) NULL else c(names(strata.files), "strata_which"),
)
if (!identical(names(x.eff), x.eff.names))
stop("Error in das_effort: names of x.eff. Please report this as an issue")
if (!all(x.eff$segnum %in% segdata$segnum))
stop("Error in das_effort(): creating and processing segement numbers. ",
"Please report this as an issue")
# Add back in ? and 1:8 (events.tmp) events, if necessary
# Only for sightinfo groupsizes, and thus no segdata info doesn't matter
if (nrow(x.oneff.tmp) > 0) x.eff <- bind_rows(x.eff, x.oneff.tmp)
x.eff.all <- x.eff %>%
arrange(.data$idx_eff) %>%
select(-.data$idx_eff)
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
# Summarize sightings
sightinfo <- x.eff.all %>%
left_join(select(segdata, .data$segnum, .data$mlat, .data$mlon),
by = "segnum") %>%
das_sight(returnformat = "default") %>%
mutate(included = (.data$Bft <= 5 & .data$OnEffort & .data$ObsStd),
included = ifelse(is.na(.data$included), FALSE, .data$included)) %>%
select(-.data$dist_from_prev, -.data$cont_eff_section)
# Clean and return
segdata <- segdata %>% select(-.data$seg_idx)
sightinfo <- sightinfo %>%
mutate(year = year(.data$DateTime)) %>%
select(-.data$seg_idx) %>%
select(.data$segnum, .data$mlat, .data$mlon, .data$Event,
.data$DateTime, .data$year, everything())
list(segdata = segdata, sightinfo = sightinfo, randpicks = randpicks)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.