From 665029438288c50fd0e57dfcca13ba140dfa6de8 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Tue, 28 Jul 2026 13:02:39 -0700 Subject: [PATCH 01/10] Add wind and swell direction to process output, fixes #21 --- NEWS.md | 2 ++ R/as_das_df.R | 2 ++ R/das_class.R | 2 ++ R/das_process.R | 31 +++++++++++++++++++------------ man/das_df-class.Rd | 2 ++ man/das_process.Rd | 2 ++ tests/testthat/test-output.R | 4 +++- 7 files changed, 32 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1266ca6..2a87e1c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ * 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) + * 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) 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_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_process.R b/R/das_process.R index 17ea227..ae11bcf 100644 --- a/R/das_process.R +++ b/R/das_process.R @@ -101,11 +101,13 @@ #' 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 @@ -303,16 +305,18 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, 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 @@ -333,8 +337,8 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, if (i %in% idx.new.cruise) { LastEff <- LastEMode <- LastEType <- LastESW <- LastCourse <- LastSpdKt <- - LastBft <- LastSwH <- LastWSpdKt <- - LastRF <- LastHS <- LastVS <- LastVis <- + LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- + LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- LastCruise <- NA } @@ -343,16 +347,16 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, if ((i %in% idx.new.day) & reset.day) { LastEff <- LastEMode <- LastEType <- LastESW <- 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 <- + LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- + LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- NA } @@ -365,10 +369,12 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, if (is.na(ESWsides[i])) ESWsides[i] <- LastESW else LastESW <- ESWsides[i] #Sides being surveyed 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 @@ -383,7 +389,8 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, tmp <- list( Cruise = Cruise, Mode = Mode, EffType = EffType, ESWsides = ESWsides, Course = Course, SpdKt = SpdKt, - Bft = Bft, SwellHght = SwellHght, WindSpdKt = WindSpdKt, + 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 @@ -445,7 +452,7 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, cols.tokeep <- c( "Event", "DateTime", "Lat", "Lon", "OnEffort", "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Course", "SpdKt", - "Bft", "SwellHght", "WindSpdKt", + "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/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_process.Rd b/man/das_process.Rd index 6626a99..72d37a2 100644 --- a/man/das_process.Rd +++ b/man/das_process.Rd @@ -71,11 +71,13 @@ 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/tests/testthat/test-output.R b/tests/testthat/test-output.R index 9aa916d..7d9bdba 100644 --- a/tests/testthat/test-output.R +++ b/tests/testthat/test-output.R @@ -5,7 +5,7 @@ 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", + "Bft", "SwellHght", "SwellDir", "WindSpdKt", "WindDir", "RainFog", "HorizSun", "VertSun", "Glare", "Vis", "ObsL", "Rec", "ObsR", "ObsInd", "EffortDot", "EventNum", "file_das", "line_num" @@ -93,7 +93,9 @@ test_that("das_process output has expected column names and classes", { SpdKt = "numeric", Bft = "numeric", SwellHght = "numeric", + SwellDir = "numeric", WindSpdKt = "numeric", + WindDir = "numeric", RainFog = "numeric", HorizSun = "numeric", VertSun = "numeric", From 49abd16efc9019aa1cf722ba66633f9ad0a785b0 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Tue, 28 Jul 2026 16:20:22 -0700 Subject: [PATCH 02/10] Update das_check with wind and swell direciton (additional step for #21) --- NEWS.md | 2 +- R/das_check.R | 10 ++++++++++ man/das_check.Rd | 2 ++ 3 files changed, 13 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 2a87e1c..bf9a7f1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,7 @@ * 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 diff --git a/R/das_check.R b/R/das_check.R index 9344212..6d2b1d6 100644 --- a/R/das_check.R +++ b/R/das_check.R @@ -47,7 +47,9 @@ #' 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 @@ -413,10 +415,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/man/das_check.Rd b/man/das_check.Rd index d71dbe5..b488c08 100644 --- a/man/das_check.Rd +++ b/man/das_check.Rd @@ -76,7 +76,9 @@ Course \tab N \tab Data1 \tab Can be conv 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 From e1583941454245ead53747077054c1e7b740f553 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Thu, 30 Jul 2026 20:08:27 -0700 Subject: [PATCH 03/10] Closes #22 --- NEWS.md | 4 +- R/das_effort.R | 822 +++++++++++++++++++++-------------------- man/das_effort.Rd | 10 +- vignettes/swfscDAS.Rmd | 2 + 4 files changed, 433 insertions(+), 405 deletions(-) diff --git a/NEWS.md b/NEWS.md index bf9a7f1..65f38a1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,13 +8,15 @@ * Added 'SwellDir' (Event V, Data 3) and 'WindDir' (Event W, Data 4) to the output of `das_process` (#21) +* Changed behavor 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) + * 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](#17) * Update roxygen to use markdown, fix documentation issues related to upgrade to roxygen2 v8.0 -* 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/das_effort.R b/R/das_effort.R index 4827a90..a384a63 100644 --- a/R/das_effort.R +++ b/R/das_effort.R @@ -1,401 +1,421 @@ -#' 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 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.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(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(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") + # If seg0.drop, then change '0' distances to 0.1 + if (seg0.drop) { + segdata <- segdata %>% + mutate(dist = if_else(dist < 0.1, 0.1, dist)) + } + + 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) +} diff --git a/man/das_effort.Rd b/man/das_effort.Rd index 1f0aec4..be53dd5 100644 --- a/man/das_effort.Rd +++ b/man/das_effort.Rd @@ -52,9 +52,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 diff --git a/vignettes/swfscDAS.Rmd b/vignettes/swfscDAS.Rmd index 2c60d51..b06a62f 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. + ## 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. From 52d11aece7e8741918eac604b4dd38cc2ac65956 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 24 Aug 2026 18:04:22 -0700 Subject: [PATCH 04/10] bump docs to roxygen 8.1 --- DESCRIPTION | 2 +- NAMESPACE | 150 +++++++++++++++++++++++++++++----------------------- 2 files changed, 86 insertions(+), 66 deletions(-) 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..0a03c22 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -59,71 +59,91 @@ 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, + 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(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 +) From 9853a81ebf9a9dda7883ebc6a7ffc97059358321 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 24 Aug 2026 18:17:53 -0700 Subject: [PATCH 05/10] Fix build comments --- NAMESPACE | 1 + R/das_effort.R | 7 ++++--- R/swfscDAS-package.R | 2 +- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0a03c22..bcfcb30 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ importFrom(dplyr, mutate, n, n_distinct, + pull, reframe, right_join, select, diff --git a/R/das_effort.R b/R/das_effort.R index a384a63..f766373 100644 --- a/R/das_effort.R +++ b/R/das_effort.R @@ -233,7 +233,8 @@ das_effort.das_df <- function( 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) + mutate(cont_eff_section = NA, dist_from_prev = NA, + seg_idx = NA, segnum = NA) rownames(x.oneff) <- rownames(x.oneff.tmp) <- NULL @@ -317,7 +318,7 @@ das_effort.das_df <- function( ces.keep <- x.ces.summ %>% filter(.data$has_sight | .data$dist_sum > 0.1) %>% - pull(cont_eff_section) + pull(.data$cont_eff_section) x.oneff <- x.oneff %>% filter(.data$cont_eff_section %in% ces.keep) @@ -409,7 +410,7 @@ das_effort.das_df <- function( # If seg0.drop, then change '0' distances to 0.1 if (seg0.drop) { segdata <- segdata %>% - mutate(dist = if_else(dist < 0.1, 0.1, dist)) + mutate(dist = if_else(.data$dist < 0.1, 0.1, .data$dist)) } sightinfo <- sightinfo %>% diff --git a/R/swfscDAS-package.R b/R/swfscDAS-package.R index baadd72..38fbef7 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 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 From 7b369d48a96b28b0eea4aae134f6d2fdc60b322f Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 24 Aug 2026 19:34:53 -0700 Subject: [PATCH 06/10] Fixes #27 --- R/das_segdata.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/das_segdata.R b/R/das_segdata.R index a3a73ca..f064a5c 100644 --- a/R/das_segdata.R +++ b/R/das_segdata.R @@ -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 From 5fe3e125937d3a4581d0abc5d9cf579480cdf9a3 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 24 Aug 2026 19:36:31 -0700 Subject: [PATCH 07/10] Added news for #27 --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 65f38a1..321112a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # 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 lenght 0 (#27) * Added an exported function `das_spcodes_read` for consistent reading of shipboard SpCode files From 8ebc892eabed5e227fc8bac9f488c56c721121b6 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Tue, 25 Aug 2026 14:47:35 -0700 Subject: [PATCH 08/10] Fixes #26 --- NAMESPACE | 1 + NEWS.md | 8 +++++--- R/das_effort.R | 16 +++++++++++++--- R/das_sight.R | 31 ++++++++++++++++++++++++++----- R/swfscDAS-package.R | 2 +- man/das_effort.Rd | 3 +++ man/das_sight.Rd | 15 ++++++++++++++- vignettes/swfscDAS.Rmd | 2 +- 8 files changed, 64 insertions(+), 14 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index bcfcb30..c4db048 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -60,6 +60,7 @@ export(das_spcodes_read) export(distance_greatcircle) export(randpicks_convert) importFrom(dplyr, + across, add_row, arrange, between, diff --git a/NEWS.md b/NEWS.md index 321112a..320a5b2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ * 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 lenght 0 (#27) +* 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 @@ -10,13 +10,15 @@ * Added 'SwellDir' (Event V, Data 3) and 'WindDir' (Event W, Data 4) to the output of `das_process` (#21) -* Changed behavor 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) +* 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) * 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](#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 diff --git a/R/das_effort.R b/R/das_effort.R index f766373..8146c25 100644 --- a/R/das_effort.R +++ b/R/das_effort.R @@ -36,6 +36,7 @@ #' 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 @@ -178,9 +179,11 @@ das_effort.das_df <- function( 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"))) @@ -400,17 +403,18 @@ das_effort.das_df <- function( sightinfo <- x.eff.all %>% left_join(select(segdata, "segnum", "mlat", "mlon"), by = "segnum") %>% - das_sight(returnformat = "default") %>% + 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 change '0' distances to 0.1 + # If seg0.drop, then set minimum distance to 0.1 if (seg0.drop) { segdata <- segdata %>% - mutate(dist = if_else(.data$dist < 0.1, 0.1, .data$dist)) + mutate(dist = pmax(.data$dist, 0.1)) } sightinfo <- sightinfo %>% @@ -418,5 +422,11 @@ das_effort.das_df <- function( 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_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 38fbef7..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 pull 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_effort.Rd b/man/das_effort.Rd index be53dd5..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, ... ) @@ -69,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_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/vignettes/swfscDAS.Rmd b/vignettes/swfscDAS.Rmd index b06a62f..26383b3 100644 --- a/vignettes/swfscDAS.Rmd +++ b/vignettes/swfscDAS.Rmd @@ -133,7 +133,7 @@ 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. +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 From dc0e82851a7642ef26fd59eb09a18daf96e76083 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 14 Sep 2026 18:33:40 -0700 Subject: [PATCH 09/10] Fixes #10 --- R/das_check.R | 3 ++- R/das_process.R | 17 +++++++++++------ R/das_segdata.R | 2 +- man/das_check.Rd | 1 + man/das_process.Rd | 1 + tests/testthat/test-output.R | 4 +++- 6 files changed, 19 insertions(+), 9 deletions(-) diff --git a/R/das_check.R b/R/das_check.R index 6d2b1d6..524ba33 100644 --- a/R/das_check.R +++ b/R/das_check.R @@ -43,6 +43,7 @@ #' 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 @@ -338,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 diff --git a/R/das_process.R b/R/das_process.R index ae11bcf..f7b8723 100644 --- a/R/das_process.R +++ b/R/das_process.R @@ -97,6 +97,7 @@ #' 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 @@ -300,6 +301,7 @@ 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) @@ -335,7 +337,7 @@ 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 <- LastSwD <- LastWSpdKt <- LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- @@ -345,7 +347,7 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, # 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 <- LastSwD <- LastWSpdKt <- LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- @@ -354,7 +356,7 @@ das_process.das_dfr <- function(x, days.gap = 20, reset.event = TRUE, # Reset applicable info (all RPVNW-related) when starting BR/R event sequence if ((i %in% idx.eff) & reset.effort) { - LastEType <- LastESW <- LastCourse <- LastSpdKt <- + LastEType <- LastESW <- LastTrackline <- LastCourse <- LastSpdKt <- LastBft <- LastSwH <- LastSwD <- LastWSpdKt <- LastRF <- LastHS <- LastVS <- LastWDir <- LastVis <- LastObsL <- LastRec <- LastObsR <- LastObsInd <- NA @@ -367,6 +369,7 @@ 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 @@ -388,7 +391,8 @@ 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, + 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, @@ -414,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 @@ -451,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", "SwellDir", "WindSpdKt", "WindDir", + "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 f064a5c..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) { diff --git a/man/das_check.Rd b/man/das_check.Rd index b488c08..5b5e5f7 100644 --- a/man/das_check.Rd +++ b/man/das_check.Rd @@ -72,6 +72,7 @@ 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 diff --git a/man/das_process.Rd b/man/das_process.Rd index 72d37a2..829edba 100644 --- a/man/das_process.Rd +++ b/man/das_process.Rd @@ -67,6 +67,7 @@ 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 diff --git a/tests/testthat/test-output.R b/tests/testthat/test-output.R index 7d9bdba..ea48c5d 100644 --- a/tests/testthat/test-output.R +++ b/tests/testthat/test-output.R @@ -4,7 +4,8 @@ y.proc <- das_process(y.read) exp.proc.name <- c( "Event", "DateTime", "Lat", "Lon", "OnEffort", - "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Course", "SpdKt", + "Cruise", "Mode", "OffsetGMT", "EffType", "ESWsides", "Trackline", + "Course", "SpdKt", "Bft", "SwellHght", "SwellDir", "WindSpdKt", "WindDir", "RainFog", "HorizSun", "VertSun", "Glare", "Vis", "ObsL", "Rec", "ObsR", "ObsInd", @@ -89,6 +90,7 @@ 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", From df295d770818753d0fd99d1687ed58b067e94db4 Mon Sep 17 00:00:00 2001 From: Sam Woodman - NOAA Date: Mon, 14 Sep 2026 18:40:42 -0700 Subject: [PATCH 10/10] #10 news --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 320a5b2..954f0c8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,8 @@ * 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](#17)