version 0.6.1

cran · Jan 31, 2022 · e3a8ca3 · e3a8ca3
1 parent de66bc9
commit e3a8ca3
Show file tree

Hide file tree

Showing 9 changed files with 88 additions and 27 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: swfscDAS
 Title: Southwest Fisheries Science Center Shipboard DAS Data Processing
-Version: 0.6.0
+Version: 0.6.1
 Authors@R: 
     person("Sam", "Woodman", email = "sam.woodman@noaa.gov", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-6071-8186"))
 Description: Process and summarize shipboard 
@@ -16,13 +16,13 @@ Depends: R (>= 4.0.0)
 Imports: dplyr, lubridate, magrittr, methods, parallel, purrr, readr,
         rlang, sf, swfscMisc, tidyr
 Suggests: knitr, rmarkdown, stringr, testthat (>= 2.1.0)
-License: GPL-3
+License: CC0
 Encoding: UTF-8
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 VignetteBuilder: knitr
 NeedsCompilation: no
-Packaged: 2021-09-03 19:16:50 UTC; sam.woodman
+Packaged: 2022-01-31 19:23:23 UTC; sam.woodman
 Author: Sam Woodman [aut, cre] (<https://orcid.org/0000-0001-6071-8186>)
 Maintainer: Sam Woodman <sam.woodman@noaa.gov>
 Repository: CRAN
-Date/Publication: 2021-09-03 19:40:02 UTC
+Date/Publication: 2022-01-31 19:50:02 UTC
diff --git a/MD5 b/MD5
@@ -1,6 +1,6 @@
-d8e44c4b380bbe9dc717c24c9f6252a6 *DESCRIPTION
-87c7bd4de3943de3dff4fd1ae9cece2a *NAMESPACE
-09e4b00cc3d13c6ac3eaeb5291646387 *NEWS.md
+6c62aa665e827c2dbfbacfc51e644035 *DESCRIPTION
+2dba93c5f274f2ce6a36fa11ae741852 *NAMESPACE
+65e67d6e38b443fcf8661fb8471508f9 *NEWS.md
 102266fa9dd1be4dfcddcf7a603b4d62 *R/as_das_df.R
 1e4cba8a7d8da74119d7012247866623 *R/as_das_dfr.R
 41efa05eba27e51ef7d4117b7745693d *R/das_check.R
@@ -9,22 +9,22 @@ d8e44c4b380bbe9dc717c24c9f6252a6 *DESCRIPTION
 aa831a68d166cd71fd9f80abb01c5052 *R/das_chop_section.R
 025d24d94725a1e0f4874bc98d665b71 *R/das_class.R
 3cccf74edcabbddbe58dc778bf9bc64c *R/das_comments.R
-952cb9d3fbfadfa7988c162df2ad5213 *R/das_effort.R
+85b33e6550dc36a09ae80294a38c9ed3 *R/das_effort.R
 683d524145ed03b82a50728c7d8a687c *R/das_effort_sight.R
 c418ed6b1524e453015f178111ee8a16 *R/das_effort_strata.R
 83c136f1419aecf61d71369ebedb45dc *R/das_format_pdf.R
 927f8611a6a67520107b7f0221d2652f *R/das_intersects_strata.R
 c0648eb11398f305921cf697009adedb *R/das_process.R
 ea4549aa913deb4902f1ad0833fee956 *R/das_read.R
 37f5ff79244213e016b624e04090564a *R/das_segdata.R
-0a0486f88d90a510fbd55b3c9d2e3a7e *R/das_sight.R
+bbbc8546e49f9a377e099592bca691ed *R/das_sight.R
 ce7d7c6cb53836f6b4b9b891b24747e4 *R/distance_greatcircle.R
 d1632370a5a33bd5f35db26a0ce42da9 *R/randpicks_convert.R
 6c3088d16042b73f6c2a2ea1ea2f534d *R/subsetting.R
 a13f59f7aab865b75d633d6969103c54 *R/swfscDAS-internal.R
-01fdf8f5aa60e9968937ae9ffab889ed *R/swfscDAS-package.R
+5076a5e29db8a50290844c47e878bbf7 *R/swfscDAS-package.R
 35abc67baf9094dd0da3defc2d5a6072 *README.md
-306d20fd8a4f8144423f20c2eb0a0555 *build/vignette.rds
+72642f8b1d5f15a2e03248acbfc9bd05 *build/vignette.rds
 dd00f8695b1893fbd071e5dfdda1fd21 *inst/DAS_Format.pdf
 019d2c4a47e87035cddc8ec511bffee7 *inst/DAS_chop_equallength_figures.pdf
 ad585d78881d3eb2512fadfd80370e11 *inst/Ship_sample.dat
@@ -68,5 +68,6 @@ bcf11c588150871770d0c4312a21daa2 *tests/testthat/test-effort_strata.R
 4976b6655b8702a1f55bf5cd6bd92eab *tests/testthat/test-output.R
 00ddfb270b4716ae44106e002d40bd6b *tests/testthat/test-process.R
 54d5f7bed481b6fecb5f84d46745152c *tests/testthat/test-subsetting.R
+02677e42969abfa1a54c6c4c904f567f *tests/testthat/test-zero_sighting_events.R
 682b2d5c6fd4bed582338b2d254f0614 *vignettes/DAS_data_join.Rmd
 e4ee86caaf4778899b2b06a07d1a3935 *vignettes/swfscDAS.Rmd
diff --git a/NAMESPACE b/NAMESPACE
@@ -68,6 +68,7 @@ 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)
@@ -91,6 +92,7 @@ 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)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# swfscDAS 0.6.1
+
+* Fix bug in `das_sight` and `das_effort` when the DAS file contains no sightings
+
+* Changed license based on https://github.com/NOAAGov
+
+
 # swfscDAS 0.6.0
 
 * Fix `das_check` index math error (#5)

diff --git a/R/das_effort.R b/R/das_effort.R
@@ -367,10 +367,11 @@ das_effort.das_df <- function(x, method = c("condition", "equallength", "section
     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
+  # 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 %>%
-    bind_rows(x.oneff.tmp) %>%
     arrange(.data$idx_eff) %>%
     select(-.data$idx_eff)
 

diff --git a/R/das_sight.R b/R/das_sight.R
@@ -211,6 +211,8 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
     filter(.data$Event %in% c(event.sight, event.sight.info)) %>%
     mutate(sight_cumsum = cumsum(.data$Event %in% event.sight))
 
+
+  #-----------------------------------------------------------------------------
   # Check that all GSKM events are followed by an A event
   idx.skmg <- which(x$Event %in% c("S", "K", "M", "G"))
   idx.a <- which(x$Event %in% c("A"))
@@ -233,7 +235,7 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
   rm(idx.skmg, idx.a, skmga.check1a, skmga.check1b, skmga.check2)
 
 
-  #----------------------------------------------------------------------------
+  #-----------------------------------------------------------------------------
   # Get applicable data for each type of sighting event
 
   #--------------------------------------------------------
@@ -282,8 +284,8 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
     mutate(SightNoDaily = paste(base::format(.data$DateTime, "%Y%m%d"),
                                 cumsum(.data$Event %in% c("S", "K", "M", "G")),
                                 sep = "_"),
-           SightNoDaily = ifelse(.data$Event %in% c("S", "K", "M", "G"),
-                                 .data$SightNoDaily, NA)) %>%
+           SightNoDaily = if_else(.data$Event %in% c("S", "K", "M", "G"),
+                                  .data$SightNoDaily, NA_character_)) %>%
     ungroup() %>%
     select(.data$sight_cumsum, .data$SightNo, .data$Subgroup, .data$SightNoDaily,
            .data$Obs, .data$ObsStd, .data$Bearing, .data$Reticle, .data$DistNm)
@@ -293,7 +295,7 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
   ### Marine mammal (+subgroup) sightings; Events S, K, M, G
   sight.info.skmg1 <- sight.df %>%
     filter(.data$Event %in% c("S", "K", "M", "G")) %>%
-    mutate(Cue = ifelse(.data$Event == "G", NA, as.numeric(.data$Data3)),
+    mutate(Cue = if_else(.data$Event == "G", NA_real_, as.numeric(.data$Data3)),
            Method = as.numeric(.data$Data4),
            CalibSchool = toupper(.data$Data10),
            PhotosAerial = toupper(.data$Data11),
@@ -307,10 +309,10 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
     mutate(Photos = toupper(.data$Data3),
            Birds = toupper(.data$Data4),
            nSp = unlist(
-             pmap(list(.data$Data5, .data$Data6, .data$Data7, .data$Data8),
-                  function(d5, d6, d7, d8) {
-                    sum(!is.na(c(d5, d6, d7, d8)))
-                  })),
+             pmap_int(list(.data$Data5, .data$Data6, .data$Data7, .data$Data8),
+                      function(d5, d6, d7, d8) {
+                        sum(!is.na(c(d5, d6, d7, d8)))
+                      })),
            Mixed = .data$nSp > 1) %>%
     select(.data$sight_cumsum, .data$Photos, .data$Birds, .data$nSp, .data$Mixed,
            SpCode1 = .data$Data5, SpCode2 = .data$Data6,
@@ -511,12 +513,15 @@ das_sight.das_df <- function(x, return.format = c("default", "wide", "complete")
       mutate(SpCode = case_when(.data$Event %in% c("S", "K", "M", "G") ~ .data$SpCode,
                                 .data$Event == "t" ~ .data$TurtleSp,
                                 .data$Event == "p" ~ .data$PinnipedSp,
-                                .data$Event == "F" ~ .data$BoatType),
+                                .data$Event == "F" ~ .data$BoatType,
+                                TRUE ~ NA_character_),
              GsSchoolBest = case_when(.data$Event %in% c("S", "K", "M", "G") ~ .data$GsSchoolBest,
                                       .data$Event == "t" ~ .data$TurtleGs,
                                       .data$Event == "p" ~ .data$PinnipedGs,
-                                      .data$Event == "F" ~ .data$BoatGs),
-             GsSpBest = ifelse(.data$Event %in% c("t", "p", "F"), .data$GsSchoolBest, .data$GsSpBest)) %>%
+                                      .data$Event == "F" ~ .data$BoatGs,
+                                      TRUE ~ NA_real_),
+             GsSpBest = if_else(.data$Event %in% c("t", "p", "F"),
+                                .data$GsSchoolBest, .data$GsSpBest)) %>%
       select(-.data$TurtleSp, -.data$TurtleGs, -.data$PinnipedSp,
              -.data$PinnipedGs, -.data$BoatType, -.data$BoatGs)
   }

diff --git a/R/swfscDAS-package.R b/R/swfscDAS-package.R
@@ -12,15 +12,16 @@
 #' @seealso \url{https://smwoodman.github.io/swfscDAS/}
 #'
 #' @importFrom dplyr add_row arrange between bind_cols bind_rows case_when desc
-#'   distinct everything filter full_join group_by lag left_join mutate n n_distinct
+#'   distinct everything filter full_join group_by if_else
+#'   lag left_join mutate n n_distinct
 #'   right_join select slice starts_with summarise ungroup
 #' @importFrom lubridate year month day tz
 #' @importFrom magrittr %>%
 #' @importFrom methods setOldClass
 #' @importFrom parallel clusterExport detectCores parLapplyLB stopCluster
 #' @importFrom readr cols col_character fwf_positions read_fwf
 #' @importFrom rlang !! .data
-#' @importFrom purrr map_chr pmap pmap_lgl
+#' @importFrom purrr map_chr pmap pmap_int pmap_lgl
 #' @importFrom sf st_as_sf st_cast st_coordinates st_geometry st_intersects st_intersection
 #'   st_linestring st_polygon st_sf st_sfc st_wrap_dateline
 #' @importFrom stats na.omit runif

diff --git a/build/vignette.rds b/build/vignette.rds
diff --git a/tests/testthat/test-zero_sighting_events.R b/tests/testthat/test-zero_sighting_events.R
@@ -0,0 +1,44 @@
+y <- system.file("das_sample.das", package = "swfscDAS")
+
+y.read <- das_read(y, skip = 20, tz = "GMT")
+y.proc <- das_process(y.read, reset.effort = FALSE)
+
+event.sight <- c("S", "K", "M", "G", "s", "k", "m", "g", "t", "p", "F",
+                 "A", "?", 1:8)
+
+
+
+test_that("The column classes of the das_sight 'default' output are the same whether or not there is sighting data", {
+  y.sight <- dplyr::filter(das_sight(y.proc, return.format = "default"),
+                               Event == "ZZ")
+
+  y.sight0 <- y.proc %>%
+    filter(!(Event %in% event.sight)) %>%
+    das_sight(return.format = "default")
+
+  expect_identical(y.sight, y.sight0)
+})
+
+
+test_that("The column classes of the das_sight 'wide' output, are the same whether or not there is sighting data", {
+  y.sight <- dplyr::filter(das_sight(y.proc, return.format = "wide"),
+                               Event == "ZZ")
+
+  y.sight0 <- y.proc %>%
+    filter(!(Event %in% event.sight)) %>%
+    das_sight(return.format = "wide")
+
+  expect_identical(y.sight, y.sight0)
+})
+
+
+test_that("The column classes of the das_sight 'complete' output are the same whether or not there is sighting data", {
+  y.sight <- dplyr::filter(das_sight(y.proc, return.format = "complete"),
+                               Event == "ZZ")
+
+  y.sight0 <- y.proc %>%
+    filter(!(Event %in% event.sight)) %>%
+    das_sight(return.format = "complete")
+
+  expect_identical(y.sight, y.sight0)
+})