diff --git a/DESCRIPTION b/DESCRIPTION index 06ae2e6..0bbf0d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,4 +33,4 @@ License: Apache License (== 2) Encoding: UTF-8 Roxygen: list(markdown = TRUE) VignetteBuilder: knitr -Config/roxygen2/version: 8.0.0 +Config/roxygen2/version: 8.1.0 diff --git a/NAMESPACE b/NAMESPACE index 0b65ac8..c4db048 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -59,71 +59,93 @@ export(das_sight) export(das_spcodes_read) export(distance_greatcircle) export(randpicks_convert) -importFrom(dplyr,add_row) -importFrom(dplyr,arrange) -importFrom(dplyr,between) -importFrom(dplyr,bind_cols) -importFrom(dplyr,bind_rows) -importFrom(dplyr,case_when) -importFrom(dplyr,desc) -importFrom(dplyr,distinct) -importFrom(dplyr,everything) -importFrom(dplyr,filter) -importFrom(dplyr,full_join) -importFrom(dplyr,group_by) -importFrom(dplyr,if_else) -importFrom(dplyr,lag) -importFrom(dplyr,left_join) -importFrom(dplyr,mutate) -importFrom(dplyr,n) -importFrom(dplyr,n_distinct) -importFrom(dplyr,reframe) -importFrom(dplyr,right_join) -importFrom(dplyr,select) -importFrom(dplyr,slice) -importFrom(dplyr,starts_with) -importFrom(dplyr,summarise) -importFrom(dplyr,ungroup) -importFrom(lubridate,day) -importFrom(lubridate,month) -importFrom(lubridate,tz) -importFrom(lubridate,year) +importFrom(dplyr, + across, + add_row, + arrange, + between, + bind_cols, + bind_rows, + case_when, + desc, + distinct, + everything, + filter, + full_join, + group_by, + if_else, + lag, + left_join, + mutate, + n, + n_distinct, + pull, + reframe, + right_join, + select, + slice, + starts_with, + summarise, + ungroup +) +importFrom(lubridate, + day, + month, + tz, + year +) importFrom(magrittr,"%>%") importFrom(methods,setOldClass) -importFrom(parallel,clusterExport) -importFrom(parallel,detectCores) -importFrom(parallel,parLapplyLB) -importFrom(parallel,stopCluster) -importFrom(purrr,map_chr) -importFrom(purrr,pmap) -importFrom(purrr,pmap_int) -importFrom(purrr,pmap_lgl) -importFrom(readr,col_character) -importFrom(readr,cols) -importFrom(readr,fwf_cols) -importFrom(readr,fwf_positions) -importFrom(readr,read_fwf) -importFrom(rlang,"!!") -importFrom(rlang,.data) -importFrom(sf,st_as_sf) -importFrom(sf,st_cast) -importFrom(sf,st_coordinates) -importFrom(sf,st_geometry) -importFrom(sf,st_intersection) -importFrom(sf,st_intersects) -importFrom(sf,st_linestring) -importFrom(sf,st_polygon) -importFrom(sf,st_sf) -importFrom(sf,st_sfc) -importFrom(sf,st_wrap_dateline) -importFrom(stats,na.omit) -importFrom(stats,runif) -importFrom(swfscMisc,bearing) -importFrom(swfscMisc,destination) -importFrom(swfscMisc,distance) -importFrom(swfscMisc,setupClusters) +importFrom(parallel, + clusterExport, + detectCores, + parLapplyLB, + stopCluster +) +importFrom(purrr, + map_chr, + pmap, + pmap_int, + pmap_lgl +) +importFrom(readr, + col_character, + cols, + fwf_cols, + fwf_positions, + read_fwf +) +importFrom(rlang, + "!!", + .data +) +importFrom(sf, + st_as_sf, + st_cast, + st_coordinates, + st_geometry, + st_intersection, + st_intersects, + st_linestring, + st_polygon, + st_sf, + st_sfc, + st_wrap_dateline +) +importFrom(stats, + na.omit, + runif +) +importFrom(swfscMisc, + bearing, + destination, + distance, + setupClusters +) importFrom(tidyr,pivot_longer) -importFrom(utils,head) -importFrom(utils,read.csv) -importFrom(utils,tail) -importFrom(utils,write.csv) +importFrom(utils, + head, + read.csv, + tail, + write.csv +) diff --git a/NEWS.md b/NEWS.md index 1266ca6..954f0c8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,18 +1,28 @@ # swfscDAS 0.7.0.9000 -* Fix bug in `das_process` of incorrect OffsetGMT values, stemming from `as.Date` using 'UTC' tz by default (#16) +* Fixed bug in `das_process` of incorrect OffsetGMT values, stemming from `as.Date` using 'UTC' tz by default (#16) + +* Fixed bug in `das_segdata` to actually only use the last condition value for a segment of length zero (#27) * Added an exported function `das_spcodes_read` for consistent reading of shipboard SpCode files * Changed the argument name in `das_check` of the user-provided SpCodes file from `sp.codes` to `sp.codes.file`. Also added a `sp.codes.skip` argument to pass to `das_spcodes_read` +* Added 'SwellDir' (Event V, Data 3) and 'WindDir' (Event W, Data 4) to the output of `das_process` (#21) + +* Changed behavior of `das_effort` when the `seg0.drop` argument is `TRUE`. Now, for segments with distance traveled <=0.1 km, either a) they are dropped if they have no associated sighting events are dropped, or b) if they have associated sightings they are kept and given a distance of 0.1km. This behavior matches historical SWFSC segment chopping logic (#22) + +* Added optional argument `gs.sp.min1` to `das_sight`, to allow the user to choose to set the minimum value for all non-NA species group size values to 1. This functionality is important for group size calibration efforts. Users can also specify this argument in `das_effort`, where it is passed to `das_sight` when creating the sightinfo data frame (#26) + +* Added 'Trackline' (Event R, Data 3)to the output of `das_process` (#10) + * Moved example data files to an 'extdata' folder within 'inst' -* Update link to NOAA Tech Memo describing DAS data; now (https://repository.library.noaa.gov/view/noaa/3174)[https://repository.library.noaa.gov/view/noaa/3174](#17) +* Update link to NOAA Tech Memo describing DAS data; now [https://repository.library.noaa.gov/view/noaa/3174](#17) -* Update roxygen to use markdown, fix documentation issues related to upgrade to roxygen2 v8.0 +* Update roxygen to use markdown, fix documentation issues related to upgrade to roxygen2 v8 -* Added the SpCodes.dat file from [`CruzPlot`](https://github.com/SWFSC/CruzPlot) to 'inst' to have available as a default +* Added the SpCodes.dat file (from [`CruzPlot`](https://github.com/SWFSC/CruzPlot)) to 'inst' to have available as a default # swfscDAS 0.6.4 diff --git a/R/as_das_df.R b/R/as_das_df.R index 4853d74..034c85c 100644 --- a/R/as_das_df.R +++ b/R/as_das_df.R @@ -38,7 +38,9 @@ as_das_df.data.frame <- function(x) { SpdKt = "numeric", Bft = "numeric", SwellHght = "numeric", + SwellDir = "numeric", WindSpdKt = "numeric", + WindDir = "numeric", RainFog = "numeric", HorizSun = "numeric", VertSun = "numeric", diff --git a/R/das_check.R b/R/das_check.R index 9344212..524ba33 100644 --- a/R/das_check.R +++ b/R/das_check.R @@ -43,11 +43,14 @@ #' Echo sounder \tab B \tab Data4 \tab Must be one of Y, N, y, n, or NA (blank) \cr #' Effort type \tab R \tab Data1 \tab Must be one of F, N, S, or NA (blank) \cr #' ESW sides \tab R \tab Data2 \tab Effective strip width; must be one of F, H, or NA (blank) \cr +#' Trackline number \tab R \tab Data3 \tab Trackline number, represented as a character \cr #' Course \tab N \tab Data1 \tab Can be converted to a numeric value \cr #' Speed \tab N \tab Data2 \tab Can be converted to a numeric value \cr #' Beaufort \tab V \tab Data1 \tab Must be a whole number between 0 and 9 \cr #' Swell height \tab V \tab Data2 \tab Can be converted to a numeric value \cr +#' Swell direction \tab V \tab Data3 \tab Can be converted to a numeric value \cr #' Wind speed \tab V \tab Data5 \tab Can be converted to a numeric value \cr +#' Wind direction \tab W \tab Data4 \tab Can be converted to a numeric value \cr #' Rain or fog \tab W \tab Data1 \tab Must be between 0 and 5 and either a whole number or have decimal value .5\cr #' Horizontal sun \tab W \tab Data2 \tab Must be a whole number between 0 and 12 \cr #' Vertical sun \tab W \tab Data3 \tab Must be a whole number between 0 and 12 \cr @@ -336,7 +339,7 @@ das_check <- function( txt.e.na <- "E events should only have data in the Data1 column" # R events - idx.r.na <- .check_isna(x, c("R"), paste0("Data", 3:9)) + idx.r.na <- .check_isna(x, c("R"), paste0("Data", 4:9)) txt.r.na <- "R events should only have data in the Data1-2 columns" # N events @@ -413,10 +416,18 @@ das_check <- function( idx.v.2 <- .check_numeric(x, "V", "Data2") txt.v.2 <- "Swell height (Data2 of V events) cannot be converted to a numeric" + # Swell direction + idx.v.2 <- .check_numeric(x, "V", "Data3") + txt.v.2 <- "Swell direction (Data3 of V events) cannot be converted to a numeric" + # Wind speed idx.v.5 <- .check_numeric(x, "V", "Data5") txt.v.5 <- "Wind speed (Data5 of V events) cannot be converted to a numeric" + # Wind direction + idx.v.5 <- .check_numeric(x, "W", "Data4") + txt.v.5 <- "Wind direction (Data4 of W events) cannot be converted to a numeric" + # RainFog rf.acc <- c(seq(0, 5, by = 0.5), sprintf("%02d", 1:5), NA) idx.w.1 <- .check_character(x, "W", "Data1", rf.acc) diff --git a/R/das_class.R b/R/das_class.R index ec45413..bd100ac 100644 --- a/R/das_class.R +++ b/R/das_class.R @@ -83,7 +83,9 @@ NULL #' SpdKt \tab "numeric"\cr #' Bft \tab "numeric"\cr #' SwellHght \tab "numeric"\cr +#' SwellDir \tab "numeric"\cr #' WindSpdKt \tab "numeric"\cr +#' WindDir \tab "numeric"\cr #' RainFog \tab "numeric"\cr #' HorizSun \tab "numeric"\cr #' VertSun \tab "numeric"\cr diff --git a/R/das_effort.R b/R/das_effort.R index 4827a90..8146c25 100644 --- a/R/das_effort.R +++ b/R/das_effort.R @@ -1,401 +1,432 @@ -#' 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("extdata", "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("extdata", "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("extdata", "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("segnum", "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(-"idx_eff") - - - #---------------------------------------------------------------------------- - #---------------------------------------------------------------------------- - # Summarize sightings - sightinfo <- x.eff.all %>% - left_join(select(segdata, "segnum", "mlat", "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(-c("dist_from_prev", "cont_eff_section")) - - # Clean and return - segdata <- segdata %>% select(-"seg_idx") - - sightinfo <- sightinfo %>% - mutate(year = year(.data$DateTime)) %>% - select(-"seg_idx") %>% - select("segnum", "mlat", "mlon", "Event", "DateTime", "year", everything()) - - list(segdata = segdata, sightinfo = sightinfo, randpicks = randpicks) -} +#' 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 'short' +#' segments that contain no sighting (S, K, M, G, t) events. In this case, +#' 'short' segments are defined as segments with a distance traveled of +#' <=0.1km. Additionally, any 'short' segments with both a distance traveled +#' of <=0.1km and one (or more) sightings will have a 'calculated' distance of +#' `0.1` in the segdata output. This matches historical SWFSC segment chopping +#' logic. 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 gs.sp.min1 passed directly to \code{\link{das_sight}} +#' @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("extdata", "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("extdata", "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("extdata", "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, + gs.sp.min1 = FALSE, + 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.1, + # 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 <- x.ces.summ %>% + filter(.data$has_sight | .data$dist_sum > 0.1) %>% + pull(.data$cont_eff_section) + + x.oneff <- x.oneff %>% + filter(.data$cont_eff_section %in% ces.keep) + + # Recalculate cont eff section index + 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 (n_distinct(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("segnum", "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(-"idx_eff") + + + #---------------------------------------------------------------------------- + #---------------------------------------------------------------------------- + # Summarize sightings + sightinfo <- x.eff.all %>% + left_join(select(segdata, "segnum", "mlat", "mlon"), + by = "segnum") %>% + das_sight(return.format = "default", + gs.sp.min1 = gs.sp.min1) %>% + mutate(included = (.data$Bft <= 5 & .data$OnEffort & .data$ObsStd), + included = ifelse(is.na(.data$included), FALSE, .data$included)) %>% + select(-c("dist_from_prev", "cont_eff_section")) + + # Clean and return + segdata <- segdata %>% select(-"seg_idx") + # If seg0.drop, then set minimum distance to 0.1 + if (seg0.drop) { + segdata <- segdata %>% + mutate(dist = pmax(.data$dist, 0.1)) + } + + sightinfo <- sightinfo %>% + mutate(year = year(.data$DateTime)) %>% + select(-"seg_idx") %>% + select("segnum", "mlat", "mlon", "Event", "DateTime", "year", everything()) + + # browser() + # if (TODO) { + # sightinfo <- sightinfo %>% + # mutate(across(starts_with("GsSp"), ~ pmax(.x, 1))) + # } + + list(segdata = segdata, sightinfo = sightinfo, randpicks = randpicks) +} diff --git a/R/das_process.R b/R/das_process.R index 17ea227..f7b8723 100644 --- a/R/das_process.R +++ b/R/das_process.R @@ -97,15 +97,18 @@ #' GMT offset of DateTime data \tab OffsetGMT \tab Event: B; Column: Data3\cr #' Effort type \tab EffType \tab Event: R; Column: Data1\cr #' Number of sides with observer \tab ESWSide \tab Event: R; Column: Data2\cr +#' Trackline number \tab Trackline \tab Event: R; Column: Data3\cr #' Course (ship direction) \tab Course \tab Event: N; Column: Data1\cr #' Speed (ship speed, knots) \tab SpdKt \tab Event: N; Column: Data2\cr #' Beaufort sea state \tab Bft \tab Event: V; Column: Data1\cr #' Swell height (ft) \tab SwellHght \tab Event: V; Column: Data2\cr +#' Swell direction (degrees) \tab SwellDir \tab Event: V; Column: Data3\cr #' Wind speed (knots) \tab WindSpdKt \tab Event: V; Column: Data5\cr #' Rain/fog/haze code \tab RainFog \tab Event: W; Column: Data1\cr #' Horizontal sun (clock system) \tab HorizSun \tab Event: W; Column: Data2\cr #' Vertical sun (clock system) \tab VertSun \tab Event: W; Column: Data3\cr #' Glare \tab Glare \tab HorizSun and VertSun\cr +#' Wind direction (degrees) \tab WindDir \tab Event: W; Column: Data4\cr #' Visibility (nm) \tab Vis \tab Event: W; Column: Data5\cr #' Left observer \tab ObsL \tab Event: P; Column: Data1\cr #' Data recorder \tab Rec \tab Event: P; Column: Data2\cr @@ -298,21 +301,24 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, Mode <- .process_chr(init.val, x, "Data2", event.B, "C") EffType <- .process_chr(init.val, x, "Data1", event.R, "S") ESWsides <- .process_chr(init.val, x, "Data2", event.R, "F") + Trackline <- .process_chr(init.val, x, "Data3", event.R, event.na) Course <- .process_num(init.val, x, "Data1", event.N, event.na) SpdKt <- .process_num(init.val, x, "Data2", event.N, event.na) Bft <- .process_num(init.val, x, "Data1", event.V, event.na) SwellHght <- .process_num(init.val, x, "Data2", event.V, event.na) + SwellDir <- .process_num(init.val, x, "Data3", event.V, event.na) WindSpdKt <- .process_num(init.val, x, "Data5", event.V, event.na) RainFog <- .process_num(init.val, x, "Data1", event.W, event.na) HorizSun <- .process_num(init.val, x, "Data2", event.W, event.na) VertSun <- .process_num(init.val, x, "Data3", event.W, event.na) + WindDir <- .process_num(init.val, x, "Data4", event.W, event.na) Vis <- .process_num(init.val, x, "Data5", event.W, event.na) - ObsL <- .process_chr(init.val, x, "Data1", event.P, event.na) - Rec <- .process_chr(init.val, x, "Data2", event.P, event.na) - ObsR <- .process_chr(init.val, x, "Data3", event.P, event.na) - ObsInd <- .process_chr(init.val, x, "Data4", event.P, event.na) + ObsL <- .process_chr(init.val, x, "Data1", event.P, event.na) + Rec <- .process_chr(init.val, x, "Data2", event.P, event.na) + ObsR <- .process_chr(init.val, x, "Data3", event.P, event.na) + ObsInd <- .process_chr(init.val, x, "Data4", event.P, event.na) Eff <- as.logical(init.val) Eff[sort(unique(c(idx.new.cruise, idx.new.day)))] <- FALSE @@ -331,28 +337,28 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, for (i in 1:nDAS) { # Reset all info when starting data for a new cruise if (i %in% idx.new.cruise) { - LastEff <- LastEMode <- LastEType <- LastESW <- + LastEff <- LastEMode <- LastEType <- LastESW <- LastTrackline <- LastCourse <- LastSpdKt <- - LastBft <- LastSwH <- LastWSpdKt <- - LastRF <- LastHS <- LastVS <- LastVis <- + LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- + LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- LastCruise <- NA } # Reset applicable info (aka all but 'LastCruise') when starting a new day if ((i %in% idx.new.day) & reset.day) { - LastEff <- LastEMode <- LastEType <- LastESW <- + LastEff <- LastEMode <- LastEType <- LastESW <- LastTrackline <- LastCourse <- LastSpdKt <- - LastBft <- LastSwH <- LastWSpdKt <- - LastRF <- LastHS <- LastVS <- LastVis <- + LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- + LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- NA } # Reset applicable info (all RPVNW-related) when starting BR/R event sequence if ((i %in% idx.eff) & reset.effort) { - LastEType <- LastESW <- LastCourse <- LastSpdKt <- - LastBft <- LastSwH <- LastWSpdKt <- - LastRF <- LastHS <- LastVS <- LastVis <- + LastEType <- LastESW <- LastTrackline <- LastCourse <- LastSpdKt <- + LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- + LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- NA } @@ -363,12 +369,15 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, if (is.na(SpdKt[i])) SpdKt[i] <- LastSpdKt else LastSpdKt <- SpdKt[i] #Speed if (is.na(EffType[i])) EffType[i] <- LastEType else LastEType <- EffType[i] #Effort type if (is.na(ESWsides[i])) ESWsides[i] <- LastESW else LastESW <- ESWsides[i] #Sides being surveyed + if (is.na(Trackline[i])) Trackline[i] <- LastTrackline else LastTrackline <- Trackline[i] #Trackline num if (is.na(Bft[i])) Bft[i] <- LastBft else LastBft <- Bft[i] #Beaufort if (is.na(SwellHght[i])) SwellHght[i] <- LastSwH else LastSwH <- SwellHght[i] #Swell height + if (is.na(SwellDir[i])) SwellDir[i] <- LastSwD else LastSwD <- SwellDir[i] # Swell direction if (is.na(WindSpdKt[i])) WindSpdKt[i] <- LastWSpdKt else LastWSpdKt <- WindSpdKt[i] #Wind speed if (is.na(RainFog[i])) RainFog[i] <- LastRF else LastRF <- RainFog[i] #Rain or fog if (is.na(HorizSun[i])) HorizSun[i] <- LastHS else LastHS <- HorizSun[i] #Horizontal sun if (is.na(VertSun[i])) VertSun[i] <- LastVS else LastVS <- VertSun[i] #Vertical sun + if (is.na(WindDir[i])) WindDir[i] <- LastWDir else LastWDir <- WindDir[i] #Wind direction if (is.na(Vis[i])) Vis[i] <- LastVis else LastVis <- Vis[i] #Visibility if (is.na(ObsL[i])) ObsL[i] <- LastObsL else LastObsL <- ObsL[i] #Left obs if (is.na(Rec[i])) Rec[i] <- LastRec else LastRec <- Rec[i] #Recorder @@ -382,8 +391,10 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, ### Post-processing tmp <- list( Cruise = Cruise, Mode = Mode, - EffType = EffType, ESWsides = ESWsides, Course = Course, SpdKt = SpdKt, - Bft = Bft, SwellHght = SwellHght, WindSpdKt = WindSpdKt, + EffType = EffType, ESWsides = ESWsides, Trackline = Trackline, + Course = Course, SpdKt = SpdKt, + Bft = Bft, SwellHght = SwellHght, SwellDir = SwellDir, + WindSpdKt = WindSpdKt, WindDir = WindDir, RainFog = RainFog, HorizSun = HorizSun, VertSun = VertSun, Vis = Vis, OnEffort = Eff, ObsL = ObsL, Rec = Rec, ObsR = ObsR, ObsInd = ObsInd @@ -407,6 +418,7 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, tmp$Mode <- as.character(toupper(tmp$Mode)) tmp$EffType <- as.character(tmp$EffType) tmp$ESWsides <- case_when(tmp$ESWsides == "F" ~ 2, tmp$ESWsides == "H" ~ 1) + tmp$Trackline <- as.character(tmp$Trackline) # tmp$RainFog <- as.logical(ifelse(is.na(tmp$RainFog), NA, tmp$RainFog %in% c(2:4))) # In case any are all NAs @@ -444,8 +456,8 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, ### Create and order data frame to return cols.tokeep <- c( "Event", "DateTime", "Lat", "Lon", "OnEffort", - "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Course", "SpdKt", - "Bft", "SwellHght", "WindSpdKt", + "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Trackline", + "Course", "SpdKt", "Bft", "SwellHght", "SwellDir", "WindSpdKt", "WindDir", "RainFog", "HorizSun", "VertSun", "Glare", "Vis", "ObsL", "Rec", "ObsR", "ObsInd", paste0("Data", 1:12), "EffortDot", "EventNum", "file_das", "line_num" diff --git a/R/das_segdata.R b/R/das_segdata.R index a3a73ca..f2d9ea5 100644 --- a/R/das_segdata.R +++ b/R/das_segdata.R @@ -100,7 +100,7 @@ das_segdata.das_df <- function(x, conditions, segdata.method = c("avg", "maxdist # Prep stuff - get the info that is consistent for the entire effort length # ymd determined below to be safe df.out1.cols <- c("file_das", "Cruise", "Mode", "OffsetGMT", - "EffType", "ESWsides") + "EffType", "ESWsides", "Trackline") # <=1 accounts for when all df.out1.check <- vapply(df.out1.cols, function(i) { @@ -191,17 +191,18 @@ das_segdata.das_df <- function(x, conditions, segdata.method = c("avg", "maxdist conditions.list.df <- data.frame( lapply(names(conditions.list), function(k, das.df) { val.out <- unique(na.omit(das.df[[k]])) - if (length(val.out) > 1) + if (length(val.out) > 1) { warning("The continuous effort section with section_id ", section.id, " has a distance of 0, ", "and multiple values for condition ", k, - ". Only the first element will be output", + ". The final value of this condition ", + "will be provided in the output", immediate. = TRUE) - if (length(val.out) == 0) NA else val.out + } + if (length(val.out) == 0) NA else tail(val.out, 1) }, das.df = das.df) ) names(conditions.list.df) <- conditions.names - enddt.curr <- tail(das.df$DateTime, 1) # ### Message printed in das_chop_equallength, outside of parallel calls diff --git a/R/das_sight.R b/R/das_sight.R index 4037bae..b8b069f 100644 --- a/R/das_sight.R +++ b/R/das_sight.R @@ -10,6 +10,9 @@ #' @param return.events character; event codes included in the output. #' Must be one or more of: "S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F" #' (case-sensitive). The default is all of these event codes +#' @param gs.sp.min1 logical; flag indicating whether species group size columns +#' will be set to a minimum value of 1 (TRUE) or maintain the raw values +#' (FALSE, default). See the 'Details' section below #' #' @details #' DAS events contain specific information in the 'Data#' columns, with the @@ -34,7 +37,15 @@ #' #' Abbreviations used in output column names: Gs = group size, Sp = species, Nm #' = nautical mile, Perc = percentage, Prob = probable, GsSchool = school-level -#' group size info +#' group size info, GsSp = species-level group size info. +#' +#' Species group sizes are calculated as the product of the arithmetic mean of +#' the corresponding school group size and the species percentage. These values +#' are reported in 'GsSp...' columns for 'default' and 'wide' output formats. +#' Sometimes, however, these species group size estimates may be less than 1, +#' depending on how the means work out across different observers. If +#' \code{gs.sp.min1} is \code{TRUE}, any values in 'GsSp...' columns that are +#' less than 1 are set to 1, via e.g. \code{\link{pmin}(GsSpBest, 1)} #' #' This function makes the following assumptions, and alterations to the raw DAS #' data: @@ -211,9 +222,13 @@ das_sight.data.frame <- function(x, ...) { #' @name das_sight #' @export -das_sight.das_df <- function(x, return.format = c("default", "wide", "complete"), - return.events = c("S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F"), - ...) { +das_sight.das_df <- function( + x, + return.format = c("default", "wide", "complete"), + return.events = c("S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F"), + gs.sp.min1 = FALSE, + ... +) { mean_narm <- function(i) mean(i, na.rm = TRUE) #---------------------------------------------------------------------------- @@ -226,6 +241,7 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete") event.sight <- c("S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F") event.sight.info <- c("A", "?", 1:8) + # browser() sight.df <- x %>% filter(.data$Event %in% c(event.sight, event.sight.info)) %>% mutate(sight_cumsum = cumsum(.data$Event %in% event.sight)) @@ -556,7 +572,12 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete") #-------------------------------------------------------- - ### Calculate perp dist and return + ### Calculate perp dist, adjust GsSp..., and return + if (gs.sp.min1) { + to.return <- to.return %>% + mutate(across(starts_with("GsSp"), ~ pmax(.x, 1))) + } + to.return %>% mutate(PerpDistKm = abs(sin(.data$Bearing*pi/180) * .data$DistNm) * 1.852) %>% filter(.data$Event %in% return.events) diff --git a/R/swfscDAS-package.R b/R/swfscDAS-package.R index baadd72..6642bf2 100644 --- a/R/swfscDAS-package.R +++ b/R/swfscDAS-package.R @@ -12,7 +12,7 @@ #' @author Sam Woodman \email{sam.woodman@@noaa.gov} #' @seealso \url{https://swfsc.github.io/swfscDAS/} #' -#' @importFrom dplyr add_row arrange between bind_cols bind_rows case_when desc distinct everything filter full_join group_by if_else lag left_join mutate n n_distinct reframe right_join select slice starts_with summarise ungroup +#' @importFrom dplyr across add_row arrange between bind_cols bind_rows case_when desc distinct everything filter full_join group_by if_else lag left_join mutate n n_distinct pull reframe right_join select slice starts_with summarise ungroup #' @importFrom lubridate year month day tz #' @importFrom magrittr %>% #' @importFrom methods setOldClass diff --git a/man/das_check.Rd b/man/das_check.Rd index d71dbe5..5b5e5f7 100644 --- a/man/das_check.Rd +++ b/man/das_check.Rd @@ -72,11 +72,14 @@ Mode \tab B \tab Data2 \tab Must be one Echo sounder \tab B \tab Data4 \tab Must be one of Y, N, y, n, or NA (blank) \cr Effort type \tab R \tab Data1 \tab Must be one of F, N, S, or NA (blank) \cr ESW sides \tab R \tab Data2 \tab Effective strip width; must be one of F, H, or NA (blank) \cr +Trackline number \tab R \tab Data3 \tab Trackline number, represented as a character \cr Course \tab N \tab Data1 \tab Can be converted to a numeric value \cr Speed \tab N \tab Data2 \tab Can be converted to a numeric value \cr Beaufort \tab V \tab Data1 \tab Must be a whole number between 0 and 9 \cr Swell height \tab V \tab Data2 \tab Can be converted to a numeric value \cr +Swell direction \tab V \tab Data3 \tab Can be converted to a numeric value \cr Wind speed \tab V \tab Data5 \tab Can be converted to a numeric value \cr +Wind direction \tab W \tab Data4 \tab Can be converted to a numeric value \cr Rain or fog \tab W \tab Data1 \tab Must be between 0 and 5 and either a whole number or have decimal value .5\cr Horizontal sun \tab W \tab Data2 \tab Must be a whole number between 0 and 12 \cr Vertical sun \tab W \tab Data3 \tab Must be a whole number between 0 and 12 \cr diff --git a/man/das_df-class.Rd b/man/das_df-class.Rd index 14d06aa..3b7a63e 100644 --- a/man/das_df-class.Rd +++ b/man/das_df-class.Rd @@ -39,7 +39,9 @@ Course \tab "numeric"\cr SpdKt \tab "numeric"\cr Bft \tab "numeric"\cr SwellHght \tab "numeric"\cr +SwellDir \tab "numeric"\cr WindSpdKt \tab "numeric"\cr +WindDir \tab "numeric"\cr RainFog \tab "numeric"\cr HorizSun \tab "numeric"\cr VertSun \tab "numeric"\cr diff --git a/man/das_effort.Rd b/man/das_effort.Rd index 1f0aec4..d419dbb 100644 --- a/man/das_effort.Rd +++ b/man/das_effort.Rd @@ -19,6 +19,7 @@ das_effort(x, ...) seg0.drop = FALSE, comment.drop = FALSE, event.touse = NULL, + gs.sp.min1 = FALSE, num.cores = NULL, ... ) @@ -52,9 +53,13 @@ lat/lon coordinates. Can be "greatcircle", "lawofcosines", "haversine", "vincenty", or any partial match thereof (case sensitive). Default is "greatcircle"} -\item{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}} +\item{seg0.drop}{logical; flag indicating whether or not to drop 'short' +segments that contain no sighting (S, K, M, G, t) events. In this case, +'short' segments are defined as segments with a distance traveled of +<=0.1km. Additionally, any 'short' segments with both a distance traveled +of <=0.1km and one (or more) sightings will have a 'calculated' distance of +\code{0.1} in the segdata output. This matches historical SWFSC segment chopping +logic. Default is \code{FALSE}} \item{comment.drop}{logical; flag indicating if comments ("C" events) should be ignored (i.e. position information should not be used) when segment @@ -65,6 +70,8 @@ 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} +\item{gs.sp.min1}{passed directly to \code{\link{das_sight}}} + \item{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 diff --git a/man/das_process.Rd b/man/das_process.Rd index 6626a99..829edba 100644 --- a/man/das_process.Rd +++ b/man/das_process.Rd @@ -67,15 +67,18 @@ Effort mode \tab Mode \tab Event: B; Column: Data2\cr GMT offset of DateTime data \tab OffsetGMT \tab Event: B; Column: Data3\cr Effort type \tab EffType \tab Event: R; Column: Data1\cr Number of sides with observer \tab ESWSide \tab Event: R; Column: Data2\cr +Trackline number \tab Trackline \tab Event: R; Column: Data3\cr Course (ship direction) \tab Course \tab Event: N; Column: Data1\cr Speed (ship speed, knots) \tab SpdKt \tab Event: N; Column: Data2\cr Beaufort sea state \tab Bft \tab Event: V; Column: Data1\cr Swell height (ft) \tab SwellHght \tab Event: V; Column: Data2\cr +Swell direction (degrees) \tab SwellDir \tab Event: V; Column: Data3\cr Wind speed (knots) \tab WindSpdKt \tab Event: V; Column: Data5\cr Rain/fog/haze code \tab RainFog \tab Event: W; Column: Data1\cr Horizontal sun (clock system) \tab HorizSun \tab Event: W; Column: Data2\cr Vertical sun (clock system) \tab VertSun \tab Event: W; Column: Data3\cr Glare \tab Glare \tab HorizSun and VertSun\cr +Wind direction (degrees) \tab WindDir \tab Event: W; Column: Data4\cr Visibility (nm) \tab Vis \tab Event: W; Column: Data5\cr Left observer \tab ObsL \tab Event: P; Column: Data1\cr Data recorder \tab Rec \tab Event: P; Column: Data2\cr diff --git a/man/das_sight.Rd b/man/das_sight.Rd index eb3fdc1..a5b8c6c 100644 --- a/man/das_sight.Rd +++ b/man/das_sight.Rd @@ -14,6 +14,7 @@ das_sight(x, ...) x, return.format = c("default", "wide", "complete"), return.events = c("S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F"), + gs.sp.min1 = FALSE, ... ) } @@ -29,6 +30,10 @@ or any partial match thereof (case sensitive). Formats described below} \item{return.events}{character; event codes included in the output. Must be one or more of: "S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F" (case-sensitive). The default is all of these event codes} + +\item{gs.sp.min1}{logical; flag indicating whether species group size columns +will be set to a minimum value of 1 (TRUE) or maintain the raw values +(FALSE, default). See the 'Details' section below} } \value{ Data frame with 1) the columns from \code{x}, excluding the 'Data#' columns, @@ -112,7 +117,15 @@ the output of \code{das_sight} by event codes Abbreviations used in output column names: Gs = group size, Sp = species, Nm = nautical mile, Perc = percentage, Prob = probable, GsSchool = school-level -group size info +group size info, GsSp = species-level group size info. + +Species group sizes are calculated as the product of the arithmetic mean of +the corresponding school group size and the species percentage. These values +are reported in 'GsSp...' columns for 'default' and 'wide' output formats. +Sometimes, however, these species group size estimates may be less than 1, +depending on how the means work out across different observers. If +\code{gs.sp.min1} is \code{TRUE}, any values in 'GsSp...' columns that are +less than 1 are set to 1, via e.g. \code{\link{pmin}(GsSpBest, 1)} This function makes the following assumptions, and alterations to the raw DAS data: diff --git a/tests/testthat/test-output.R b/tests/testthat/test-output.R index 9aa916d..ea48c5d 100644 --- a/tests/testthat/test-output.R +++ b/tests/testthat/test-output.R @@ -4,8 +4,9 @@ y.proc <- das_process(y.read) exp.proc.name <- c( "Event", "DateTime", "Lat", "Lon", "OnEffort", - "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Course", "SpdKt", - "Bft", "SwellHght", "WindSpdKt", + "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Trackline", + "Course", "SpdKt", + "Bft", "SwellHght", "SwellDir", "WindSpdKt", "WindDir", "RainFog", "HorizSun", "VertSun", "Glare", "Vis", "ObsL", "Rec", "ObsR", "ObsInd", "EffortDot", "EventNum", "file_das", "line_num" @@ -89,11 +90,14 @@ test_that("das_process output has expected column names and classes", { OffsetGMT = "integer", EffType = "character", ESWsides = "numeric", + Trackline = "character", Course = "numeric", SpdKt = "numeric", Bft = "numeric", SwellHght = "numeric", + SwellDir = "numeric", WindSpdKt = "numeric", + WindDir = "numeric", RainFog = "numeric", HorizSun = "numeric", VertSun = "numeric", diff --git a/vignettes/swfscDAS.Rmd b/vignettes/swfscDAS.Rmd index 2c60d51..26383b3 100644 --- a/vignettes/swfscDAS.Rmd +++ b/vignettes/swfscDAS.Rmd @@ -133,6 +133,8 @@ glimpse(y.eff.sight$segdata) glimpse(y.eff.sight$sightinfo) ``` +Note that `das_effort` contains several arguments that allow for more control over segmentation steps. These arguments include `seg0.drop` (to drop segments of length <=0.1 with no sightings), `comment.drop` (should positions from comment events be used when segment chopping), and `event.touse` (which events to use when determining segment lengths). See the function documentation (`?das_effort`) for more details. Additionally, for group size calibration work, users can use the `gs.sp.min1` argument to specify if species group size values should have a minimum value of 1. + ## Strata This package contains several methods to incorporate strata into your DAS data processing: `das_intersects_strata` for assigning points to strata and `das_effort` for chopping effort lines by strata. These functions contain a 'strata.files' argument, which expects a (named) list of paths to CSV files; names are automatically generated if not provided. These files must have headers, longitude values in column one and latitude values in column two, and be closed polygons.