From 3fdcadbf0797be03ee30f38f0c031d57b8ab4262 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Thu, 7 Mar 2024 13:09:25 -0500 Subject: [PATCH 01/56] fasttime -> fast_strptime. Closes #211. --- NAMESPACE | 2 +- R/load-read_glatos_detections.r | 15 ++++++--------- R/load-read_glatos_receivers.r | 13 +++++-------- R/load-read_otn_deployments.R | 11 ++++++----- R/load-read_otn_detections.r | 21 +++++++++++---------- man/read_glatos_detections.Rd | 4 ++-- man/read_glatos_receivers.Rd | 2 +- man/read_otn_deployments.Rd | 2 +- man/read_otn_detections.Rd | 2 +- 9 files changed, 34 insertions(+), 38 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 94fcaf2d..8fa1007b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -99,7 +99,7 @@ importFrom(graphics,par) importFrom(graphics,points) importFrom(graphics,symbols) importFrom(graphics,text) -importFrom(lubridate,parse_date_time) +importFrom(lubridate,fast_strptime) importFrom(magrittr,"%>%") importFrom(stats,approx) importFrom(stats,dnorm) diff --git a/R/load-read_glatos_detections.r b/R/load-read_glatos_detections.r index a4b3d9f1..6f555bd1 100644 --- a/R/load-read_glatos_detections.r +++ b/R/load-read_glatos_detections.r @@ -16,8 +16,8 @@ #' never need to set this argument (`NULL` should work). #' #' @details Data are loaded using [fread][data.table::fread] and timestamps are -#' coerced to POSIXct using [fastPOSIXct][fasttime::fastPOSIXct]. All times must -#' be in UTC timezone per GLATOS standard. +#' coerced to POSIXct using [fast_strptime][lubridate::fast_strptime]. All times +#' must be in UTC timezone per GLATOS standard. #' #' @details Column `animal_id` is considered a required column by many other #' functions in this package, so it will be created if any records are `NULL`. @@ -40,7 +40,7 @@ #' #' det <- read_glatos_detections(det_file) #' -#' @importFrom lubridate parse_date_time +#' @importFrom lubridate fast_strptime #' #' @export read_glatos_detections <- function(det_file, version = NULL) { @@ -84,16 +84,13 @@ read_glatos_detections <- function(det_file, version = NULL) { na.strings = c("", "NA") ) - # coerce timestamps to POSIXct; note that with fastPOSIXct raw - # timestamp must be in UTC; and tz argument sets the tzone attr only - options(lubridate.fasttime = TRUE) + # coerce timestamps to POSIXct for (j in timestamp_cols) { data.table::set(dtc, j = glatos_detection_schema[[vversion]]$name[j], - value = lubridate::parse_date_time( + value = lubridate::fast_strptime( dtc[[glatos_detection_schema[[vversion]]$name[j]]], - orders = "ymd HMS", - tz = "UTC" + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE ) ) } diff --git a/R/load-read_glatos_receivers.r b/R/load-read_glatos_receivers.r index 5b45e328..b0309865 100644 --- a/R/load-read_glatos_receivers.r +++ b/R/load-read_glatos_receivers.r @@ -15,7 +15,7 @@ #' `"1.0"`. Any other values will trigger an error. #' #' @details Data are loaded using [fread][data.table::fread] and timestamps are -#' coerced to POSIXct using [fastPOSIXct][fasttime::fastPOSIXct]. All +#' coerced to POSIXct using [fast_strptime][lubridate::fast_strptime]. All #' timestamps must be 'YYYY-MM-DD HH:MM' format and in UTC timezone per GLATOS #' standard. #' @@ -36,7 +36,7 @@ #' #' rcv <- read_glatos_receivers(rec_file) #' -#' @importFrom lubridate parse_date_time +#' @importFrom lubridate fast_strptime #' #' @export read_glatos_receivers <- function(rec_file, version = NULL) { @@ -80,16 +80,13 @@ read_glatos_receivers <- function(rec_file, version = NULL) { # read data rec <- data.table::fread(rec_file, sep = ",", colClasses = col_classes) - # coerce timestamps to POSIXct; note that with fastPOSIXct raw - # timestamp must be in UTC; and tz argument sets the tzone attr only - options(lubridate.fasttime = TRUE) + # coerce timestamps to POSIXct for (j in timestamp_cols) { data.table::set(rec, j = glatos_receivers_schema[[ver_txt]]$name[j], - value = lubridate::parse_date_time( + value = lubridate::fast_strptime( rec[[glatos_receivers_schema[[ver_txt]]$name[j]]], - orders = "ymd HMS", - tz = "UTC" + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE ) ) } diff --git a/R/load-read_otn_deployments.R b/R/load-read_otn_deployments.R index 5f4aa9d7..4bc6d150 100644 --- a/R/load-read_otn_deployments.R +++ b/R/load-read_otn_deployments.R @@ -18,7 +18,7 @@ #' #' @details #' Data are loaded using [data.table::fread()] package and timestamps -#' are coerced to POSIXct using the [fasttime::fastPOSIXct()]. All +#' are coerced to POSIXct using [lubridate::fast_strptime()]. All #' times must be in UTC timezone per GLATOS standard. #' #' @details @@ -39,7 +39,7 @@ #' dep <- read_otn_deployments(deployment_file) #' } #' -#' @importFrom lubridate parse_date_time +#' @importFrom lubridate fast_strptime #' @importFrom tidyr extract #' @importFrom dplyr mutate #' @importFrom magrittr "%>%" @@ -60,8 +60,7 @@ read_otn_deployments <- function(deployment_file, na.strings = c("", "NA") ) - # coerce timestamps to POSIXct; note that with fastPOSIXct raw - # timestamp must be in UTC; and tz argument sets the tzone attr only + # coerce timestamps to POSIXct dtc <- dtc %>% tidyr::extract(deploy_date_col, into = "deploy_date", regex = "(\\d+-\\d+-\\d+)") dtc <- dtc %>% tidyr::extract(recovery_date_col, into = "recovery_date", regex = "(\\d+-\\d+-\\d+)") dtc <- dtc %>% tidyr::extract(last_download_col, into = "last_download", regex = "(\\d+-\\d+-\\d+)") @@ -70,7 +69,9 @@ read_otn_deployments <- function(deployment_file, for (j in timestamp_cols) { data.table::set(dtc, j = otn_deployments_schema$name[j], - value = lubridate::parse_date_time(dtc[[otn_deployments_schema$name[j]]], orders = "ymd", tz = "UTC") + value = lubridate::fast_strptime( + dtc[[otn_deployments_schema$name[j]]], + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE) ) } # coerce dates to date diff --git a/R/load-read_otn_detections.r b/R/load-read_otn_detections.r index 7f3191a4..898bb339 100644 --- a/R/load-read_otn_detections.r +++ b/R/load-read_otn_detections.r @@ -9,7 +9,7 @@ #' #' @details #' Data are loaded using [data.table::fread()] package and timestamps -#' are coerced to POSIXct using the [fasttime::fastPOSIXct()]. All +#' are coerced to POSIXct using [lubridate::fast_strptime()]. All #' times must be in UTC timezone per GLATOS standard. #' #' @details @@ -28,7 +28,7 @@ #' ) #' det <- read_otn_detections(det_file) #' -#' @importFrom lubridate parse_date_time +#' @importFrom lubridate fast_strptime #' #' @export read_otn_detections <- function(det_file) { @@ -38,11 +38,11 @@ read_otn_detections <- function(det_file) { timestamp_cols <- which(col_classes == "POSIXct") date_cols <- which(col_classes == "Date") col_classes[c(timestamp_cols, date_cols)] <- "character" - + # read data, suppressWarnings because some columns could be missing dtc <- suppressWarnings(data.table::fread(det_file, - sep = ",", colClasses = col_classes, - na.strings = c("", "NA") + sep = ",", colClasses = col_classes, + na.strings = c("", "NA") )) # This check is for non-matched detection extracts. They are missing some required columns, this attempts to create them. # More info on OTN detection extracts here: https://members.oceantrack.org/data/otn-detection-extract-documentation-matched-to-animals @@ -53,13 +53,14 @@ read_otn_detections <- function(det_file) { dtc$tagname <- dtc$fieldnumber dtc$codespace <- purrr::map(dtc$fieldnumber, get_codemap) } - # coerce timestamps to POSIXct; note that with fastPOSIXct raw - # timestamp must be in UTC; and tz argument sets the tzone attr only - options(lubridate.fasttime = TRUE) + # coerce timestamps to POSIXct for (j in timestamp_cols) { data.table::set(dtc, - j = otn_detection_schema$name[j], - value = lubridate::parse_date_time(dtc[[otn_detection_schema$name[j]]], orders = "ymd HMS", tz = "UTC") + j = otn_detection_schema$name[j], + value = lubridate::fast_strptime( + dtc[[otn_detection_schema$name[j]]], + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE + ) ) } # coerce dates to date diff --git a/man/read_glatos_detections.Rd b/man/read_glatos_detections.Rd index 3dd8270b..542d547c 100644 --- a/man/read_glatos_detections.Rd +++ b/man/read_glatos_detections.Rd @@ -28,8 +28,8 @@ a data.frame of class \code{glatos_detections}. } \details{ Data are loaded using \link[data.table:fread]{fread} and timestamps are -coerced to POSIXct using \link[fasttime:fastPOSIXct]{fastPOSIXct}. All times must -be in UTC timezone per GLATOS standard. +coerced to POSIXct using \link[lubridate:parse_date_time]{fast_strptime}. All times +must be in UTC timezone per GLATOS standard. Column \code{animal_id} is considered a required column by many other functions in this package, so it will be created if any records are \code{NULL}. diff --git a/man/read_glatos_receivers.Rd b/man/read_glatos_receivers.Rd index 7a442ddc..13fac121 100644 --- a/man/read_glatos_receivers.Rd +++ b/man/read_glatos_receivers.Rd @@ -27,7 +27,7 @@ data.frame of class \code{glatos_receivers}. } \details{ Data are loaded using \link[data.table:fread]{fread} and timestamps are -coerced to POSIXct using \link[fasttime:fastPOSIXct]{fastPOSIXct}. All +coerced to POSIXct using \link[lubridate:parse_date_time]{fast_strptime}. All timestamps must be 'YYYY-MM-DD HH:MM' format and in UTC timezone per GLATOS standard. } diff --git a/man/read_otn_deployments.Rd b/man/read_otn_deployments.Rd index ead0dbfb..3b087467 100644 --- a/man/read_otn_deployments.Rd +++ b/man/read_otn_deployments.Rd @@ -35,7 +35,7 @@ a data.frame of class \code{glatos_receivers}. } \details{ Data are loaded using \code{\link[data.table:fread]{data.table::fread()}} package and timestamps -are coerced to POSIXct using the \code{\link[fasttime:fastPOSIXct]{fasttime::fastPOSIXct()}}. All +are coerced to POSIXct using \code{\link[lubridate:parse_date_time]{lubridate::fast_strptime()}}. All times must be in UTC timezone per GLATOS standard. Column names are changed to match GLATOS standard columns when possible. diff --git a/man/read_otn_detections.Rd b/man/read_otn_detections.Rd index 85325692..349b349c 100644 --- a/man/read_otn_detections.Rd +++ b/man/read_otn_detections.Rd @@ -21,7 +21,7 @@ a data.frame of class \code{glatos_detections}. } \details{ Data are loaded using \code{\link[data.table:fread]{data.table::fread()}} package and timestamps -are coerced to POSIXct using the \code{\link[fasttime:fastPOSIXct]{fasttime::fastPOSIXct()}}. All +are coerced to POSIXct using \code{\link[lubridate:parse_date_time]{lubridate::fast_strptime()}}. All times must be in UTC timezone per GLATOS standard. Column names are changed to match GLATOS standard columns when possible. From 1efd94414fe43ec3d80c2c0edf648b0645d62d31 Mon Sep 17 00:00:00 2001 From: mhpob Date: Thu, 7 Mar 2024 18:17:14 +0000 Subject: [PATCH 02/56] Style code (GHA) --- R/load-read_otn_deployments.R | 3 ++- R/load-read_otn_detections.r | 16 ++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/R/load-read_otn_deployments.R b/R/load-read_otn_deployments.R index 4bc6d150..b9c83c0c 100644 --- a/R/load-read_otn_deployments.R +++ b/R/load-read_otn_deployments.R @@ -71,7 +71,8 @@ read_otn_deployments <- function(deployment_file, j = otn_deployments_schema$name[j], value = lubridate::fast_strptime( dtc[[otn_deployments_schema$name[j]]], - format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE) + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE + ) ) } # coerce dates to date diff --git a/R/load-read_otn_detections.r b/R/load-read_otn_detections.r index 898bb339..54834bfb 100644 --- a/R/load-read_otn_detections.r +++ b/R/load-read_otn_detections.r @@ -38,11 +38,11 @@ read_otn_detections <- function(det_file) { timestamp_cols <- which(col_classes == "POSIXct") date_cols <- which(col_classes == "Date") col_classes[c(timestamp_cols, date_cols)] <- "character" - + # read data, suppressWarnings because some columns could be missing dtc <- suppressWarnings(data.table::fread(det_file, - sep = ",", colClasses = col_classes, - na.strings = c("", "NA") + sep = ",", colClasses = col_classes, + na.strings = c("", "NA") )) # This check is for non-matched detection extracts. They are missing some required columns, this attempts to create them. # More info on OTN detection extracts here: https://members.oceantrack.org/data/otn-detection-extract-documentation-matched-to-animals @@ -56,11 +56,11 @@ read_otn_detections <- function(det_file) { # coerce timestamps to POSIXct for (j in timestamp_cols) { data.table::set(dtc, - j = otn_detection_schema$name[j], - value = lubridate::fast_strptime( - dtc[[otn_detection_schema$name[j]]], - format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE - ) + j = otn_detection_schema$name[j], + value = lubridate::fast_strptime( + dtc[[otn_detection_schema$name[j]]], + format = "%Y-%m-%d %H:%M:%S", tz = "UTC", lt = FALSE + ) ) } # coerce dates to date From d8185e4b012e05e2b9080bedde2c239f5e23ab97 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Thu, 7 Mar 2024 13:19:02 -0500 Subject: [PATCH 03/56] Update style.yaml --- .github/workflows/style.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style.yaml b/.github/workflows/style.yaml index 6eea13f3..66958a43 100644 --- a/.github/workflows/style.yaml +++ b/.github/workflows/style.yaml @@ -46,7 +46,7 @@ jobs: shell: Rscript {0} - name: Cache styler - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{ steps.styler-location.outputs.location }} key: ${{ runner.os }}-styler-${{ github.sha }} From 8b58649ce9e2229d24ce693b27411a1dd90c96e3 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 09:35:04 -0400 Subject: [PATCH 04/56] declare globals for residence_index; explicit use of dplyr::across --- R/summ-residence_index.r | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/R/summ-residence_index.r b/R/summ-residence_index.r index 2b5959a5..a1a18f01 100644 --- a/R/summ-residence_index.r +++ b/R/summ-residence_index.r @@ -174,6 +174,11 @@ residence_index <- function( detections, calculation_method = "kessel", locations = NULL, group_col = "animal_id", time_interval_size = "1 day", groupwise_total = TRUE) { + # Declare global variables for R CMD check + location <- mean_latitude <- mean_longitude <- days_detected <- + total_days <- NULL + + # set to NULL if NA if (!is.null(group_col)) if (is.na(group_col)) group_col <- NULL if (!is.null(locations)) if (all(is.na(locations))) locations <- NULL @@ -237,7 +242,7 @@ residence_index <- function( # numerator group_cols <- c("location", group_col) - detections <- dplyr::group_by(detections, across(group_cols)) + detections <- dplyr::group_by(detections, dplyr::across(group_cols)) ri <- dplyr::do( detections, @@ -263,7 +268,7 @@ residence_index <- function( time_interval_size ) } else { - detections <- dplyr::group_by(detections, across(group_col)) + detections <- dplyr::group_by(detections, dplyr::across(group_col)) ri <- dplyr::left_join(ri, dplyr::do( detections, @@ -365,6 +370,9 @@ total_diff_days <- function(detections) { #' #' @importFrom dplyr mutate aggregate_total_with_overlap <- function(detections) { + # Declare global variables for R CMD check + last_detection <- first_detection <- NULL + detections <- mutate(detections, timedelta = as.double(difftime(last_detection, first_detection, units = "secs"))) detections <- mutate(detections, timedelta = dplyr::recode(detections$timedelta, `0` = 1)) total <- as.double(sum(detections$timedelta)) / 86400.0 @@ -382,6 +390,9 @@ aggregate_total_with_overlap <- function(detections) { #' #' @importFrom data.table foverlaps aggregate_total_no_overlap <- function(detections) { + # Declare global variables for R CMD check + t1 <- t2 <- first_detection <- last_detection <- xid <- yid <- tdiff <- NULL + # extract intervals, rename ints <- data.table::as.data.table(detections)[, .( t1 = first_detection, From 01227c17681ca41d9cdfaba82d1668ff2ed8e1f8 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 09:41:48 -0400 Subject: [PATCH 05/56] explicitly use utils::head/tails to avoid abiguity warning --- R/sim-crw_in_polygon.r | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/sim-crw_in_polygon.r b/R/sim-crw_in_polygon.r index 89a5e6b6..3ff2bba1 100644 --- a/R/sim-crw_in_polygon.r +++ b/R/sim-crw_in_polygon.r @@ -429,8 +429,8 @@ check_cross_boundary <- function(path, boundary, EPSG) { # Make line segment objects of sequential point-pairs in path segs_mat <- cbind( - head(path, -1), - tail(path, -1) + utils::head(path, -1), + utils::tail(path, -1) ) in_poly <- From 75f4d06f7869a0b5732f23f65aafdf13ffd82b76 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 09:47:27 -0400 Subject: [PATCH 06/56] Declare globals: convert_glatos_to_att --- R/util-convert_glatos_to_att.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/util-convert_glatos_to_att.r b/R/util-convert_glatos_to_att.r index 196eee45..3150cbcb 100644 --- a/R/util-convert_glatos_to_att.r +++ b/R/util-convert_glatos_to_att.r @@ -42,6 +42,11 @@ convert_glatos_to_att <- function(detectionObj, receiverObj, crs = sp::CRS("+init=epsg:4326")) { + ## Declare global variables for R CMD check + Sex <- glatos_array <- station_no <- deploy_lat <- deploy_long <- + station <- dummy <- ins_model_no <- ins_serial_no <- + deploy_date_time <- recover_date_time <- detection_timestamp_utc <- NULL + transmitters <- if (all(grepl("-", detectionObj$transmitter_id, fixed = TRUE))) { detectionObj$transmitter_id From ecd5140fdcf4cd9560398327d2e4c5a45ed19582 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 09:52:27 -0400 Subject: [PATCH 07/56] Declare globals for convert_otn_erddap_to_att --- R/util-convert_otn_erddap_to_att.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/util-convert_otn_erddap_to_att.r b/R/util-convert_otn_erddap_to_att.r index 931532a8..d7a9b9ef 100644 --- a/R/util-convert_otn_erddap_to_att.r +++ b/R/util-convert_otn_erddap_to_att.r @@ -77,6 +77,11 @@ #' convert_otn_erddap_to_att <- function(detectionObj, erdTags, erdRcv, erdAni, crs = sf::st_crs(4326)) { + ## Declare global variables for R CMD check + Sex <- latitude <- longitude <- station <- receiver_model <- + receiver_serial_number <- dummy <- time <- recovery_datetime_utc <- + deploy_datetime_utc <- detection_timestamp_utc <- NULL + transmitters <- if (all(grepl("-", detectionObj$transmitter_id, fixed = TRUE))) { detectionObj$transmitter_id From 62a4f1557022ea55ac48e40e3393b0f06df6703f Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 09:58:24 -0400 Subject: [PATCH 08/56] Declare globals for convert_otn_to_att --- R/util-convert_otn_to_att.r | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/util-convert_otn_to_att.r b/R/util-convert_otn_to_att.r index e104ce15..06a4be2d 100644 --- a/R/util-convert_otn_to_att.r +++ b/R/util-convert_otn_to_att.r @@ -89,6 +89,12 @@ convert_otn_to_att <- function(detectionObj, deploymentSheet = NULL, timeFilter = TRUE, crs = sf::st_crs(4326)) { + ## Declare global variables for R CMD check + station <- receiver_sn <- deploy_lat <- deploy_long <- detection_timestamp_utc <- + deploy_date_time <- recover_date_time <- last_download <- instrumenttype <- + ins_model_no <- Tag.ID <- Sex <- NULL + + if (is.null(deploymentObj) && is.null(deploymentSheet)) { stop("Deployment data must be supplied by either 'deploymentObj' or 'deploymentSheet'") } else if ((!is.null(deploymentObj)) && (!is.null(deploymentSheet))) { From f3573dfacb63e9caa0272896381bc45c8b3ada01 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:00:23 -0400 Subject: [PATCH 09/56] explicit use of utils::tail --- R/sim-crw_in_polygon.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/sim-crw_in_polygon.r b/R/sim-crw_in_polygon.r index 3ff2bba1..3e4607b5 100644 --- a/R/sim-crw_in_polygon.r +++ b/R/sim-crw_in_polygon.r @@ -242,7 +242,7 @@ crw_in_polygon <- function(polyg, theta = c(0, 10), stepLen = 100, } # Close polyg if needed (first and last point must be same) - if (!identical(polyg[1, ], tail(polyg, 1))) polyg <- rbind(polyg, polyg[1, ]) + if (!identical(polyg[1, ], utils::tail(polyg, 1))) polyg <- rbind(polyg, polyg[1, ]) # Make sf object polyg_sf <- sf::st_polygon(list(as.matrix(polyg[c("x", "y")]))) From a0116ddaa948f1627d619224fbb0c13de094fd7b Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:03:08 -0400 Subject: [PATCH 10/56] define globals: detect_transmissions --- R/sim-detect_transmissions.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/sim-detect_transmissions.r b/R/sim-detect_transmissions.r index a5d6b232..72a8ceb9 100644 --- a/R/sim-detect_transmissions.r +++ b/R/sim-detect_transmissions.r @@ -219,6 +219,9 @@ detect_transmissions <- function(trnsLoc = NA, inputCRS = NA, sp_out = TRUE, show_progress = TRUE) { + ## Declare global variables for NSE & R CMD check + trns_x <- trns_y <- NULL + # Check input class - trnsLoc if (!inherits(trnsLoc, c("data.frame", "sf", "sfc", "SpatialPointsDataFrame"))) { stop( From 833fed3bef59ffb3224c0b630b2a833d2f205df8 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:05:47 -0400 Subject: [PATCH 11/56] call great_lakes_polygon without using global variable --- R/vis-detection_bubble_plot.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index e52ffed0..75aeea08 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -163,7 +163,7 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", message("Converted map to EPSG:4326") } - if (is.null(map)) map <- great_lakes_polygon # example in glatos package (sf object) + if (is.null(map)) map <- data("great_lakes_polygon") # example in glatos package (sf object) # Check that timestamp is of class 'POSIXct' if (!("POSIXct" %in% class(det$detection_timestamp_utc))) { From 1b183734781635db8a76681e9dc1f355c0552dfd Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:16:48 -0400 Subject: [PATCH 12/56] declare globals: interpolate_path --- R/vis-interpolate_path.r | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/vis-interpolate_path.r b/R/vis-interpolate_path.r index 073287ad..3601b010 100644 --- a/R/vis-interpolate_path.r +++ b/R/vis-interpolate_path.r @@ -196,6 +196,14 @@ interpolate_path <- function(det, trans = NULL, start_time = NULL, int_time_stamp = 86400, lnl_thresh = 0.9, out_class = NULL, show_progress = TRUE){ + ## Declare global variables for NSE & R CMD check + detection_timestamp_utc <- record_type <- num_rows <- animal_id <- bin <- + bin_stamp <- i_lat <- deploy_lat <- i_lon <- deploy_long <- bin_timestamp <- + num <- start_dtc <- x.animal_id <- x.detection_timestamp_utc <- x.deploy_lat <- + x.deploy_long <- x.record_type <- x.num_rows <- x.bin <- gcd <- i.start <- + lcd <- crit <- t_lat <- t_lon <- t_timestamp <- coord <- grp <- nln_longitude <- + nln_latitude <- seq_count <- i_time <- latitude_lead <- longitude_lead <- + cumdist <- NULL # stop if out_class is not NULL, data.table, or tibble if(!is.null(out_class)){ From 032b17cde538f7b15d6fbfe8763a56195fd7caad Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:19:11 -0400 Subject: [PATCH 13/56] wrong argument: kml_file -> filePath --- R/util-kml_to_csv.r | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/util-kml_to_csv.r b/R/util-kml_to_csv.r index 01971d40..8e8d5a20 100644 --- a/R/util-kml_to_csv.r +++ b/R/util-kml_to_csv.r @@ -36,13 +36,14 @@ kml_to_csv <- function(filePath, type = c("points", "lines", "polygons")) { + # Change type to sf-style types type[type == "points"] <- "POINT" type[type == "lines"] <- "LINE" type[type == "polygons"] <- "POLYGON" # Unzip if kmz - fileExt <- tools::file_ext(kml_file) + fileExt <- tools::file_ext(filePath) if (tolower(fileExt) == "kmz") stop("kmz are not supported.") From b92fa5e3fd971710a889315cfff20c79648f1f26 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:20:41 -0400 Subject: [PATCH 14/56] declare globals: kml_workbook --- R/vis-kml_workbook.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/vis-kml_workbook.r b/R/vis-kml_workbook.r index 63d2a5a8..18f7d32c 100644 --- a/R/vis-kml_workbook.r +++ b/R/vis-kml_workbook.r @@ -114,6 +114,9 @@ kml_workbook <- function( "specified when 'wb_file = NULL.'" )) } + + ## Declare global variables for NSE & R CMD check + Folder <- NULL # set default and get optional kml arguments kml_args <- list(labelSize = 0.6, iconSize = 0.6) From 93ff7d72fe73787ec3c011d6782f3ddc79c9b9a9 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:24:11 -0400 Subject: [PATCH 15/56] declare globals: make_frames --- R/vis-make_frames.r | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 231817f3..ad4e4aa9 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -215,6 +215,11 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), bg_map = NULL, show_progress = TRUE, ...) { # NOTE: As of glatos v 0.4.1, the package no longer uses the external program ffmpeg. Input argument 'ffmpeg' has been removed" + ## Declare global variables for NSE & R CMD check + row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- + f_name <- animal_id <- record_type <- latitude <- longitude <- + deploy_date_time <- NULL + # expand path to animation output file # - place in same file as images (out_dir) if none specified # - preserve "./" prefix if specified @@ -393,7 +398,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # Load background (use example Great Lakes if null) if (is.null(bg_map)) { - background <- great_lakes_polygon # example in glatos package + background <- data("great_lakes_polygon") # example in glatos package } else { background <- bg_map From 78a837d617e3f7f47556d9cb103a52cde775385d Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:25:52 -0400 Subject: [PATCH 16/56] declare globals: min_lag --- R/proc-min_lag.r | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/proc-min_lag.r b/R/proc-min_lag.r index b9f0d103..a0133707 100644 --- a/R/proc-min_lag.r +++ b/R/proc-min_lag.r @@ -64,6 +64,10 @@ #' @export min_lag <- function(det) { + ## Declare global variables for NSE & R CMD check + ord <- transmitter_codespace <- transmitter_id <- receiver_sn <- + detection_timestamp_utc <- NULL + # coerce to data.table dtc <- data.table::as.data.table(det) From 13f12529258a9509893886fa7f87091c6aef2516 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:28:38 -0400 Subject: [PATCH 17/56] declare globals: prepare_deploy_sheet --- R/load-prepare_deploy_sheet.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/load-prepare_deploy_sheet.R b/R/load-prepare_deploy_sheet.R index 4230321a..f8e8619b 100644 --- a/R/load-prepare_deploy_sheet.R +++ b/R/load-prepare_deploy_sheet.R @@ -36,6 +36,13 @@ #' @export prepare_deploy_sheet <- function(path, header_line = 5, sheet_name = 1, combine_arr_stn = TRUE) { + ## Declare global variables for NSE & R CMD check + DEPLOY_LAT <- DEPLOY_LONG <- INS_MODEL_NO <- + `DEPLOY_DATE_TIME (yyyy-mm-ddThh:mm:ss)` <- + `RECOVER_DATE_TIME (yyyy-mm-ddThh:mm:ss)` <- STATION_NO <- + OTN_ARRAY <- station <- ins_model_no <- deploy_lat <- deploy_long <- + deploy_date_time <- recover_date_time <- NULL + deploy_sheet <- readxl::read_excel(path, sheet = sheet_name, skip = header_line - 1, From b6cff766936b240c4987c0f50e8e1e63c29fe056 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 10:30:36 -0400 Subject: [PATCH 18/56] declare globals: prepare_tag_sheet --- R/load-prepare_tag_sheet.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/load-prepare_tag_sheet.R b/R/load-prepare_tag_sheet.R index d0dee61d..6cd60eac 100644 --- a/R/load-prepare_tag_sheet.R +++ b/R/load-prepare_tag_sheet.R @@ -31,6 +31,10 @@ #' @export prepare_tag_sheet <- function(path, header_line = 5, sheet_name = 2) { + ## Declare global variables for NSE & R CMD check + TAG_CODE_SPACE <- TAG_ID_CODE <- EST_TAG_LIFE <- UTC_RELEASE_DATE_TIME <- + SEX <- RELEASE_LATITUDE <- RELEASE_LONGITUDE <- SCIENTIFIC_NAME <- NULL + tag_sheet <- readxl::read_excel(path, sheet = sheet_name, skip = header_line - 1) tag_sheet <- tag_sheet %>% dplyr::mutate( transmitter_id = paste(TAG_CODE_SPACE, TAG_ID_CODE, sep = "-"), From 66b33f8c11042dc12ebcdddad734d82de433767a Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 14:38:30 +0000 Subject: [PATCH 19/56] Update documentation --- man/summarize_detections.Rd | 117 +++++++++++++++++++----------------- 1 file changed, 63 insertions(+), 54 deletions(-) diff --git a/man/summarize_detections.Rd b/man/summarize_detections.Rd index e0cbde40..76bf76ea 100644 --- a/man/summarize_detections.Rd +++ b/man/summarize_detections.Rd @@ -137,60 +137,69 @@ the output summary. } \examples{ -#get path to example detection file - det_file <- system.file("extdata", "walleye_detections.csv", - package = "glatos") - det <- read_glatos_detections(det_file) - - #Basic summaries - - # by animal - ds <- summarize_detections(det) - - # by location - ds <- summarize_detections(det, summ_type = "location") - - # by animal and location - ds <- summarize_detections(det, summ_type = "both") - - - #Include user-defined location_col - - # by animal - det$some_place <- ifelse(grepl("^S", det$glatos_array), "s", "not_s") - - ds <- summarize_detections(det, location_col = "some_place") - - # by location - ds <- summarize_detections(det, location_col = "some_place", - summ_type = "location") - - # by animal and location - ds <- summarize_detections(det, location_col = "some_place", - summ_type = "both") - - - #Include locations where no animals detected - - #get example receiver data - rec_file <- system.file("extdata", "sample_receivers.csv", - package = "glatos") - rec <- read_glatos_receivers(rec_file) - - ds <- summarize_detections(det, receiver_locs = rec, summ_type = "location") - - - #Include animals that were not detected - #get example animal data from walleye workbook - wb_file <- system.file("extdata", "walleye_workbook.xlsm", - package = "glatos") - wb <- read_glatos_workbook(wb_file) - - ds <- summarize_detections(det, animals = wb$animals, summ_type = "animal") - - #Include by animals and locations that were not detected - ds <- summarize_detections(det, receiver_locs = rec, animals = wb$animals, - summ_type = "both") +# get path to example detection file +det_file <- system.file("extdata", "walleye_detections.csv", + package = "glatos" +) +det <- read_glatos_detections(det_file) + +# Basic summaries + +# by animal +ds <- summarize_detections(det) + +# by location +ds <- summarize_detections(det, summ_type = "location") + +# by animal and location +ds <- summarize_detections(det, summ_type = "both") + + +# Include user-defined location_col + +# by animal +det$some_place <- ifelse(grepl("^S", det$glatos_array), "s", "not_s") + +ds <- summarize_detections(det, location_col = "some_place") + +# by location +ds <- summarize_detections(det, + location_col = "some_place", + summ_type = "location" +) + +# by animal and location +ds <- summarize_detections(det, + location_col = "some_place", + summ_type = "both" +) + + +# Include locations where no animals detected + +# get example receiver data +rec_file <- system.file("extdata", "sample_receivers.csv", + package = "glatos" +) +rec <- read_glatos_receivers(rec_file) + +ds <- summarize_detections(det, receiver_locs = rec, summ_type = "location") + + +# Include animals that were not detected +# get example animal data from walleye workbook +wb_file <- system.file("extdata", "walleye_workbook.xlsm", + package = "glatos" +) +wb <- read_glatos_workbook(wb_file) + +ds <- summarize_detections(det, animals = wb$animals, summ_type = "animal") + +# Include by animals and locations that were not detected +ds <- summarize_detections(det, + receiver_locs = rec, animals = wb$animals, + summ_type = "both" +) } \author{ From a7295d6fe761321f9a421e67470fcd148ace10cc Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:02:50 -0400 Subject: [PATCH 20/56] declare globals; call vdat_csv_schema without global var; call stats::setNames explicitly --- R/load-read_vdat_csv.r | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index ccc3230a..55053bf8 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -1,7 +1,5 @@ #' Read data from an Innovasea Fathom VDAT CSV file #' -#' Read data from an Innovasea Fathom VDAT CSV file -#' #' @param src A character string with path and name of an Innovasea VDAT CSV #' detection file. If only file name is given, then the file must be located #' in the working directory. @@ -135,6 +133,9 @@ read_vdat_csv <- function(src, warning("File not found: ", src) return() } + + ## Declare global variables for NSE & R CMD check + record_type <- # Identify vdat csv format version and vdat.exe version that created input csv vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) @@ -218,13 +219,13 @@ read_vdat_csv <- function(src, keep.by = FALSE ) - data(vdat_csv_schema) + data("vdat_csv_schema") vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] # Preallocate list; element = record type - vdat <- setNames( + vdat <- stats::setNames( object = vector("list", length(vdat_list)), nm = names(vdat_list) ) From 1fb9fc76ad60569aa913c33434d1a92e6e415b6a Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:21:20 -0400 Subject: [PATCH 21/56] Declare globals: real_sensor_values --- R/proc-real_sensor_values.r | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/proc-real_sensor_values.r b/R/proc-real_sensor_values.r index d5115a9a..d03fd9f2 100644 --- a/R/proc-real_sensor_values.r +++ b/R/proc-real_sensor_values.r @@ -110,6 +110,10 @@ #' @export real_sensor_values <- function(det, tag_specs) { + ## Declare global variables for NSE & R CMD check + ord <- transmitter_codespace <- transmitter_id <- code_space <- id_code <- + sensor_value_real <- sensor_intercept <- sensor_value <- sensor_slope <- NULL + # coerce to data.table dtc <- data.table::as.data.table(det) From f63a2d979e68b23b95b1be3501b6bf68f2a9394d Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:23:35 -0400 Subject: [PATCH 22/56] declare globals: REI --- R/summ-receiver_efficiency.r | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/summ-receiver_efficiency.r b/R/summ-receiver_efficiency.r index aafd20df..96becb42 100644 --- a/R/summ-receiver_efficiency.r +++ b/R/summ-receiver_efficiency.r @@ -55,6 +55,10 @@ #' @export REI <- function(detections, deployments) { + ## Declare global variables for NSE & R CMD check + recover_date_time <- last_download <- station <- days_deployed <- deploy_lat <- + deploy_long <- animal_id <- common_name_e <- detection_timestamp_utc <- NULL + # Check for proper columns required_deployment_columns <- c("station", "deploy_date_time", "recover_date_time") required_detection_columns <- c("station", "common_name_e", "animal_id", "detection_timestamp_utc") From e27d22979fda37157b27321f925ee5c3ccc64f8f Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:27:05 -0400 Subject: [PATCH 23/56] declare globals: summarize_detections --- R/summ-summarize_detections.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/summ-summarize_detections.r b/R/summ-summarize_detections.r index b78a6ed8..2a1b4cf9 100644 --- a/R/summ-summarize_detections.r +++ b/R/summ-summarize_detections.r @@ -194,6 +194,11 @@ summarize_detections <- function(det, location_col = "glatos_array", receiver_locs = NULL, animals = NULL, summ_type = "animal") { + ## Declare global variables for NSE & R CMD check + deploy_lat <- deploy_long <- detection_timestamp_utc <- num_fish <- animal_id <- + num_locs <- num_dets <- NULL + + # coerce to data.table dtc <- data.table::as.data.table(det) From 0fa0d26f8925a97cbd803150330b0f2a7bf346d7 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:28:21 -0400 Subject: [PATCH 24/56] declare globals: transmit_along_path --- R/sim-transmit_along_path.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/sim-transmit_along_path.r b/R/sim-transmit_along_path.r index 3b52f7d4..d786b88f 100644 --- a/R/sim-transmit_along_path.r +++ b/R/sim-transmit_along_path.r @@ -179,6 +179,9 @@ transmit_along_path <- function(path = NA, ), pathCRS = NA, sp_out = TRUE) { + ## Declare global variables for NSE & R CMD check + cumdistm <- NULL + # Check input class if (!inherits(path, c("data.frame", "sf", "sfc", "SpatialPointsDataFrame"))) { stop( From c9ff4d4a21b1b3ebb7cb8aaafe4d42d41bd0b81c Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:32:13 -0400 Subject: [PATCH 25/56] declare globals: vdat_convert --- R/util-vdat.r | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/util-vdat.r b/R/util-vdat.r index 7b4eed18..2045543a 100644 --- a/R/util-vdat.r +++ b/R/util-vdat.r @@ -180,6 +180,10 @@ vdat_convert <- function(src, skip_pattern = "-RLD_", show_progress = TRUE, diagn = FALSE) { + ## Declare global variables for NSE & R CMD check + src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- + written <- NULL + # Supported input file extensions (not case sensitive) supported_ext <- c("vrl", "vdat") From 4478bdcb5d06f2c6019b2ea93a79f378ec59bdf8 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:32:25 -0400 Subject: [PATCH 26/56] declare globals: vue_convert --- R/util-vue.r | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/util-vue.r b/R/util-vue.r index a52de60e..b8844a5b 100644 --- a/R/util-vue.r +++ b/R/util-vue.r @@ -167,6 +167,10 @@ vue_convert <- function(src, skip_pattern = "-RLD_", show_progress = TRUE, diagn = FALSE) { + ## Declare global variables for NSE & R CMD check + src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- + written <- NULL + # Supported input file extensions (not case sensitive) supported_ext <- "vrl" From 110b910672f3af7c8b0e6477d9c8661c11dcbdcf Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 13:42:10 -0400 Subject: [PATCH 27/56] declare globals: write_vdat_csv; explicitly call stats::setNames and utils::tail --- R/load-write_vdat_csv.r | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/load-write_vdat_csv.r b/R/load-write_vdat_csv.r index 6ffd201d..859c4f28 100644 --- a/R/load-write_vdat_csv.r +++ b/R/load-write_vdat_csv.r @@ -74,6 +74,11 @@ write_vdat_csv <- function(vdat, out_file = NULL, output_format = "csv.fathom", include_empty = FALSE) { + ## Declare global variables for NSE & R CMD check + record_type <- dt2 <- `Device Time (UTC)` <- `Time Correction (s)` <- + `Ambient (deg C)` <- `Ambient Min (deg C)` <- `Ambient Max (deg C)` <- + `Ambient Mean (deg C)` <- `Internal (deg C)` <- ..txt_cols <- txt <- NULL + # Check input class if (!inherits(vdat, "vdat_list")) { stop( @@ -107,7 +112,7 @@ write_vdat_csv <- function(vdat, if (out_file_type == "dir") { out_file_name <- gsub("\\.vrl$|\\.vdat$", out_file_ext, - tail(vdat$DATA_SOURCE_FILE$`File Name`, 1), + utils::tail(vdat$DATA_SOURCE_FILE$`File Name`, 1), ignore.case = TRUE ) @@ -142,12 +147,12 @@ write_vdat_csv <- function(vdat, # Compress each list element into a character vector - vdat_lines_body <- setNames( + vdat_lines_body <- stats::setNames( object = vector("list", length(record_types)), record_types ) - vdat_lines_header <- setNames( + vdat_lines_header <- stats::setNames( object = vector("list", length(record_types)), record_types ) From 709f0f2603d5be7d09a5f236c391b9a5442dc118 Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 17:44:55 +0000 Subject: [PATCH 28/56] Style code (GHA) --- R/load-prepare_deploy_sheet.R | 4 ++-- R/load-prepare_tag_sheet.R | 4 ++-- R/load-read_vdat_csv.r | 9 ++++----- R/load-write_vdat_csv.r | 6 +++--- R/proc-min_lag.r | 2 +- R/proc-real_sensor_values.r | 4 ++-- R/sim-detect_transmissions.r | 2 +- R/sim-transmit_along_path.r | 2 +- R/summ-receiver_efficiency.r | 4 ++-- R/summ-residence_index.r | 10 +++++----- R/summ-summarize_detections.r | 6 +++--- R/util-convert_glatos_to_att.r | 6 +++--- R/util-convert_otn_erddap_to_att.r | 2 +- R/util-convert_otn_to_att.r | 8 ++++---- R/util-kml_to_csv.r | 1 - R/util-vdat.r | 4 ++-- R/util-vue.r | 4 ++-- R/vis-kml_workbook.r | 2 +- R/vis-make_frames.r | 4 ++-- 19 files changed, 41 insertions(+), 43 deletions(-) diff --git a/R/load-prepare_deploy_sheet.R b/R/load-prepare_deploy_sheet.R index f8e8619b..bfd90e1f 100644 --- a/R/load-prepare_deploy_sheet.R +++ b/R/load-prepare_deploy_sheet.R @@ -39,10 +39,10 @@ prepare_deploy_sheet <- function(path, header_line = 5, sheet_name = 1, combine_ ## Declare global variables for NSE & R CMD check DEPLOY_LAT <- DEPLOY_LONG <- INS_MODEL_NO <- `DEPLOY_DATE_TIME (yyyy-mm-ddThh:mm:ss)` <- - `RECOVER_DATE_TIME (yyyy-mm-ddThh:mm:ss)` <- STATION_NO <- + `RECOVER_DATE_TIME (yyyy-mm-ddThh:mm:ss)` <- STATION_NO <- OTN_ARRAY <- station <- ins_model_no <- deploy_lat <- deploy_long <- deploy_date_time <- recover_date_time <- NULL - + deploy_sheet <- readxl::read_excel(path, sheet = sheet_name, skip = header_line - 1, diff --git a/R/load-prepare_tag_sheet.R b/R/load-prepare_tag_sheet.R index 6cd60eac..06ee6ccf 100644 --- a/R/load-prepare_tag_sheet.R +++ b/R/load-prepare_tag_sheet.R @@ -32,9 +32,9 @@ prepare_tag_sheet <- function(path, header_line = 5, sheet_name = 2) { ## Declare global variables for NSE & R CMD check - TAG_CODE_SPACE <- TAG_ID_CODE <- EST_TAG_LIFE <- UTC_RELEASE_DATE_TIME <- + TAG_CODE_SPACE <- TAG_ID_CODE <- EST_TAG_LIFE <- UTC_RELEASE_DATE_TIME <- SEX <- RELEASE_LATITUDE <- RELEASE_LONGITUDE <- SCIENTIFIC_NAME <- NULL - + tag_sheet <- readxl::read_excel(path, sheet = sheet_name, skip = header_line - 1) tag_sheet <- tag_sheet %>% dplyr::mutate( transmitter_id = paste(TAG_CODE_SPACE, TAG_ID_CODE, sep = "-"), diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index 55053bf8..6848821a 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -133,12 +133,11 @@ read_vdat_csv <- function(src, warning("File not found: ", src) return() } - - ## Declare global variables for NSE & R CMD check - record_type <- - # Identify vdat csv format version and vdat.exe version that created input csv - vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) + ## Declare global variables for NSE & R CMD check + record_type <- + # Identify vdat csv format version and vdat.exe version that created input csv + vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) # Check if fathom csv format (error if looks like VUE export format) if (vdat_header$V1[1] == "VEMCO DATA LOG") { diff --git a/R/load-write_vdat_csv.r b/R/load-write_vdat_csv.r index 859c4f28..114a7457 100644 --- a/R/load-write_vdat_csv.r +++ b/R/load-write_vdat_csv.r @@ -75,10 +75,10 @@ write_vdat_csv <- function(vdat, output_format = "csv.fathom", include_empty = FALSE) { ## Declare global variables for NSE & R CMD check - record_type <- dt2 <- `Device Time (UTC)` <- `Time Correction (s)` <- - `Ambient (deg C)` <- `Ambient Min (deg C)` <- `Ambient Max (deg C)` <- + record_type <- dt2 <- `Device Time (UTC)` <- `Time Correction (s)` <- + `Ambient (deg C)` <- `Ambient Min (deg C)` <- `Ambient Max (deg C)` <- `Ambient Mean (deg C)` <- `Internal (deg C)` <- ..txt_cols <- txt <- NULL - + # Check input class if (!inherits(vdat, "vdat_list")) { stop( diff --git a/R/proc-min_lag.r b/R/proc-min_lag.r index a0133707..9d42c050 100644 --- a/R/proc-min_lag.r +++ b/R/proc-min_lag.r @@ -67,7 +67,7 @@ min_lag <- function(det) { ## Declare global variables for NSE & R CMD check ord <- transmitter_codespace <- transmitter_id <- receiver_sn <- detection_timestamp_utc <- NULL - + # coerce to data.table dtc <- data.table::as.data.table(det) diff --git a/R/proc-real_sensor_values.r b/R/proc-real_sensor_values.r index d03fd9f2..573641f9 100644 --- a/R/proc-real_sensor_values.r +++ b/R/proc-real_sensor_values.r @@ -111,9 +111,9 @@ real_sensor_values <- function(det, tag_specs) { ## Declare global variables for NSE & R CMD check - ord <- transmitter_codespace <- transmitter_id <- code_space <- id_code <- + ord <- transmitter_codespace <- transmitter_id <- code_space <- id_code <- sensor_value_real <- sensor_intercept <- sensor_value <- sensor_slope <- NULL - + # coerce to data.table dtc <- data.table::as.data.table(det) diff --git a/R/sim-detect_transmissions.r b/R/sim-detect_transmissions.r index 72a8ceb9..cd0cd9ea 100644 --- a/R/sim-detect_transmissions.r +++ b/R/sim-detect_transmissions.r @@ -221,7 +221,7 @@ detect_transmissions <- function(trnsLoc = NA, show_progress = TRUE) { ## Declare global variables for NSE & R CMD check trns_x <- trns_y <- NULL - + # Check input class - trnsLoc if (!inherits(trnsLoc, c("data.frame", "sf", "sfc", "SpatialPointsDataFrame"))) { stop( diff --git a/R/sim-transmit_along_path.r b/R/sim-transmit_along_path.r index d786b88f..ab9d6d09 100644 --- a/R/sim-transmit_along_path.r +++ b/R/sim-transmit_along_path.r @@ -181,7 +181,7 @@ transmit_along_path <- function(path = NA, sp_out = TRUE) { ## Declare global variables for NSE & R CMD check cumdistm <- NULL - + # Check input class if (!inherits(path, c("data.frame", "sf", "sfc", "SpatialPointsDataFrame"))) { stop( diff --git a/R/summ-receiver_efficiency.r b/R/summ-receiver_efficiency.r index 96becb42..c08fa812 100644 --- a/R/summ-receiver_efficiency.r +++ b/R/summ-receiver_efficiency.r @@ -56,9 +56,9 @@ REI <- function(detections, deployments) { ## Declare global variables for NSE & R CMD check - recover_date_time <- last_download <- station <- days_deployed <- deploy_lat <- + recover_date_time <- last_download <- station <- days_deployed <- deploy_lat <- deploy_long <- animal_id <- common_name_e <- detection_timestamp_utc <- NULL - + # Check for proper columns required_deployment_columns <- c("station", "deploy_date_time", "recover_date_time") required_detection_columns <- c("station", "common_name_e", "animal_id", "detection_timestamp_utc") diff --git a/R/summ-residence_index.r b/R/summ-residence_index.r index a1a18f01..48d1f386 100644 --- a/R/summ-residence_index.r +++ b/R/summ-residence_index.r @@ -175,10 +175,10 @@ residence_index <- function( locations = NULL, group_col = "animal_id", time_interval_size = "1 day", groupwise_total = TRUE) { # Declare global variables for R CMD check - location <- mean_latitude <- mean_longitude <- days_detected <- + location <- mean_latitude <- mean_longitude <- days_detected <- total_days <- NULL - - + + # set to NULL if NA if (!is.null(group_col)) if (is.na(group_col)) group_col <- NULL if (!is.null(locations)) if (all(is.na(locations))) locations <- NULL @@ -372,7 +372,7 @@ total_diff_days <- function(detections) { aggregate_total_with_overlap <- function(detections) { # Declare global variables for R CMD check last_detection <- first_detection <- NULL - + detections <- mutate(detections, timedelta = as.double(difftime(last_detection, first_detection, units = "secs"))) detections <- mutate(detections, timedelta = dplyr::recode(detections$timedelta, `0` = 1)) total <- as.double(sum(detections$timedelta)) / 86400.0 @@ -392,7 +392,7 @@ aggregate_total_with_overlap <- function(detections) { aggregate_total_no_overlap <- function(detections) { # Declare global variables for R CMD check t1 <- t2 <- first_detection <- last_detection <- xid <- yid <- tdiff <- NULL - + # extract intervals, rename ints <- data.table::as.data.table(detections)[, .( t1 = first_detection, diff --git a/R/summ-summarize_detections.r b/R/summ-summarize_detections.r index 2a1b4cf9..4d11ae6e 100644 --- a/R/summ-summarize_detections.r +++ b/R/summ-summarize_detections.r @@ -195,10 +195,10 @@ summarize_detections <- function(det, location_col = "glatos_array", receiver_locs = NULL, animals = NULL, summ_type = "animal") { ## Declare global variables for NSE & R CMD check - deploy_lat <- deploy_long <- detection_timestamp_utc <- num_fish <- animal_id <- + deploy_lat <- deploy_long <- detection_timestamp_utc <- num_fish <- animal_id <- num_locs <- num_dets <- NULL - - + + # coerce to data.table dtc <- data.table::as.data.table(det) diff --git a/R/util-convert_glatos_to_att.r b/R/util-convert_glatos_to_att.r index 3150cbcb..aec6b688 100644 --- a/R/util-convert_glatos_to_att.r +++ b/R/util-convert_glatos_to_att.r @@ -44,9 +44,9 @@ convert_glatos_to_att <- function(detectionObj, receiverObj, crs = sp::CRS("+init=epsg:4326")) { ## Declare global variables for R CMD check Sex <- glatos_array <- station_no <- deploy_lat <- deploy_long <- - station <- dummy <- ins_model_no <- ins_serial_no <- - deploy_date_time <- recover_date_time <- detection_timestamp_utc <- NULL - + station <- dummy <- ins_model_no <- ins_serial_no <- + deploy_date_time <- recover_date_time <- detection_timestamp_utc <- NULL + transmitters <- if (all(grepl("-", detectionObj$transmitter_id, fixed = TRUE))) { detectionObj$transmitter_id diff --git a/R/util-convert_otn_erddap_to_att.r b/R/util-convert_otn_erddap_to_att.r index d7a9b9ef..da17625e 100644 --- a/R/util-convert_otn_erddap_to_att.r +++ b/R/util-convert_otn_erddap_to_att.r @@ -81,7 +81,7 @@ convert_otn_erddap_to_att <- function(detectionObj, erdTags, erdRcv, erdAni, Sex <- latitude <- longitude <- station <- receiver_model <- receiver_serial_number <- dummy <- time <- recovery_datetime_utc <- deploy_datetime_utc <- detection_timestamp_utc <- NULL - + transmitters <- if (all(grepl("-", detectionObj$transmitter_id, fixed = TRUE))) { detectionObj$transmitter_id diff --git a/R/util-convert_otn_to_att.r b/R/util-convert_otn_to_att.r index 06a4be2d..dd1cd706 100644 --- a/R/util-convert_otn_to_att.r +++ b/R/util-convert_otn_to_att.r @@ -90,11 +90,11 @@ convert_otn_to_att <- function(detectionObj, timeFilter = TRUE, crs = sf::st_crs(4326)) { ## Declare global variables for R CMD check - station <- receiver_sn <- deploy_lat <- deploy_long <- detection_timestamp_utc <- - deploy_date_time <- recover_date_time <- last_download <- instrumenttype <- + station <- receiver_sn <- deploy_lat <- deploy_long <- detection_timestamp_utc <- + deploy_date_time <- recover_date_time <- last_download <- instrumenttype <- ins_model_no <- Tag.ID <- Sex <- NULL - - + + if (is.null(deploymentObj) && is.null(deploymentSheet)) { stop("Deployment data must be supplied by either 'deploymentObj' or 'deploymentSheet'") } else if ((!is.null(deploymentObj)) && (!is.null(deploymentSheet))) { diff --git a/R/util-kml_to_csv.r b/R/util-kml_to_csv.r index 8e8d5a20..13a28b11 100644 --- a/R/util-kml_to_csv.r +++ b/R/util-kml_to_csv.r @@ -36,7 +36,6 @@ kml_to_csv <- function(filePath, type = c("points", "lines", "polygons")) { - # Change type to sf-style types type[type == "points"] <- "POINT" type[type == "lines"] <- "LINE" diff --git a/R/util-vdat.r b/R/util-vdat.r index 2045543a..9dc3072d 100644 --- a/R/util-vdat.r +++ b/R/util-vdat.r @@ -181,9 +181,9 @@ vdat_convert <- function(src, show_progress = TRUE, diagn = FALSE) { ## Declare global variables for NSE & R CMD check - src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- + src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- written <- NULL - + # Supported input file extensions (not case sensitive) supported_ext <- c("vrl", "vdat") diff --git a/R/util-vue.r b/R/util-vue.r index b8844a5b..3fe52e26 100644 --- a/R/util-vue.r +++ b/R/util-vue.r @@ -168,9 +168,9 @@ vue_convert <- function(src, show_progress = TRUE, diagn = FALSE) { ## Declare global variables for NSE & R CMD check - src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- + src_dir <- src_file <- out_file <- out_file_exists <- src_to_convert <- written <- NULL - + # Supported input file extensions (not case sensitive) supported_ext <- "vrl" diff --git a/R/vis-kml_workbook.r b/R/vis-kml_workbook.r index 18f7d32c..aee435dc 100644 --- a/R/vis-kml_workbook.r +++ b/R/vis-kml_workbook.r @@ -114,7 +114,7 @@ kml_workbook <- function( "specified when 'wb_file = NULL.'" )) } - + ## Declare global variables for NSE & R CMD check Folder <- NULL diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index ad4e4aa9..c143c3df 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -216,10 +216,10 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # NOTE: As of glatos v 0.4.1, the package no longer uses the external program ffmpeg. Input argument 'ffmpeg' has been removed" ## Declare global variables for NSE & R CMD check - row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- + row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- f_name <- animal_id <- record_type <- latitude <- longitude <- deploy_date_time <- NULL - + # expand path to animation output file # - place in same file as images (out_dir) if none specified # - preserve "./" prefix if specified From 67fa30030f905e7c204e52778be2ad087488bc63 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 14:04:24 -0400 Subject: [PATCH 29/56] Add kml_to_csv test --- tests/testthat/_snaps/kml_to_csv.md | 20 +++++++++++++++++ tests/testthat/test-kml_to_csv.R | 35 +++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+) create mode 100644 tests/testthat/_snaps/kml_to_csv.md create mode 100644 tests/testthat/test-kml_to_csv.R diff --git a/tests/testthat/_snaps/kml_to_csv.md b/tests/testthat/_snaps/kml_to_csv.md new file mode 100644 index 00000000..b40d1c80 --- /dev/null +++ b/tests/testthat/_snaps/kml_to_csv.md @@ -0,0 +1,20 @@ +# creates csv + + Code + read.csv(file.path(temp_dir, "example_polygons.csv")) + Output + name feature_type seq longitude latitude altitude + 1 example_polygon1 POLYGON 1 -109.33785 45.53534 0 + 2 example_polygon1 POLYGON 2 -106.95169 41.46721 0 + 3 example_polygon1 POLYGON 3 -100.89851 44.45468 0 + 4 example_polygon1 POLYGON 4 -109.33785 45.53534 0 + 5 example_polygon2 POLYGON 1 -100.06183 37.08399 0 + 6 example_polygon2 POLYGON 2 -99.84344 35.26575 0 + 7 example_polygon2 POLYGON 3 -98.61712 35.40292 0 + 8 example_polygon2 POLYGON 4 -96.75744 37.63186 0 + 9 example_polygon2 POLYGON 5 -96.44857 39.81675 0 + 10 example_polygon2 POLYGON 6 -98.79507 41.59274 0 + 11 example_polygon2 POLYGON 7 -102.16848 39.89768 0 + 12 example_polygon2 POLYGON 8 -103.08779 36.17908 0 + 13 example_polygon2 POLYGON 9 -100.06183 37.08399 0 + diff --git a/tests/testthat/test-kml_to_csv.R b/tests/testthat/test-kml_to_csv.R new file mode 100644 index 00000000..b5736ada --- /dev/null +++ b/tests/testthat/test-kml_to_csv.R @@ -0,0 +1,35 @@ +test_that("errors with kmz", { + expect_error( + kml_to_csv('some_kmz_file.kmz'), + 'kmz are not supported' + ) +}) + +test_that("creates csv", { + temp_dir <- file.path(tempdir(), 'test-kml_to_csv') + dir.create(temp_dir) + result_of_copy <- file.copy( + system.file("extdata", "example_polygons.kml", package = "glatos"), + temp_dir + ) + + + out_loc <- kml_to_csv(file.path(temp_dir, "example_polygons.kml")) + + expect_equal( + out_loc, + file.path(temp_dir, "example_polygons.csv") + ) + + expect_true( + file.exists(file.path(temp_dir, "example_polygons.csv")) + ) + + expect_snapshot( + read.csv( + file.path(temp_dir, "example_polygons.csv") + ) + ) + + unlink(temp_dir, recursive = T) +}) From 7564865596c8cbd7ca53c631615ba447197093b6 Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 18:06:45 +0000 Subject: [PATCH 30/56] Style code (GHA) --- tests/testthat/test-kml_to_csv.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-kml_to_csv.R b/tests/testthat/test-kml_to_csv.R index b5736ada..8ade7d9a 100644 --- a/tests/testthat/test-kml_to_csv.R +++ b/tests/testthat/test-kml_to_csv.R @@ -1,35 +1,35 @@ test_that("errors with kmz", { expect_error( - kml_to_csv('some_kmz_file.kmz'), - 'kmz are not supported' + kml_to_csv("some_kmz_file.kmz"), + "kmz are not supported" ) }) test_that("creates csv", { - temp_dir <- file.path(tempdir(), 'test-kml_to_csv') + temp_dir <- file.path(tempdir(), "test-kml_to_csv") dir.create(temp_dir) result_of_copy <- file.copy( system.file("extdata", "example_polygons.kml", package = "glatos"), temp_dir ) - - + + out_loc <- kml_to_csv(file.path(temp_dir, "example_polygons.kml")) - + expect_equal( out_loc, file.path(temp_dir, "example_polygons.csv") ) - + expect_true( file.exists(file.path(temp_dir, "example_polygons.csv")) ) - + expect_snapshot( read.csv( file.path(temp_dir, "example_polygons.csv") ) ) - + unlink(temp_dir, recursive = T) }) From e6253325d99921423db5f7c7e450be3e95fd7721 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 14:20:59 -0400 Subject: [PATCH 31/56] fix partial match --- R/vis-position_heat_map.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/vis-position_heat_map.r b/R/vis-position_heat_map.r index 9b00992b..f52000ad 100644 --- a/R/vis-position_heat_map.r +++ b/R/vis-position_heat_map.r @@ -397,7 +397,7 @@ position_heat_map <- function(positions, png( - file = file.path(png_file), + filename = file.path(png_file), bg = "transparent", height = 2000, width = 2000 * (ncol(results) / nrow(results)), From 1a9e7dc87f4d25646af7201b4918e6b0bcfc427c Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 14:22:52 -0400 Subject: [PATCH 32/56] call utils::data --- R/load-read_vdat_csv.r | 2 +- R/vis-detection_bubble_plot.r | 2 +- R/vis-make_frames.r | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index 6848821a..065066b6 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -218,7 +218,7 @@ read_vdat_csv <- function(src, keep.by = FALSE ) - data("vdat_csv_schema") + utils::data("vdat_csv_schema") vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index 75aeea08..a4f4d3a5 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -163,7 +163,7 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", message("Converted map to EPSG:4326") } - if (is.null(map)) map <- data("great_lakes_polygon") # example in glatos package (sf object) + if (is.null(map)) map <- utils::data("great_lakes_polygon") # example in glatos package (sf object) # Check that timestamp is of class 'POSIXct' if (!("POSIXct" %in% class(det$detection_timestamp_utc))) { diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index c143c3df..19740203 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -398,7 +398,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # Load background (use example Great Lakes if null) if (is.null(bg_map)) { - background <- data("great_lakes_polygon") # example in glatos package + background <- utils::data("great_lakes_polygon") # example in glatos package } else { background <- bg_map From 484d4f59a68fd61ed79ab599b47d9d5d6bac6829 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 14:28:07 -0400 Subject: [PATCH 33/56] load data into function's environment rather than global user environment. see ?data --- R/load-read_vdat_csv.r | 2 +- R/vis-detection_bubble_plot.r | 3 +-- R/vis-make_frames.r | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index 065066b6..a09d2937 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -218,7 +218,7 @@ read_vdat_csv <- function(src, keep.by = FALSE ) - utils::data("vdat_csv_schema") + utils::data("vdat_csv_schema", envir = environment()) vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index a4f4d3a5..4bae67aa 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -1,4 +1,3 @@ -#' Plot number of tagged animals or detections on a map #' #' Make bubble plots showing the number of fish detected across a defined set #' of receiver locations. @@ -163,7 +162,7 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", message("Converted map to EPSG:4326") } - if (is.null(map)) map <- utils::data("great_lakes_polygon") # example in glatos package (sf object) + if (is.null(map)) map <- utils::data("great_lakes_polygon", envir = environment()) # example in glatos package (sf object) # Check that timestamp is of class 'POSIXct' if (!("POSIXct" %in% class(det$detection_timestamp_utc))) { diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 19740203..56a89483 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -398,7 +398,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # Load background (use example Great Lakes if null) if (is.null(bg_map)) { - background <- utils::data("great_lakes_polygon") # example in glatos package + background <- utils::data("great_lakes_polygon", envir = environment()) # example in glatos package } else { background <- bg_map From 802d3c790d71fc3601f25736d9fb9f40bfdf3c21 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 14:56:27 -0400 Subject: [PATCH 34/56] fix introduced utils::data bug --- R/vis-make_frames.r | 235 ++++++++++++++++++++++---------------------- 1 file changed, 118 insertions(+), 117 deletions(-) diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 56a89483..79bcf71e 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -214,12 +214,12 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), overwrite = FALSE, preview = FALSE, bg_map = NULL, show_progress = TRUE, ...) { # NOTE: As of glatos v 0.4.1, the package no longer uses the external program ffmpeg. Input argument 'ffmpeg' has been removed" - - ## Declare global variables for NSE & R CMD check + + # Declare global variables for NSE & R CMD check row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- f_name <- animal_id <- record_type <- latitude <- longitude <- deploy_date_time <- NULL - + # expand path to animation output file # - place in same file as images (out_dir) if none specified # - preserve "./" prefix if specified @@ -233,31 +233,31 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), if (!contains_dir) ani_name <- file.path(out_dir, ani_name) } } - + # if overwrite = FALSE, check if animation output file exists if (!overwrite & file.exists(ani_name)) { stop("Operation aborted ", - "because output video file ", - "exists and 'overwrite = ", - "FALSE'.", - call. = FALSE + "because output video file ", + "exists and 'overwrite = ", + "FALSE'.", + call. = FALSE ) } - + # Convert proc_obj and recs dataframes into data.table objects work_proc_obj <- data.table::as.data.table(proc_obj) - + # make column to identify original row to join with option plot arguments work_proc_obj[, row_in := 1:.N] - - + + # capture optional plot arguments passed via ellipses # and add original row indices to join on both inargs <- list(...) # set defaults and apply if needed rcv_args <- list(pch = 16, cex = 1.5) dtc_args <- list(pch = 16, col = "blue", cex = 2) - + # identify and subset par arguments par_inargs <- inargs[grepl("^par\\.", names(inargs))] # temporary # identify and subset receiver point arguments @@ -266,7 +266,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), timeline_inargs <- inargs[grepl("^timeline\\.", names(inargs))] # identify and subset timeslider arguments timeslider_inargs <- inargs[grepl("^timeslider\\.", names(inargs))] - + # identify dtc input arguments dtc_inarg_names <- setdiff(names(inargs), c( names(par_inargs), @@ -274,7 +274,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), names(timeline_inargs), names(timeslider_inargs) )) - + # identify and subset detection point arguments dtc_inargs <- inargs[dtc_inarg_names] # strip argument names @@ -282,12 +282,12 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), names(timeline_inargs) <- gsub("^timeline\\.", "", names(timeline_inargs)) names(timeslider_inargs) <- gsub("^timeslider\\.", "", names(timeslider_inargs)) names(rcv_inargs) <- gsub("^recs\\.", "", names(rcv_inargs)) - + # update from ... if (length(rcv_inargs) > 0) rcv_args[names(rcv_inargs)] <- rcv_inargs # update from ... if (length(dtc_inargs) > 0) dtc_args[names(dtc_inargs)] <- dtc_inargs - + # expand single rcv_args elements to equal number of rows in recs if (!is.null(recs)) { for (i in 1:length(rcv_args)) { @@ -301,7 +301,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), } } } - + # expand single dtc_args elements to equal number of rows in work_proc_obj for (i in 1:length(dtc_args)) { if (length(dtc_args[[i]]) == 1) { @@ -313,21 +313,21 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), )) } } - + # coerce to data.table and add original row index (for join to recs) rcv_args <- data.table::as.data.table(rcv_args) rcv_args[, row_in := 1:.N] dtc_args <- data.table::as.data.table(dtc_args) dtc_args[, row_in := 1:.N] - - + + # set recs to data.table and remove receivers not recovered if (!is.null(recs)) { recs <- data.table::as.data.table(recs) - + # make column to identify original row to join with option plot arguments recs[, row_in := 1:.N] - + # Remove receivers not recovered (records with NA in recover_date_time) data.table::setkey(recs, recover_date_time) recs <- recs[!list(NA_real_), c( @@ -336,15 +336,15 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), "recover_date_time", "row_in" )] } - - + + # Make output directory if it does not already exist if (!dir.exists(out_dir)) dir.create(out_dir) - + # extract time sequence for plotting t_seq <- unique(work_proc_obj$bin_timestamp) - - + + # make tails if needed if (tail_dur == 0) { # Create group identifier for plotting @@ -353,22 +353,22 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # make tail groups if needed dur <- work_proc_obj[, .(t_seq = sort(unique(bin_timestamp)))] dur[, c("t_end", "t_grp") := - list( - data.table::shift(t_seq, - type = "lag", - fill = min(t_seq), n = tail_dur - ), - 1:nrow(dur) - )] - + list( + data.table::shift(t_seq, + type = "lag", + fill = min(t_seq), n = tail_dur + ), + 1:nrow(dur) + )] + # group obs for tails work_proc_obj[, t_end := bin_timestamp] data.table::setkey(dur, t_end, t_seq) - + # merge by overlap work_proc_obj <- data.table::foverlaps(work_proc_obj, dur, - type = "within", - nomatch = 0L, by.x = c("bin_timestamp", "t_end") + type = "within", + nomatch = 0L, by.x = c("bin_timestamp", "t_end") ) work_proc_obj <- work_proc_obj[, c( "animal_id", "t_seq", "latitude", @@ -380,78 +380,79 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), )) work_proc_obj[, grp := bin_timestamp] } - + # set rows in time order data.table::setorder(work_proc_obj, bin_timestamp) - + # create num group for later work_proc_obj[, grp_num := .GRP, by = bin_timestamp] - + # determine leading zeros needed by ffmpeg and add as new column char <- paste0("%", 0, nchar((length(t_seq))), "d") data.table::setkey(work_proc_obj, bin_timestamp) work_proc_obj[, f_name := .GRP, by = grp] work_proc_obj[, f_name := paste0(sprintf(char, f_name), ".png")] - + # order data for plotting data.table::setkey(work_proc_obj, bin_timestamp, animal_id, record_type) - + # Load background (use example Great Lakes if null) if (is.null(bg_map)) { - background <- utils::data("great_lakes_polygon", envir = environment()) # example in glatos package + utils::data("great_lakes_polygon", envir = environment()) # example in glatos package + background <- great_lakes_polygon } else { background <- bg_map - + # convert to sf if sp::Spatial object if (inherits(background, "Spatial")) { background <- sf::st_as_sf(background) message("Converted sp object to sf") } - + # convert to sf if map is terra::SpatVector object if (inherits(background, "SpatVector")) { background <- sf::st_as_sf(background) message("Converted terra object to sf") } - + # convert to WGS 84 (EPSG 4326) if (sf::st_crs(background)$epsg != 4326) { background <- sf::st_transform(background, 4326) message("Converted background to long/lat (epsg: 4326) CRS") } - + # if x and y limits are equal to default, then set limits to extent of bg_map # if x and y limits are not equal to default, then leave as specified in input arguments. if (missing(background_ylim) | all(background_ylim == c(41.3, 49.0))) { background_ylim <- as.numeric(sf::st_bbox(bg_map)[c("ymin", "ymax")]) } - + if (missing(background_xlim) | all(background_xlim == c(-92.45, -75.87))) { background_xlim <- as.numeric(sf::st_bbox(bg_map)[c("xmin", "xmax")]) } } - + # turn off interpolated points if show_interpolated = FALSE if (!show_interpolated) { work_proc_obj[record_type == "interpolated", latitude := NA] work_proc_obj[record_type == "interpolated", longitude := NA] } - + # Calculate the duration of the animation for timeline time_period <- range(work_proc_obj$bin_timestamp) - + # define custom plot function cust_plot <- function(x, .time_period, .recs, .out_dir, .background, .background_xlim, .background_ylim) { # Calculate great circle distance in meters of x and y limits. # needed to determine aspect ratio of the output - + # old version, new below, needs tested # linear_x = geosphere::distMeeus(c(.background_xlim[1], .background_ylim[1]), # c(.background_xlim[2], .background_ylim[1])) # linear_y = geosphere::distMeeus(c(.background_xlim[1], .background_ylim[1]), # c(.background_xlim[1], .background_ylim[2])) - + linear_x <- geodist::geodist_vec( x1 = .background_xlim[1], y1 = .background_ylim[1], @@ -459,7 +460,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), y2 = .background_ylim[1], measure = "haversine" ) - + linear_y <- geodist::geodist_vec( x1 = .background_xlim[1], y1 = .background_ylim[1], @@ -467,58 +468,58 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), y2 = .background_ylim[2], measure = "haversine" ) - + # aspect ratio of image figRatio <- linear_y / linear_x - + # calculate image height based on aspect ratio height <- trunc(2000 * figRatio) - + # plot GL outline and movement points png(file.path(.out_dir, x$f_name[1]), - width = 2000, - height = ifelse(height %% 2 == 0, height, height + 1), units = "px", - pointsize = 22 * figRatio + width = 2000, + height = ifelse(height %% 2 == 0, height, height + 1), units = "px", + pointsize = 22 * figRatio ) - + # Plot background image # Set bottom margin to plot timeline outside of plot window - + # set defaults and apply if needed par_args <- list(oma = c(0, 0, 0, 0), mar = c(6, 0, 0, 0), xpd = FALSE) # update from defaults... if (length(par_inargs) > 0) par_args[names(par_inargs)] <- par_inargs - + do.call(par, par_args) - + # Note this call was changed to sf? plot(sf::st_geometry(.background), - ylim = c(.background_ylim), - xlim = c(.background_xlim), - axes = FALSE, lwd = 2 * figRatio, col = "white", bg = "gray74" + ylim = c(.background_ylim), + xlim = c(.background_xlim), + axes = FALSE, lwd = 2 * figRatio, col = "white", bg = "gray74" ) - + box(lwd = 3 * figRatio) - + # Add receiver locations if (!is.null(.recs)) { # extract receivers in the water during plot interval sub_recs <- .recs[deploy_date_time <= x$bin_timestamp[1] & - (recover_date_time >= x$bin_timestamp[1] & !is.na(recover_date_time))] - + (recover_date_time >= x$bin_timestamp[1] & !is.na(recover_date_time))] + # get optional plot arguments that correspond with sub_recs sub_rcv_args <- rcv_args[match(sub_recs$row_in, rcv_args$row_in), ] - + # plot receivers; not do.call to include optional input arguments do.call(points, c( list(x = sub_recs$deploy_long, y = sub_recs$deploy_lat), sub_rcv_args[, !"row_in", with = FALSE] )) } - + # Add timeline par(xpd = TRUE) - + # Define timeline x and y location xlim_diff <- diff(.background_xlim) ylim_diff <- diff(.background_ylim) @@ -527,18 +528,18 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), .background_xlim[1] + (0.10 * xlim_diff), .background_xlim[2] - (0.10 * xlim_diff) ) - + time_dur <- diff(as.numeric(.time_period)) - + # Add labels to timeline labels <- seq(as.POSIXct(format(min(.time_period), "%Y-%m-%d")), - as.POSIXct(format(max(.time_period), "%Y-%m-%d")), - length.out = 5 + as.POSIXct(format(max(.time_period), "%Y-%m-%d")), + length.out = 5 ) labels_ticks <- as.POSIXct(format(labels, "%Y-%m-%d"), tz = "GMT") ptime <- (as.numeric(labels_ticks) - as.numeric(min(.time_period))) / time_dur labels_x <- timeline_x[1] + (diff(timeline_x) * ptime) - + # set defaults and apply if needed timeline_args <- list( side = 1, at = labels_x, pos = timeline_y[1], @@ -546,57 +547,57 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), lwd = 20 * figRatio, lend = 0, lwd.ticks = NA, col.ticks = 1, cex.axis = 2, padj = 0.5 ) - + # update from ... if (length(timeline_inargs) > 0) { timeline_args[names(timeline_inargs)] <- timeline_inargs } - + do.call(axis, timeline_args) - - + + # Update timeline ptime <- (as.numeric(x[1, "grp"]) - as.numeric(min(.time_period))) / time_dur - + # Proportion of timeline elapsed timeline_x_i <- timeline_x[1] + diff(timeline_x) * ptime - + # set defaults and apply if needed timeslider_args <- list( pch = 21, cex = 2, bg = "grey40", col = "grey20", lwd = 1 ) - + # update from ... if (length(timeslider_inargs) > 0) { timeslider_args[names(timeslider_inargs)] <- timeslider_inargs } - + # Plot slider along timeline at appropriate location do.call(points, c( list(x = timeline_x_i, y = timeline_args$pos), timeslider_args )) - - + + # Add fish positions # get optional plot arguments that correspond with x sub_dtc_args <- dtc_args[match(x$row_in, dtc_args$row_in), ] - + do.call(points, c( list(x = x$longitude, y = x$latitude), sub_dtc_args[, !"row_in", with = FALSE] )) - + dev.off() } - + # order for plotting data.table::setkey(work_proc_obj, grp_num) - - + + if (preview) { grpn <- 1 } else { @@ -604,37 +605,37 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), grpn <- data.table::uniqueN(work_proc_obj$grp) if (show_progress) pb <- txtProgressBar(min = 0, max = grpn, style = 3) } - + # call cust_plot witin data.table work_proc_obj[grp_num <= grpn, - { - if (!preview & show_progress) setTxtProgressBar(pb, .GRP) - cust_plot( - x = .SD, - .time_period = time_period, - .recs = recs, - .out_dir = out_dir, - .background = background, - .background_xlim = background_xlim, - .background_ylim = background_ylim - ) - }, - by = grp, - .SDcols = c( - "bin_timestamp", "longitude", "latitude", - "record_type", "f_name", "grp", "row_in" - ) + { + if (!preview & show_progress) setTxtProgressBar(pb, .GRP) + cust_plot( + x = .SD, + .time_period = time_period, + .recs = recs, + .out_dir = out_dir, + .background = background, + .background_xlim = background_xlim, + .background_ylim = background_ylim + ) + }, + by = grp, + .SDcols = c( + "bin_timestamp", "longitude", "latitude", + "record_type", "f_name", "grp", "row_in" + ) ] - + if (preview) { message("Preview frames written to\n ", out_dir) } else { if (show_progress) close(pb) - + if (animate) { make_video(input_dir = out_dir, output = ani_name, overwrite = overwrite) } - + if (frame_delete) { unlink(file.path(out_dir, unique(work_proc_obj$f_name))) } else { From f885ff29450c1cfe2dbd4418443b724a064a603d Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 18:58:25 +0000 Subject: [PATCH 35/56] Style code (GHA) --- R/vis-make_frames.r | 230 ++++++++++++++++++++++---------------------- 1 file changed, 115 insertions(+), 115 deletions(-) diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 79bcf71e..c0590b00 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -214,12 +214,12 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), overwrite = FALSE, preview = FALSE, bg_map = NULL, show_progress = TRUE, ...) { # NOTE: As of glatos v 0.4.1, the package no longer uses the external program ffmpeg. Input argument 'ffmpeg' has been removed" - + # Declare global variables for NSE & R CMD check row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- f_name <- animal_id <- record_type <- latitude <- longitude <- deploy_date_time <- NULL - + # expand path to animation output file # - place in same file as images (out_dir) if none specified # - preserve "./" prefix if specified @@ -233,31 +233,31 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), if (!contains_dir) ani_name <- file.path(out_dir, ani_name) } } - + # if overwrite = FALSE, check if animation output file exists if (!overwrite & file.exists(ani_name)) { stop("Operation aborted ", - "because output video file ", - "exists and 'overwrite = ", - "FALSE'.", - call. = FALSE + "because output video file ", + "exists and 'overwrite = ", + "FALSE'.", + call. = FALSE ) } - + # Convert proc_obj and recs dataframes into data.table objects work_proc_obj <- data.table::as.data.table(proc_obj) - + # make column to identify original row to join with option plot arguments work_proc_obj[, row_in := 1:.N] - - + + # capture optional plot arguments passed via ellipses # and add original row indices to join on both inargs <- list(...) # set defaults and apply if needed rcv_args <- list(pch = 16, cex = 1.5) dtc_args <- list(pch = 16, col = "blue", cex = 2) - + # identify and subset par arguments par_inargs <- inargs[grepl("^par\\.", names(inargs))] # temporary # identify and subset receiver point arguments @@ -266,7 +266,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), timeline_inargs <- inargs[grepl("^timeline\\.", names(inargs))] # identify and subset timeslider arguments timeslider_inargs <- inargs[grepl("^timeslider\\.", names(inargs))] - + # identify dtc input arguments dtc_inarg_names <- setdiff(names(inargs), c( names(par_inargs), @@ -274,7 +274,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), names(timeline_inargs), names(timeslider_inargs) )) - + # identify and subset detection point arguments dtc_inargs <- inargs[dtc_inarg_names] # strip argument names @@ -282,12 +282,12 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), names(timeline_inargs) <- gsub("^timeline\\.", "", names(timeline_inargs)) names(timeslider_inargs) <- gsub("^timeslider\\.", "", names(timeslider_inargs)) names(rcv_inargs) <- gsub("^recs\\.", "", names(rcv_inargs)) - + # update from ... if (length(rcv_inargs) > 0) rcv_args[names(rcv_inargs)] <- rcv_inargs # update from ... if (length(dtc_inargs) > 0) dtc_args[names(dtc_inargs)] <- dtc_inargs - + # expand single rcv_args elements to equal number of rows in recs if (!is.null(recs)) { for (i in 1:length(rcv_args)) { @@ -301,7 +301,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), } } } - + # expand single dtc_args elements to equal number of rows in work_proc_obj for (i in 1:length(dtc_args)) { if (length(dtc_args[[i]]) == 1) { @@ -313,21 +313,21 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), )) } } - + # coerce to data.table and add original row index (for join to recs) rcv_args <- data.table::as.data.table(rcv_args) rcv_args[, row_in := 1:.N] dtc_args <- data.table::as.data.table(dtc_args) dtc_args[, row_in := 1:.N] - - + + # set recs to data.table and remove receivers not recovered if (!is.null(recs)) { recs <- data.table::as.data.table(recs) - + # make column to identify original row to join with option plot arguments recs[, row_in := 1:.N] - + # Remove receivers not recovered (records with NA in recover_date_time) data.table::setkey(recs, recover_date_time) recs <- recs[!list(NA_real_), c( @@ -336,15 +336,15 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), "recover_date_time", "row_in" )] } - - + + # Make output directory if it does not already exist if (!dir.exists(out_dir)) dir.create(out_dir) - + # extract time sequence for plotting t_seq <- unique(work_proc_obj$bin_timestamp) - - + + # make tails if needed if (tail_dur == 0) { # Create group identifier for plotting @@ -353,22 +353,22 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # make tail groups if needed dur <- work_proc_obj[, .(t_seq = sort(unique(bin_timestamp)))] dur[, c("t_end", "t_grp") := - list( - data.table::shift(t_seq, - type = "lag", - fill = min(t_seq), n = tail_dur - ), - 1:nrow(dur) - )] - + list( + data.table::shift(t_seq, + type = "lag", + fill = min(t_seq), n = tail_dur + ), + 1:nrow(dur) + )] + # group obs for tails work_proc_obj[, t_end := bin_timestamp] data.table::setkey(dur, t_end, t_seq) - + # merge by overlap work_proc_obj <- data.table::foverlaps(work_proc_obj, dur, - type = "within", - nomatch = 0L, by.x = c("bin_timestamp", "t_end") + type = "within", + nomatch = 0L, by.x = c("bin_timestamp", "t_end") ) work_proc_obj <- work_proc_obj[, c( "animal_id", "t_seq", "latitude", @@ -380,79 +380,79 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), )) work_proc_obj[, grp := bin_timestamp] } - + # set rows in time order data.table::setorder(work_proc_obj, bin_timestamp) - + # create num group for later work_proc_obj[, grp_num := .GRP, by = bin_timestamp] - + # determine leading zeros needed by ffmpeg and add as new column char <- paste0("%", 0, nchar((length(t_seq))), "d") data.table::setkey(work_proc_obj, bin_timestamp) work_proc_obj[, f_name := .GRP, by = grp] work_proc_obj[, f_name := paste0(sprintf(char, f_name), ".png")] - + # order data for plotting data.table::setkey(work_proc_obj, bin_timestamp, animal_id, record_type) - + # Load background (use example Great Lakes if null) if (is.null(bg_map)) { utils::data("great_lakes_polygon", envir = environment()) # example in glatos package background <- great_lakes_polygon } else { background <- bg_map - + # convert to sf if sp::Spatial object if (inherits(background, "Spatial")) { background <- sf::st_as_sf(background) message("Converted sp object to sf") } - + # convert to sf if map is terra::SpatVector object if (inherits(background, "SpatVector")) { background <- sf::st_as_sf(background) message("Converted terra object to sf") } - + # convert to WGS 84 (EPSG 4326) if (sf::st_crs(background)$epsg != 4326) { background <- sf::st_transform(background, 4326) message("Converted background to long/lat (epsg: 4326) CRS") } - + # if x and y limits are equal to default, then set limits to extent of bg_map # if x and y limits are not equal to default, then leave as specified in input arguments. if (missing(background_ylim) | all(background_ylim == c(41.3, 49.0))) { background_ylim <- as.numeric(sf::st_bbox(bg_map)[c("ymin", "ymax")]) } - + if (missing(background_xlim) | all(background_xlim == c(-92.45, -75.87))) { background_xlim <- as.numeric(sf::st_bbox(bg_map)[c("xmin", "xmax")]) } } - + # turn off interpolated points if show_interpolated = FALSE if (!show_interpolated) { work_proc_obj[record_type == "interpolated", latitude := NA] work_proc_obj[record_type == "interpolated", longitude := NA] } - + # Calculate the duration of the animation for timeline time_period <- range(work_proc_obj$bin_timestamp) - + # define custom plot function cust_plot <- function(x, .time_period, .recs, .out_dir, .background, .background_xlim, .background_ylim) { # Calculate great circle distance in meters of x and y limits. # needed to determine aspect ratio of the output - + # old version, new below, needs tested # linear_x = geosphere::distMeeus(c(.background_xlim[1], .background_ylim[1]), # c(.background_xlim[2], .background_ylim[1])) # linear_y = geosphere::distMeeus(c(.background_xlim[1], .background_ylim[1]), # c(.background_xlim[1], .background_ylim[2])) - + linear_x <- geodist::geodist_vec( x1 = .background_xlim[1], y1 = .background_ylim[1], @@ -460,7 +460,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), y2 = .background_ylim[1], measure = "haversine" ) - + linear_y <- geodist::geodist_vec( x1 = .background_xlim[1], y1 = .background_ylim[1], @@ -468,58 +468,58 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), y2 = .background_ylim[2], measure = "haversine" ) - + # aspect ratio of image figRatio <- linear_y / linear_x - + # calculate image height based on aspect ratio height <- trunc(2000 * figRatio) - + # plot GL outline and movement points png(file.path(.out_dir, x$f_name[1]), - width = 2000, - height = ifelse(height %% 2 == 0, height, height + 1), units = "px", - pointsize = 22 * figRatio + width = 2000, + height = ifelse(height %% 2 == 0, height, height + 1), units = "px", + pointsize = 22 * figRatio ) - + # Plot background image # Set bottom margin to plot timeline outside of plot window - + # set defaults and apply if needed par_args <- list(oma = c(0, 0, 0, 0), mar = c(6, 0, 0, 0), xpd = FALSE) # update from defaults... if (length(par_inargs) > 0) par_args[names(par_inargs)] <- par_inargs - + do.call(par, par_args) - + # Note this call was changed to sf? plot(sf::st_geometry(.background), - ylim = c(.background_ylim), - xlim = c(.background_xlim), - axes = FALSE, lwd = 2 * figRatio, col = "white", bg = "gray74" + ylim = c(.background_ylim), + xlim = c(.background_xlim), + axes = FALSE, lwd = 2 * figRatio, col = "white", bg = "gray74" ) - + box(lwd = 3 * figRatio) - + # Add receiver locations if (!is.null(.recs)) { # extract receivers in the water during plot interval sub_recs <- .recs[deploy_date_time <= x$bin_timestamp[1] & - (recover_date_time >= x$bin_timestamp[1] & !is.na(recover_date_time))] - + (recover_date_time >= x$bin_timestamp[1] & !is.na(recover_date_time))] + # get optional plot arguments that correspond with sub_recs sub_rcv_args <- rcv_args[match(sub_recs$row_in, rcv_args$row_in), ] - + # plot receivers; not do.call to include optional input arguments do.call(points, c( list(x = sub_recs$deploy_long, y = sub_recs$deploy_lat), sub_rcv_args[, !"row_in", with = FALSE] )) } - + # Add timeline par(xpd = TRUE) - + # Define timeline x and y location xlim_diff <- diff(.background_xlim) ylim_diff <- diff(.background_ylim) @@ -528,18 +528,18 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), .background_xlim[1] + (0.10 * xlim_diff), .background_xlim[2] - (0.10 * xlim_diff) ) - + time_dur <- diff(as.numeric(.time_period)) - + # Add labels to timeline labels <- seq(as.POSIXct(format(min(.time_period), "%Y-%m-%d")), - as.POSIXct(format(max(.time_period), "%Y-%m-%d")), - length.out = 5 + as.POSIXct(format(max(.time_period), "%Y-%m-%d")), + length.out = 5 ) labels_ticks <- as.POSIXct(format(labels, "%Y-%m-%d"), tz = "GMT") ptime <- (as.numeric(labels_ticks) - as.numeric(min(.time_period))) / time_dur labels_x <- timeline_x[1] + (diff(timeline_x) * ptime) - + # set defaults and apply if needed timeline_args <- list( side = 1, at = labels_x, pos = timeline_y[1], @@ -547,57 +547,57 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), lwd = 20 * figRatio, lend = 0, lwd.ticks = NA, col.ticks = 1, cex.axis = 2, padj = 0.5 ) - + # update from ... if (length(timeline_inargs) > 0) { timeline_args[names(timeline_inargs)] <- timeline_inargs } - + do.call(axis, timeline_args) - - + + # Update timeline ptime <- (as.numeric(x[1, "grp"]) - as.numeric(min(.time_period))) / time_dur - + # Proportion of timeline elapsed timeline_x_i <- timeline_x[1] + diff(timeline_x) * ptime - + # set defaults and apply if needed timeslider_args <- list( pch = 21, cex = 2, bg = "grey40", col = "grey20", lwd = 1 ) - + # update from ... if (length(timeslider_inargs) > 0) { timeslider_args[names(timeslider_inargs)] <- timeslider_inargs } - + # Plot slider along timeline at appropriate location do.call(points, c( list(x = timeline_x_i, y = timeline_args$pos), timeslider_args )) - - + + # Add fish positions # get optional plot arguments that correspond with x sub_dtc_args <- dtc_args[match(x$row_in, dtc_args$row_in), ] - + do.call(points, c( list(x = x$longitude, y = x$latitude), sub_dtc_args[, !"row_in", with = FALSE] )) - + dev.off() } - + # order for plotting data.table::setkey(work_proc_obj, grp_num) - - + + if (preview) { grpn <- 1 } else { @@ -605,37 +605,37 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), grpn <- data.table::uniqueN(work_proc_obj$grp) if (show_progress) pb <- txtProgressBar(min = 0, max = grpn, style = 3) } - + # call cust_plot witin data.table work_proc_obj[grp_num <= grpn, - { - if (!preview & show_progress) setTxtProgressBar(pb, .GRP) - cust_plot( - x = .SD, - .time_period = time_period, - .recs = recs, - .out_dir = out_dir, - .background = background, - .background_xlim = background_xlim, - .background_ylim = background_ylim - ) - }, - by = grp, - .SDcols = c( - "bin_timestamp", "longitude", "latitude", - "record_type", "f_name", "grp", "row_in" - ) + { + if (!preview & show_progress) setTxtProgressBar(pb, .GRP) + cust_plot( + x = .SD, + .time_period = time_period, + .recs = recs, + .out_dir = out_dir, + .background = background, + .background_xlim = background_xlim, + .background_ylim = background_ylim + ) + }, + by = grp, + .SDcols = c( + "bin_timestamp", "longitude", "latitude", + "record_type", "f_name", "grp", "row_in" + ) ] - + if (preview) { message("Preview frames written to\n ", out_dir) } else { if (show_progress) close(pb) - + if (animate) { make_video(input_dir = out_dir, output = ani_name, overwrite = overwrite) } - + if (frame_delete) { unlink(file.path(out_dir, unique(work_proc_obj$f_name))) } else { From d8073d9bd6ce1e58fe4fcf9e90b2f7bb37172013 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 15:18:26 -0400 Subject: [PATCH 36/56] fix introduced utils::data bug --- R/vis-detection_bubble_plot.r | 118 ++++++++++++++++++---------------- R/vis-make_frames.r | 7 +- 2 files changed, 67 insertions(+), 58 deletions(-) diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index 4bae67aa..33b8d7b7 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -123,6 +123,10 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", symbol_radius = 1, col_grad = c("white", "red"), scale_loc = NULL) { + + # Declare global variables for NSE & R CMD check + great_lakes_polygon <- NULL + # Check that the specified columns appear in the det data frame missingCols <- setdiff( c( @@ -136,54 +140,58 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", paste0( "det is missing the following ", "column(s):\n", paste0(" '", missingCols, "'", - collapse = "\n" + collapse = "\n" ) ), call. = FALSE ) } - - + + # convert sp to sf if (!is.null(map) & inherits(map, "Spatial")) { map <- sf::st_as_sf(map) message("Converted sp object to sf") } - + # convert terra::SpatVector to sf if (!is.null(map) & inherits(map, "SpatVector")) { map <- sf::st_as_sf(map) message("Converted terra SpatVector to sf") } - + # Check CRS == 4326 and attempt conversion if not if (!is.null(map) & sf::st_crs(map)$input != "EPSG:4326") { map <- sf::st_transform(map, 4326) message("Converted map to EPSG:4326") } - - if (is.null(map)) map <- utils::data("great_lakes_polygon", envir = environment()) # example in glatos package (sf object) - + + if (is.null(map)) { + data("great_lakes_polygon", envir = environment()) + map <- great_lakes_polygon + rm(great_lakes_polygon) + } # example in glatos package (sf object) + # Check that timestamp is of class 'POSIXct' if (!("POSIXct" %in% class(det$detection_timestamp_utc))) { stop(paste0("Column detection_timestamp_utc in det data frame must be of class 'POSIXct'."), - call. = FALSE + call. = FALSE ) } - + # Call glatos::detection_summary to create summary data. det_summ <- glatos::summarize_detections(det, - location_col = location_col, - receiver_locs = receiver_locs, - summ_type = "location" + location_col = location_col, + receiver_locs = receiver_locs, + summ_type = "location" ) - + # Re-order the summaries so that sites with detections plot on top of sites # without. Makes it easier to see detected locations when they are close # enough together that the bubbles overlap det_summ <- det_summ[order(det_summ$num_fish), ] - + # Create labs with degrees symbol for plots xlabs <- round(seq( from = background_xlim[1], to = background_xlim[2], @@ -193,10 +201,10 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", from = background_ylim[1], to = background_ylim[2], length.out = 5 ), 2) - + # Define the color palette used to color-code the bubbles color <- c(colorRampPalette(col_grad)(101)) - + # Calculate great circle distance in meters of x and y limits. # needed to determine aspect ratio of the output linear_x <- geodist::geodist_vec( @@ -207,21 +215,21 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", x1 = background_xlim[1], y1 = background_ylim[1], x2 = background_xlim[1], y2 = background_ylim[2], measure = "haversine" ) - + # aspect ratio of image figRatio <- linear_y / linear_x - + # get file extension file_type <- ifelse(is.null(out_file), NA, tools::file_ext(out_file)) - + # check file extension is supported ext_supp <- c(NA, "png", "jpeg", "png", "bmp", "tiff") if (!(tolower(file_type) %in% ext_supp)) { stop(paste0("Image type '", file_type, "' is not supported."), - call. = FALSE + call. = FALSE ) } - + if (!is.na(file_type) & tolower(file_type) == "png") { png(out_file, height = 1000 * figRatio, width = 1000, pointsize = 28) } @@ -234,45 +242,45 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", if (!is.na(file_type) & tolower(file_type) == "tiff") { tiff(out_file, height = 1000 * figRatio, width = 1000, pointsize = 28) } - + if (is.null(out_file)) { dev.new(noRStudioGD = TRUE, height = 7 * figRatio, width = 7) } - + # Set margins par(mar = c(1, 0, 0, 2), oma = c(3, 5, 1, 0)) - + # Plot background image plot(sf::st_geometry(map), - xlim = background_xlim, ylim = background_ylim, axes = T, - xaxs = "i", lwd = 1.5, xaxt = "n", yaxt = "n", col = "White", - bg = "WhiteSmoke" + xlim = background_xlim, ylim = background_ylim, axes = T, + xaxs = "i", lwd = 1.5, xaxt = "n", yaxt = "n", col = "White", + bg = "WhiteSmoke" ) - + # Plot the bubbles symbols(det_summ$mean_lon, det_summ$mean_lat, - circles = rep( - (background_xlim[2] - - background_xlim[1]) * symbol_radius / 100, - length(det_summ$mean_lon) - ), - add = T, inches = FALSE, - bg = color[round(det_summ$num_fish - / max(det_summ$num_fish) * 100, 0) + 1], - fg = "black", lwd = 3 + circles = rep( + (background_xlim[2] - + background_xlim[1]) * symbol_radius / 100, + length(det_summ$mean_lon) + ), + add = T, inches = FALSE, + bg = color[round(det_summ$num_fish + / max(det_summ$num_fish) * 100, 0) + 1], + fg = "black", lwd = 3 ) - + # Add 'X' to bubbles with no detections if (any(det_summ$num_fish == 0)) { with( det_summ[det_summ$num_fish == 0, ], text(mean_lon, mean_lat, - "X", - cex = 0.6 * symbol_radius + "X", + cex = 0.6 * symbol_radius ) ) } - + if (is.null(scale_loc)) { # Calculate the location to plot the color scale scale_loc <- c( @@ -285,34 +293,34 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", # Add color legend # explore options for doing this without an extra plotrix package https://stackoverflow.com/questions/13355176/gradient-legend-in-base plotrix::color.legend(scale_loc[1], scale_loc[2], scale_loc[3], scale_loc[4], - paste0(" ", round( - seq(from = 1, to = max(det_summ$num_fish), length.out = 6), - 0 - )), color, - gradient = "y", family = "sans", cex = 0.75, align = "rb" + paste0(" ", round( + seq(from = 1, to = max(det_summ$num_fish), length.out = 6), + 0 + )), color, + gradient = "y", family = "sans", cex = 0.75, align = "rb" ) - + # Add x-axis and title axis(1, at = xlabs, labels = paste0(format(xlabs, 4), intToUtf8(176)), cex.axis = 1) mtext("Longitude", side = 1, line = 2.5, cex = 1) - + # Add y-axis and title axis(2, - at = ylabs, labels = paste0(format(ylabs, 4), intToUtf8(176)), cex.axis = 1, - las = 1 + at = ylabs, labels = paste0(format(ylabs, 4), intToUtf8(176)), cex.axis = 1, + las = 1 ) mtext("Latitude", side = 2, line = 4, cex = 1) - + box() - + if (!is.na(file_type)) dev.off() # Close plot device - + if (!is.na(file_type)) { message(paste0( "Image files were written to the following directory:\n", getwd(), "\n" )) } - + return(det_summ) } diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 79bcf71e..8a36c2fa 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -218,7 +218,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # Declare global variables for NSE & R CMD check row_in <- recover_date_time <- grp <- bin_timestamp <- t_end <- grp_num <- f_name <- animal_id <- record_type <- latitude <- longitude <- - deploy_date_time <- NULL + deploy_date_time <- great_lakes_polygon <- NULL # expand path to animation output file # - place in same file as images (out_dir) if none specified @@ -397,9 +397,10 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), data.table::setkey(work_proc_obj, bin_timestamp, animal_id, record_type) # Load background (use example Great Lakes if null) - if (is.null(bg_map)) { - utils::data("great_lakes_polygon", envir = environment()) # example in glatos package + if (is.null(bg_map)) { # example in glatos package + utils::data("great_lakes_polygon", envir = environment()) background <- great_lakes_polygon + rm(great_lakes_polygon) } else { background <- bg_map From ab22ef932319b1e406d5f1d4a23e7d6f60a283d0 Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 19:22:23 +0000 Subject: [PATCH 37/56] Style code (GHA) --- R/vis-detection_bubble_plot.r | 111 +++++++++++++++++----------------- R/vis-make_frames.r | 2 +- 2 files changed, 56 insertions(+), 57 deletions(-) diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index 33b8d7b7..60d4f26f 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -123,10 +123,9 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", symbol_radius = 1, col_grad = c("white", "red"), scale_loc = NULL) { - # Declare global variables for NSE & R CMD check great_lakes_polygon <- NULL - + # Check that the specified columns appear in the det data frame missingCols <- setdiff( c( @@ -140,58 +139,58 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", paste0( "det is missing the following ", "column(s):\n", paste0(" '", missingCols, "'", - collapse = "\n" + collapse = "\n" ) ), call. = FALSE ) } - - + + # convert sp to sf if (!is.null(map) & inherits(map, "Spatial")) { map <- sf::st_as_sf(map) message("Converted sp object to sf") } - + # convert terra::SpatVector to sf if (!is.null(map) & inherits(map, "SpatVector")) { map <- sf::st_as_sf(map) message("Converted terra SpatVector to sf") } - + # Check CRS == 4326 and attempt conversion if not if (!is.null(map) & sf::st_crs(map)$input != "EPSG:4326") { map <- sf::st_transform(map, 4326) message("Converted map to EPSG:4326") } - + if (is.null(map)) { data("great_lakes_polygon", envir = environment()) map <- great_lakes_polygon rm(great_lakes_polygon) } # example in glatos package (sf object) - + # Check that timestamp is of class 'POSIXct' if (!("POSIXct" %in% class(det$detection_timestamp_utc))) { stop(paste0("Column detection_timestamp_utc in det data frame must be of class 'POSIXct'."), - call. = FALSE + call. = FALSE ) } - + # Call glatos::detection_summary to create summary data. det_summ <- glatos::summarize_detections(det, - location_col = location_col, - receiver_locs = receiver_locs, - summ_type = "location" + location_col = location_col, + receiver_locs = receiver_locs, + summ_type = "location" ) - + # Re-order the summaries so that sites with detections plot on top of sites # without. Makes it easier to see detected locations when they are close # enough together that the bubbles overlap det_summ <- det_summ[order(det_summ$num_fish), ] - + # Create labs with degrees symbol for plots xlabs <- round(seq( from = background_xlim[1], to = background_xlim[2], @@ -201,10 +200,10 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", from = background_ylim[1], to = background_ylim[2], length.out = 5 ), 2) - + # Define the color palette used to color-code the bubbles color <- c(colorRampPalette(col_grad)(101)) - + # Calculate great circle distance in meters of x and y limits. # needed to determine aspect ratio of the output linear_x <- geodist::geodist_vec( @@ -215,21 +214,21 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", x1 = background_xlim[1], y1 = background_ylim[1], x2 = background_xlim[1], y2 = background_ylim[2], measure = "haversine" ) - + # aspect ratio of image figRatio <- linear_y / linear_x - + # get file extension file_type <- ifelse(is.null(out_file), NA, tools::file_ext(out_file)) - + # check file extension is supported ext_supp <- c(NA, "png", "jpeg", "png", "bmp", "tiff") if (!(tolower(file_type) %in% ext_supp)) { stop(paste0("Image type '", file_type, "' is not supported."), - call. = FALSE + call. = FALSE ) } - + if (!is.na(file_type) & tolower(file_type) == "png") { png(out_file, height = 1000 * figRatio, width = 1000, pointsize = 28) } @@ -242,45 +241,45 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", if (!is.na(file_type) & tolower(file_type) == "tiff") { tiff(out_file, height = 1000 * figRatio, width = 1000, pointsize = 28) } - + if (is.null(out_file)) { dev.new(noRStudioGD = TRUE, height = 7 * figRatio, width = 7) } - + # Set margins par(mar = c(1, 0, 0, 2), oma = c(3, 5, 1, 0)) - + # Plot background image plot(sf::st_geometry(map), - xlim = background_xlim, ylim = background_ylim, axes = T, - xaxs = "i", lwd = 1.5, xaxt = "n", yaxt = "n", col = "White", - bg = "WhiteSmoke" + xlim = background_xlim, ylim = background_ylim, axes = T, + xaxs = "i", lwd = 1.5, xaxt = "n", yaxt = "n", col = "White", + bg = "WhiteSmoke" ) - + # Plot the bubbles symbols(det_summ$mean_lon, det_summ$mean_lat, - circles = rep( - (background_xlim[2] - - background_xlim[1]) * symbol_radius / 100, - length(det_summ$mean_lon) - ), - add = T, inches = FALSE, - bg = color[round(det_summ$num_fish - / max(det_summ$num_fish) * 100, 0) + 1], - fg = "black", lwd = 3 + circles = rep( + (background_xlim[2] - + background_xlim[1]) * symbol_radius / 100, + length(det_summ$mean_lon) + ), + add = T, inches = FALSE, + bg = color[round(det_summ$num_fish + / max(det_summ$num_fish) * 100, 0) + 1], + fg = "black", lwd = 3 ) - + # Add 'X' to bubbles with no detections if (any(det_summ$num_fish == 0)) { with( det_summ[det_summ$num_fish == 0, ], text(mean_lon, mean_lat, - "X", - cex = 0.6 * symbol_radius + "X", + cex = 0.6 * symbol_radius ) ) } - + if (is.null(scale_loc)) { # Calculate the location to plot the color scale scale_loc <- c( @@ -293,34 +292,34 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", # Add color legend # explore options for doing this without an extra plotrix package https://stackoverflow.com/questions/13355176/gradient-legend-in-base plotrix::color.legend(scale_loc[1], scale_loc[2], scale_loc[3], scale_loc[4], - paste0(" ", round( - seq(from = 1, to = max(det_summ$num_fish), length.out = 6), - 0 - )), color, - gradient = "y", family = "sans", cex = 0.75, align = "rb" + paste0(" ", round( + seq(from = 1, to = max(det_summ$num_fish), length.out = 6), + 0 + )), color, + gradient = "y", family = "sans", cex = 0.75, align = "rb" ) - + # Add x-axis and title axis(1, at = xlabs, labels = paste0(format(xlabs, 4), intToUtf8(176)), cex.axis = 1) mtext("Longitude", side = 1, line = 2.5, cex = 1) - + # Add y-axis and title axis(2, - at = ylabs, labels = paste0(format(ylabs, 4), intToUtf8(176)), cex.axis = 1, - las = 1 + at = ylabs, labels = paste0(format(ylabs, 4), intToUtf8(176)), cex.axis = 1, + las = 1 ) mtext("Latitude", side = 2, line = 4, cex = 1) - + box() - + if (!is.na(file_type)) dev.off() # Close plot device - + if (!is.na(file_type)) { message(paste0( "Image files were written to the following directory:\n", getwd(), "\n" )) } - + return(det_summ) } diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index c2868d72..28530b47 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -398,7 +398,7 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), # Load background (use example Great Lakes if null) if (is.null(bg_map)) { # example in glatos package - utils::data("great_lakes_polygon", envir = environment()) + utils::data("great_lakes_polygon", envir = environment()) background <- great_lakes_polygon rm(great_lakes_polygon) } else { From 4e3b8ef4fbddfdafb8622f8dee44614c939d3c8b Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 15:26:18 -0400 Subject: [PATCH 38/56] missed a utils --- R/vis-detection_bubble_plot.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/vis-detection_bubble_plot.r b/R/vis-detection_bubble_plot.r index 33b8d7b7..97f85d92 100644 --- a/R/vis-detection_bubble_plot.r +++ b/R/vis-detection_bubble_plot.r @@ -167,7 +167,7 @@ detection_bubble_plot <- function(det, location_col = "glatos_array", } if (is.null(map)) { - data("great_lakes_polygon", envir = environment()) + utils::data("great_lakes_polygon", envir = environment()) map <- great_lakes_polygon rm(great_lakes_polygon) } # example in glatos package (sf object) From 31aa76079be25ea6b8193a7476316d886ed8b324 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Sat, 11 May 2024 15:30:56 -0400 Subject: [PATCH 39/56] expect_identical to expect_equal to avoid floating point issues --- tests/testthat/test-convert_otn_erddap_to_att.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-convert_otn_erddap_to_att.r b/tests/testthat/test-convert_otn_erddap_to_att.r index 5656c6bd..279ae456 100644 --- a/tests/testthat/test-convert_otn_erddap_to_att.r +++ b/tests/testthat/test-convert_otn_erddap_to_att.r @@ -62,7 +62,7 @@ test_that("matches internal data: blue_shark_erddap_att", { ) # Check if expected and actual results are the same - expect_identical(bs_att, blue_shark_erddap_att) + expect_equal(bs_att, blue_shark_erddap_att) }) From 2adc2627b445183bed05b9ad48c337c6b67f8294 Mon Sep 17 00:00:00 2001 From: mhpob Date: Sat, 11 May 2024 19:33:44 +0000 Subject: [PATCH 40/56] Update documentation --- man/detection_bubble_plot.Rd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/man/detection_bubble_plot.Rd b/man/detection_bubble_plot.Rd index 0f7737af..95447e65 100644 --- a/man/detection_bubble_plot.Rd +++ b/man/detection_bubble_plot.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/vis-detection_bubble_plot.r \name{detection_bubble_plot} \alias{detection_bubble_plot} -\title{Plot number of tagged animals or detections on a map} +\title{Make bubble plots showing the number of fish detected across a defined set +of receiver locations.} \usage{ detection_bubble_plot( det, From edc101773ffbd2cadbc9a96e41865b215abd7f34 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 10:53:20 -0400 Subject: [PATCH 41/56] Fix forgotten NULL --- R/load-read_vdat_csv.r | 75 +++++++++++++++++++++--------------------- 1 file changed, 38 insertions(+), 37 deletions(-) diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index a09d2937..568d8c1e 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -133,12 +133,13 @@ read_vdat_csv <- function(src, warning("File not found: ", src) return() } - + ## Declare global variables for NSE & R CMD check - record_type <- - # Identify vdat csv format version and vdat.exe version that created input csv - vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) - + record_type <- NULL + + # Identify vdat csv format version and vdat.exe version that created input csv + vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) + # Check if fathom csv format (error if looks like VUE export format) if (vdat_header$V1[1] == "VEMCO DATA LOG") { # Set column names @@ -157,21 +158,21 @@ read_vdat_csv <- function(src, "Latitude", "Longitude" ) %in% - as.character(vdat_header))) { + as.character(vdat_header))) { stop( "Input file appears to be in VUE Export format, which is not ", "supported.\n Only Fathom CSV format is supported. \n", " Perhaps you want read_vue_detection_csv()?" ) } - + # Read all data into character vector (like readLines) vdat_txt <- data.table::fread( file = src, skip = 2, header = FALSE, sep = NULL, col.names = "txt", showProgress = show_progress ) - + # Identify record type of each row vdat_txt[, record_type := data.table::fread( file = src, @@ -182,59 +183,59 @@ read_vdat_csv <- function(src, fill = TRUE, showProgress = show_progress )] - + # Drop _DESC from headers vdat_txt[, record_type := gsub("_DESC$", "", record_type)] - - + + # Get record identifiers from csv file csv_record_types <- unique(vdat_txt$record_type) - - + + if (is.null(record_types)) { record_types <- csv_record_types } else { # Check if any record_types are not in csv unknown_record_types <- setdiff(record_types, csv_record_types) - + if (length(unknown_record_types) > 0) { stop( "The following input ", "'record_types' ", "were not found in CSV file: \n\t", paste(unknown_record_types, - collapse = ", " + collapse = ", " ) ) } } - + # Drop data types not requested by user vdat_txt <- vdat_txt[record_type %in% record_types] - + # Split into list elements by record type vdat_list <- split(vdat_txt, - by = "record_type", - keep.by = FALSE + by = "record_type", + keep.by = FALSE ) - + utils::data("vdat_csv_schema", envir = environment()) - + vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] - - + + # Preallocate list; element = record type vdat <- stats::setNames( object = vector("list", length(vdat_list)), nm = names(vdat_list) ) - + for (i in 1:length(vdat)) { # fread has issues with numerical precision (e.g., 'Time Correction (s)') # so read all columns as character then coerce vdat[[i]] <- data.table::fread( text = paste0(c(vdat_list[[i]]$txt, ""), - collapse = "\n" + collapse = "\n" ), sep = ",", na.strings = "", colClasses = "character", @@ -242,22 +243,22 @@ read_vdat_csv <- function(src, drop = 1, showProgress = show_progress ) - + # Coerce to class schema_i <- vdat_csv_schema[[names(vdat[i])]] - + # numeric numeric_cols <- schema_i$name[schema_i$type == "numeric"] - + if (length(numeric_cols) > 0) { vdat[[i]][, (numeric_cols) := lapply(.SD, as.numeric), - .SDcols = numeric_cols + .SDcols = numeric_cols ] } - + # POSIXct timestamp_cols <- schema_i$name[schema_i$type == "POSIXct"] - + if (length(timestamp_cols) > 0) { vdat[[i]][, (timestamp_cols) := lapply( .SD, @@ -272,18 +273,18 @@ read_vdat_csv <- function(src, .SDcols = timestamp_cols ] } - + # Assign class new_class <- c(paste0("vdat_", names(vdat[i])), class(vdat[[i]])) data.table::setattr(vdat[[i]], "class", new_class) } # end i - + # Assign class and other attributes vdat_list <- structure(vdat, - class = c("vdat_list", class(vdat)), - fathom_csv_version = src_version$fathom_csv, - source = src_version$vdat_exe + class = c("vdat_list", class(vdat)), + fathom_csv_version = src_version$fathom_csv, + source = src_version$vdat_exe ) - + return(vdat_list) } From faf6facb5be975aa3ced19a9a4116d6aa29be1a9 Mon Sep 17 00:00:00 2001 From: mhpob Date: Mon, 13 May 2024 14:55:12 +0000 Subject: [PATCH 42/56] Style code (GHA) --- R/load-read_vdat_csv.r | 70 +++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index 568d8c1e..609c0f71 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -133,13 +133,13 @@ read_vdat_csv <- function(src, warning("File not found: ", src) return() } - + ## Declare global variables for NSE & R CMD check record_type <- NULL - + # Identify vdat csv format version and vdat.exe version that created input csv vdat_header <- data.table::fread(file = src, nrows = 1L, header = FALSE) - + # Check if fathom csv format (error if looks like VUE export format) if (vdat_header$V1[1] == "VEMCO DATA LOG") { # Set column names @@ -158,21 +158,21 @@ read_vdat_csv <- function(src, "Latitude", "Longitude" ) %in% - as.character(vdat_header))) { + as.character(vdat_header))) { stop( "Input file appears to be in VUE Export format, which is not ", "supported.\n Only Fathom CSV format is supported. \n", " Perhaps you want read_vue_detection_csv()?" ) } - + # Read all data into character vector (like readLines) vdat_txt <- data.table::fread( file = src, skip = 2, header = FALSE, sep = NULL, col.names = "txt", showProgress = show_progress ) - + # Identify record type of each row vdat_txt[, record_type := data.table::fread( file = src, @@ -183,59 +183,59 @@ read_vdat_csv <- function(src, fill = TRUE, showProgress = show_progress )] - + # Drop _DESC from headers vdat_txt[, record_type := gsub("_DESC$", "", record_type)] - - + + # Get record identifiers from csv file csv_record_types <- unique(vdat_txt$record_type) - - + + if (is.null(record_types)) { record_types <- csv_record_types } else { # Check if any record_types are not in csv unknown_record_types <- setdiff(record_types, csv_record_types) - + if (length(unknown_record_types) > 0) { stop( "The following input ", "'record_types' ", "were not found in CSV file: \n\t", paste(unknown_record_types, - collapse = ", " + collapse = ", " ) ) } } - + # Drop data types not requested by user vdat_txt <- vdat_txt[record_type %in% record_types] - + # Split into list elements by record type vdat_list <- split(vdat_txt, - by = "record_type", - keep.by = FALSE + by = "record_type", + keep.by = FALSE ) - + utils::data("vdat_csv_schema", envir = environment()) - + vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] - - + + # Preallocate list; element = record type vdat <- stats::setNames( object = vector("list", length(vdat_list)), nm = names(vdat_list) ) - + for (i in 1:length(vdat)) { # fread has issues with numerical precision (e.g., 'Time Correction (s)') # so read all columns as character then coerce vdat[[i]] <- data.table::fread( text = paste0(c(vdat_list[[i]]$txt, ""), - collapse = "\n" + collapse = "\n" ), sep = ",", na.strings = "", colClasses = "character", @@ -243,22 +243,22 @@ read_vdat_csv <- function(src, drop = 1, showProgress = show_progress ) - + # Coerce to class schema_i <- vdat_csv_schema[[names(vdat[i])]] - + # numeric numeric_cols <- schema_i$name[schema_i$type == "numeric"] - + if (length(numeric_cols) > 0) { vdat[[i]][, (numeric_cols) := lapply(.SD, as.numeric), - .SDcols = numeric_cols + .SDcols = numeric_cols ] } - + # POSIXct timestamp_cols <- schema_i$name[schema_i$type == "POSIXct"] - + if (length(timestamp_cols) > 0) { vdat[[i]][, (timestamp_cols) := lapply( .SD, @@ -273,18 +273,18 @@ read_vdat_csv <- function(src, .SDcols = timestamp_cols ] } - + # Assign class new_class <- c(paste0("vdat_", names(vdat[i])), class(vdat[[i]])) data.table::setattr(vdat[[i]], "class", new_class) } # end i - + # Assign class and other attributes vdat_list <- structure(vdat, - class = c("vdat_list", class(vdat)), - fathom_csv_version = src_version$fathom_csv, - source = src_version$vdat_exe + class = c("vdat_list", class(vdat)), + fathom_csv_version = src_version$fathom_csv, + source = src_version$vdat_exe ) - + return(vdat_list) } From 047f150165c6e37cf1befb89844a0cee22dd242b Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:12:46 -0400 Subject: [PATCH 43/56] fix latex escape and invalid alias tagging --- R/package-glatos.r | 6 +++--- man/glatos.Rd | 32 +++++++++++++++++++++++++++++--- 2 files changed, 32 insertions(+), 6 deletions(-) diff --git a/R/package-glatos.r b/R/package-glatos.r index c9716029..ea832dbb 100644 --- a/R/package-glatos.r +++ b/R/package-glatos.r @@ -35,12 +35,12 @@ #' #' \item{[real_sensor_values]}{ Converts 'raw' transmitter sensor (e.g., #' depth, temperature) to 'real'-scale values (e.g., depth in meters) using -#' transmitter specification data (e.g., from read\_vemco\_tag\_specs).} } +#' transmitter specification data (e.g., from [read_vemco_tag_specs]).} } #' #' @section Filtering and summarizing: \describe{ #' \item{[min_lag]}{ #' Facilitates identification and removal of false positive detections by -#' calculating the minimum time interval (min\_lag) between successive +#' calculating the minimum time interval (min_lag) between successive #' detections.} #' #' \item{[false_detections]}{ Removes potential false positive detections @@ -123,7 +123,7 @@ #' txtProgressBar unzip write.csv write.table zip #' @importFrom grDevices bmp colorRampPalette dev.new dev.off jpeg png rainbow #' tiff -globalVariables(".") # to avoid R CMD check note +"_PACKAGE" # package startup message .onAttach <- function(libname, pkgname) { diff --git a/man/glatos.Rd b/man/glatos.Rd index 9401faf3..d8c2379a 100644 --- a/man/glatos.Rd +++ b/man/glatos.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/package-glatos.r \docType{package} \name{glatos} -\alias{-package} +\alias{glatos-package} \alias{glatos} \title{An R package for the Great Lakes Acoustic Telemetry Observation System} \description{ @@ -44,14 +44,14 @@ and operating schedule.} \item{\link{real_sensor_values}}{ Converts 'raw' transmitter sensor (e.g., depth, temperature) to 'real'-scale values (e.g., depth in meters) using -transmitter specification data (e.g., from read\_vemco\_tag\_specs).} } +transmitter specification data (e.g., from \link{read_vemco_tag_specs}).} } } \section{Filtering and summarizing}{ \describe{ \item{\link{min_lag}}{ Facilitates identification and removal of false positive detections by -calculating the minimum time interval (min\_lag) between successive +calculating the minimum time interval (min_lag) between successive detections.} \item{\link{false_detections}}{ Removes potential false positive detections @@ -130,3 +130,29 @@ Toolbox(https://github.com/vinayudyawer/ATT) and the VTrack package.} } } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/ocean-tracking-network/glatos} + \item Report bugs at \url{https://github.com/ocean-tracking-network/glatos/issues} +} + +} +\author{ +\strong{Maintainer}: Christopher Holbrook \email{cholbrook@usgs.gov} + +Authors: +\itemize{ + \item Todd Hayden + \item Thomas Binder + \item Jon Pye +} + +Other contributors: +\itemize{ + \item Alex Nunes [contributor] + \item Angela Dini [contributor] + \item Ryan Gosse [contributor] +} + +} From bcdd387a71873218328fba070ce22d510f13c011 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:13:12 -0400 Subject: [PATCH 44/56] fix latex escape --- R/vis-make_transition3.r | 2 +- man/make_transition3.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/vis-make_transition3.r b/R/vis-make_transition3.r index 14f8cef7..9de7f041 100644 --- a/R/vis-make_transition3.r +++ b/R/vis-make_transition3.r @@ -26,7 +26,7 @@ #' layer. Both objects have the same extents and geographic #' projection as input shapefile. #' -#' @details If receiver\_points is provided, any receiver not in water +#' @details If receiver_points is provided, any receiver not in water #' is buffered by the distance from the receiver to the nearest #' water. This allows all receivers to be coded as in water if the #' receiver is on land. diff --git a/man/make_transition3.Rd b/man/make_transition3.Rd index 24d8dfbd..100a0501 100644 --- a/man/make_transition3.Rd +++ b/man/make_transition3.Rd @@ -45,7 +45,7 @@ two-object list containing the raster layer and transition layer. Both objects have the same extents and geographic projection as input shapefile. -@details If receiver\_points is provided, any receiver not in water +@details If receiver_points is provided, any receiver not in water is buffered by the distance from the receiver to the nearest water. This allows all receivers to be coded as in water if the receiver is on land. From 1f47093c17428f2efe3738ba55f2e4a63df5d7bc Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:13:53 -0400 Subject: [PATCH 45/56] fix misspecified itemize list --- R/vis-make_frames.r | 61 +++++++++++++++++++++++---------------------- man/make_frames.Rd | 46 +++++++++++++++++----------------- 2 files changed, 54 insertions(+), 53 deletions(-) diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 28530b47..ac0c95cf 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -63,23 +63,24 @@ #' location points, receiver location points, timeline, and slider (moves along #' the timeline). See also **Details** and **Note** sections. #' -#' @details -#' +#' @details #' ***To customize fish location points (from `proc_obj`):*** Add any argument #' that can be passed to [points][graphics::points]. The following values will #' create the default plot: #' \itemize{ -#' \item{`cex:`}{ symbol size; default = 2} -#' \item{`col:`}{ symbol color; default = "blue"} -#' \item{`pch:`}{ symbol type; default = 16} +#' \item `cex`: symbol size; default = 2 +#' \item `col`: symbol color; default = "blue" +#' \item `pch`: symbol type; default = 16 #' } -#' +#' +#' @details +#' #' ***To customize receiver location points (from `recs`):*** Add prefix #' `recs.` to any argument that can be passed to [points][graphics::points]. The #' following values will create the default plot: #' \itemize{ -#' \item{`recs.cex:`}{ symbol size; default = 1.5} -#' \item{`recs.pch:`}{ symbol type; default = 16} +#' \item `recs.cex`: symbol size; default = 1.5 +#' \item `recs.pch`: symbol type; default = 16 #' } #' #' ***To customize timeline:*** Add add prefix `timeline.` to any @@ -87,43 +88,43 @@ #' the sliding symbol (see 'slider' below) are created by a call to `axis`. The #' following values will create the default plot: #' \itemize{ -#' \item{`timeline.at:`}{ a sequence with locations of labels (with first +#' \item `timeline.at`: a sequence with locations of labels (with first #' and last being start and end) along x-axis; in units of longitude; by default #' this will center the timeline with five equally-spaced labels in the middle -#' 80% of background_xlim.} -#' \item{`timeline.pos:`}{ location along the y-axis; in units of latitude; +#' 80% of background_xlim. +#' \item `timeline.pos`: location along the y-axis; in units of latitude; #' by default this will place the timeline up from the bottom 6% of the range -#' of `background_ylim`} -#' \item{`timeline.labels:`}{ text used for labels; default = -#' `format(labels, "\%Y-\%m-\%d")`, where labels are values of proc_obj$bin_timestamp} -#' \item{`timeline.col:`}{ color of line; default = "grey70"} -#' \item{`timeline.lwd:`}{ width of line; default = 20 times the aspect -#' ratio of the plot device} -#' \item{`timeline.cex.axis:`}{size of labels; default = 2} +#' of `background_ylim` +#' \item `timeline.labels`: text used for labels; default = +#' `format(labels, "\%Y-\%m-\%d")`, where labels are values of proc_obj$bin_timestamp +#' \item `timeline.col`: color of line; default = "grey70" +#' \item `timeline.lwd`: width of line; default = 20 times the aspect +#' ratio of the plot device +#' \item `timeline.cex.axis`: size of labels; default = 2 #' } -#' +#' #' ***To customize time slider (symbol that slides):*** Add prefix #' `timeline.` to any argument that can be passed to [points][graphics::points]. #' The following values will create the default plot: #' \itemize{ -#' \item{`timeslider.bg:`}{ a single value with symbol bg color; default = -#' "grey40"} -#' \item{`timeslider.cex:`}{ a single value with symbol size; default = 2} -#' \item{`timeslider.col:`}{ a single value with symbol type; default = -#' "grey20"} -#' \item{`timeslider.pch:`}{ a single value with symbol type; default = 21} +#' \item `timeslider.bg`: a single value with symbol bg color; default = +#' "grey40" +#' \item `timeslider.cex`: a single value with symbol size; default = 2 +#' \item `timeslider.col`: a single value with symbol type; default = +#' "grey20" +#' \item `timeslider.pch`: a single value with symbol type; default = 21 #' } -#' +#' #' ***To customize parameters controlled by `par`:*** Add prefix #' `par.` to any argument that can be passed to [par][graphics::par]. Note that #' `par.mar` controls whitespace behind default timeslider. The following values #' will create the default plot: #' \itemize{ -#' \item{`par.oma`}{ plot outer margins; default = c(0,0,0,0)} -#' \item{`par.mar`}{ plot inner margins; default = c(6,0,0,0)} +#' \item `par.oma`: plot outer margins; default = c(0,0,0,0) +#' \item `par.mar`: plot inner margins; default = c(6,0,0,0) #' } #' -#' @details If `animate = TRUE` then the animation output file name (`ani_name` +#' If `animate = TRUE` then the animation output file name (`ani_name` #' argument) will be passed to the `output` argument in [make_video()]. Default #' values for all other [make_video()] arguments will be used. Note that the #' default frame rate is 24 frames per second (`framerate` argument in @@ -133,7 +134,7 @@ #' dimensions (size), and other ouput video characteristics can be modified by #' calling [make_video()] directly. To do this, set `animate = FALSE` and then #' use [make_video()] to create a video from the resulting set of images. -#' +#' #' #' @return Sequentially-numbered png files (one for each frame) and one mp4 file #' will be written to `out_dir`. diff --git a/man/make_frames.Rd b/man/make_frames.Rd index 1bc8658c..4925e2ea 100644 --- a/man/make_frames.Rd +++ b/man/make_frames.Rd @@ -95,17 +95,17 @@ a video animation (mp4 file). that can be passed to \link[graphics:points]{points}. The following values will create the default plot: \itemize{ -\item{\verb{cex:}}{ symbol size; default = 2} -\item{\verb{col:}}{ symbol color; default = "blue"} -\item{\verb{pch:}}{ symbol type; default = 16} +\item \code{cex}: symbol size; default = 2 +\item \code{col}: symbol color; default = "blue" +\item \code{pch}: symbol type; default = 16 } \emph{\strong{To customize receiver location points (from \code{recs}):}} Add prefix \code{recs.} to any argument that can be passed to \link[graphics:points]{points}. The following values will create the default plot: \itemize{ -\item{\verb{recs.cex:}}{ symbol size; default = 1.5} -\item{\verb{recs.pch:}}{ symbol type; default = 16} +\item \code{recs.cex}: symbol size; default = 1.5 +\item \code{recs.pch}: symbol type; default = 16 } \emph{\strong{To customize timeline:}} Add add prefix \code{timeline.} to any @@ -113,31 +113,31 @@ argument of \link[graphics:axis]{axis}. Note all elements of the timeline excep the sliding symbol (see 'slider' below) are created by a call to \code{axis}. The following values will create the default plot: \itemize{ -\item{\verb{timeline.at:}}{ a sequence with locations of labels (with first +\item \code{timeline.at}: a sequence with locations of labels (with first and last being start and end) along x-axis; in units of longitude; by default this will center the timeline with five equally-spaced labels in the middle -80\% of background_xlim.} -\item{\verb{timeline.pos:}}{ location along the y-axis; in units of latitude; +80\% of background_xlim. +\item \code{timeline.pos}: location along the y-axis; in units of latitude; by default this will place the timeline up from the bottom 6\% of the range -of \code{background_ylim}} -\item{\verb{timeline.labels:}}{ text used for labels; default = -\code{format(labels, "\\\%Y-\\\%m-\\\%d")}, where labels are values of proc_obj$bin_timestamp} -\item{\verb{timeline.col:}}{ color of line; default = "grey70"} -\item{\verb{timeline.lwd:}}{ width of line; default = 20 times the aspect -ratio of the plot device} -\item{\verb{timeline.cex.axis:}}{size of labels; default = 2} +of \code{background_ylim} +\item \code{timeline.labels}: text used for labels; default = +\code{format(labels, "\\\%Y-\\\%m-\\\%d")}, where labels are values of proc_obj$bin_timestamp +\item \code{timeline.col}: color of line; default = "grey70" +\item \code{timeline.lwd}: width of line; default = 20 times the aspect +ratio of the plot device +\item \code{timeline.cex.axis}: size of labels; default = 2 } \emph{\strong{To customize time slider (symbol that slides):}} Add prefix \code{timeline.} to any argument that can be passed to \link[graphics:points]{points}. The following values will create the default plot: \itemize{ -\item{\verb{timeslider.bg:}}{ a single value with symbol bg color; default = -"grey40"} -\item{\verb{timeslider.cex:}}{ a single value with symbol size; default = 2} -\item{\verb{timeslider.col:}}{ a single value with symbol type; default = -"grey20"} -\item{\verb{timeslider.pch:}}{ a single value with symbol type; default = 21} +\item \code{timeslider.bg}: a single value with symbol bg color; default = +"grey40" +\item \code{timeslider.cex}: a single value with symbol size; default = 2 +\item \code{timeslider.col}: a single value with symbol type; default = +"grey20" +\item \code{timeslider.pch}: a single value with symbol type; default = 21 } \emph{\strong{To customize parameters controlled by \code{par}:}} Add prefix @@ -145,8 +145,8 @@ The following values will create the default plot: \code{par.mar} controls whitespace behind default timeslider. The following values will create the default plot: \itemize{ -\item{\code{par.oma}}{ plot outer margins; default = c(0,0,0,0)} -\item{\code{par.mar}}{ plot inner margins; default = c(6,0,0,0)} +\item \code{par.oma}: plot outer margins; default = c(0,0,0,0) +\item \code{par.mar}: plot inner margins; default = c(6,0,0,0) } If \code{animate = TRUE} then the animation output file name (\code{ani_name} From 81a0b81db1e45dadcd0c9ae1fe9677ba37100c7e Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:14:32 -0400 Subject: [PATCH 46/56] fix misspecified itemize list --- R/vis-make_transition.r | 7 ++++--- man/make_transition.Rd | 7 ++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/R/vis-make_transition.r b/R/vis-make_transition.r index 48689d88..815fa79f 100644 --- a/R/vis-make_transition.r +++ b/R/vis-make_transition.r @@ -51,9 +51,10 @@ #' #' @return A list with two elements: #' \itemize{ -#' \item{`transition:`}{ a geo-corrected transition raster layer where land = 0 -#' and water=1 (see `gdistance`)} -#' \item{`rast:`}{ rasterized input layer of class `raster`}} +#' \item `transition`: a geo-corrected transition raster layer where land = 0 +#' and water=1 (see `gdistance`) +#' \item `rast`: rasterized input layer of class `raster` +#' } #' Additionally, rasterized version of input shapefile (*.tif extension) is #' written to computer at `output_dir` #' diff --git a/man/make_transition.Rd b/man/make_transition.Rd index c366dffc..f3f596ff 100644 --- a/man/make_transition.Rd +++ b/man/make_transition.Rd @@ -41,9 +41,10 @@ pixel must be at least 50\% covered by polygon to be coded as water.} \value{ A list with two elements: \itemize{ -\item{\verb{transition:}}{ a geo-corrected transition raster layer where land = 0 -and water=1 (see \code{gdistance})} -\item{\verb{rast:}}{ rasterized input layer of class \code{raster}}} +\item \code{transition}: a geo-corrected transition raster layer where land = 0 +and water=1 (see \code{gdistance}) +\item \code{rast}: rasterized input layer of class \code{raster} +} Additionally, rasterized version of input shapefile (*.tif extension) is written to computer at \code{output_dir} } From f4a21c8da5b7c0697929099665d41f42c90a97f5 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:15:03 -0400 Subject: [PATCH 47/56] fix rd link --- R/vis-interpolate_path.r | 2 +- man/interpolate_path.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/vis-interpolate_path.r b/R/vis-interpolate_path.r index 3601b010..2ec2a1cc 100644 --- a/R/vis-interpolate_path.r +++ b/R/vis-interpolate_path.r @@ -63,7 +63,7 @@ #' interpolation will be used for all points when `lnl_thresh` #' = 0. #' -#' @details All linear interpolation is done by code{stats::approx} with +#' @details All linear interpolation is done by [stats::approx] with #' argument `ties = "ordered"` controlling how tied `x` values #' are handled. See [approxfun()]. #' diff --git a/man/interpolate_path.Rd b/man/interpolate_path.Rd index 71a0ae04..c681e7f6 100644 --- a/man/interpolate_path.Rd +++ b/man/interpolate_path.Rd @@ -84,7 +84,7 @@ be used for all points when \code{lnl_thresh} > 1 and linear interpolation will be used for all points when \code{lnl_thresh} = 0. -All linear interpolation is done by code{stats::approx} with +All linear interpolation is done by \link[stats:approxfun]{stats::approx} with argument \code{ties = "ordered"} controlling how tied \code{x} values are handled. See \code{\link[=approxfun]{approxfun()}}. } From 642a77c78e2cde3b16e586514a9ee47676cfd5b0 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:15:39 -0400 Subject: [PATCH 48/56] fix missing link by rm --- R/util-vdat.r | 2 +- R/util-vue.r | 2 +- man/check_vdat.Rd | 2 +- man/check_vue.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/util-vdat.r b/R/util-vdat.r index 9dc3072d..736e1dd8 100644 --- a/R/util-vdat.r +++ b/R/util-vdat.r @@ -491,7 +491,7 @@ vdat_convert <- function(src, #' of the system. #' #' @returns Character string with command for calling VDAT.exe via -#' \code{system2}'s \code{\link{command}} argument. +#' \code{system2}'s \code{command} argument. #' #' @examples #' \dontrun{ diff --git a/R/util-vue.r b/R/util-vue.r index 3fe52e26..5a5d9054 100644 --- a/R/util-vue.r +++ b/R/util-vue.r @@ -472,7 +472,7 @@ vue_convert <- function(src, #' of the system. #' #' @returns Character string with command for calling VUE.exe via -#' \code{system2}'s \code{\link{command}} argument. +#' \code{system2}'s \code{command} argument. #' #' @examples #' \dontrun{ diff --git a/man/check_vdat.Rd b/man/check_vdat.Rd index 3f7c6a4c..57b3c5c8 100644 --- a/man/check_vdat.Rd +++ b/man/check_vdat.Rd @@ -13,7 +13,7 @@ of the system.} } \value{ Character string with command for calling VDAT.exe via -\code{system2}'s \code{\link{command}} argument. +\code{system2}'s \code{command} argument. } \description{ Check path to Innovasea program VDAT.exe diff --git a/man/check_vue.Rd b/man/check_vue.Rd index dc254ceb..60c69077 100644 --- a/man/check_vue.Rd +++ b/man/check_vue.Rd @@ -13,7 +13,7 @@ of the system.} } \value{ Character string with command for calling VUE.exe via -\code{system2}'s \code{\link{command}} argument. +\code{system2}'s \code{command} argument. } \description{ Check path to Innovasea program VUE.exe From 07ff39bb10f75545d0be0dd86f9cd494c7e9f2ce Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:16:21 -0400 Subject: [PATCH 49/56] backtick so roxygen doesn interpret boxed code as a link --- R/sim-crw_in_polygon.r | 6 +++--- R/simutil-crw.r | 6 +++--- R/vis-position_heat_map.r | 26 +++++++++++++++----------- man/crw.Rd | 6 +++--- man/crw_in_polygon.Rd | 6 +++--- man/position_heat_map.Rd | 26 +++++++++++++++----------- 6 files changed, 42 insertions(+), 34 deletions(-) diff --git a/R/sim-crw_in_polygon.r b/R/sim-crw_in_polygon.r index 3e4607b5..ab614f55 100644 --- a/R/sim-crw_in_polygon.r +++ b/R/sim-crw_in_polygon.r @@ -9,14 +9,14 @@ #' are also accepted); \cr *OR* \cr A polygon defined as data frame or #' matrix with numeric columns x and y. #' -#' @param theta A 2-element numeric vector with turn angle parameters (theta[1] -#' = mean; theta[2] = sd), in degrees, from normal distribution. +#' @param theta A 2-element numeric vector with turn angle parameters (`theta[1]` +#' = mean; `theta[2]` = sd), in degrees, from normal distribution. #' #' @param stepLen A numeric scalar with total distance moved in each step, in #' meters. #' #' @param initPos A 2-element numeric vector with initial position -#' (initPos[1]=x, initPos[2]=y) in same coordinate reference system as +#' (`initPos[1]`=x, `initPos[2]`=y) in same coordinate reference system as #' `polyg`. #' #' @param initHeading A numeric scalar with initial heading in degrees. E.g., 0 diff --git a/R/simutil-crw.r b/R/simutil-crw.r index e0537a67..4959ad94 100644 --- a/R/simutil-crw.r +++ b/R/simutil-crw.r @@ -4,12 +4,12 @@ #' drawn from a normal distribution. #' #' @param theta A 2-element numeric vector with turn angle parameters -#' (theta[1] = mean; theta[2] = sd) from normal distribution. +#' (`theta[1]` = mean; `theta[2]` = sd) from normal distribution. #' #' @param stepLen A numeric scalar with total distance moved in each step. #' -#' @param initPos A 2-element numeric vector with nital position (initPos[1]=x, -#' initPos[2]=y). +#' @param initPos A 2-element numeric vector with nital position (`initPos[1]`=x, +#' `initPos[2]`=y). #' #' @param initHeading A numeric scalar with initial heading in degrees. #' diff --git a/R/vis-position_heat_map.r b/R/vis-position_heat_map.r index f52000ad..ce974ee1 100644 --- a/R/vis-position_heat_map.r +++ b/R/vis-position_heat_map.r @@ -5,10 +5,14 @@ #' VPS positional telemetry data. #' #' @param positions A dataframe containing detection data with at least the -#' following 4 columns: \describe{ \item{`DETECTEDID`}{Individual animal -#' identifier; character.} \item{`DATETIME`}{Date-time stamps for the -#' positions (MUST be of class 'POSIXct')} \item{`LAT`}{Position -#' latitude.} \item{`LON`}{Position longitude.} } +#' following 4 columns: +#' \describe{ +#' \item{`DETECTEDID`}{Individual animal identifier; character.} +#' \item{`DATETIME`}{Date-time stamps for the positions (MUST be of +#' class 'POSIXct')} +#' \item{`LAT`}{Position latitude.} +#' \item{`LON`}{Position longitude.} +#' } #' #' @param projection A character string indicating if the coordinates in the #' 'positions' dataframe are geographic (`projection = "LL"`) or @@ -87,13 +91,13 @@ #' the 4 intervals, than the number of intervals for that fish and grid #' combination is 3. Intervals are determined by applying the #' [findInterval][base::findInterval] function (base R) to a sequence of timestamps -#' (class: POSIXct) created using seq(from = min(positions[, DATETIME]), to = -#' min(positions[, DATETIME]), by = interval), where interval is the -#' user-assigned interval duration in seconds. Number of intervals is a more -#' robust surrogate than number of positions for relative time spent in each -#' grid in cases where spatial or temporal variability in positioning -#' probability are likely to significantly bias the distribution of positions -#' in the array. +#' (class: POSIXct) created using +#' `seq(from = min(positions[, DATETIME]), to = min(positions[, DATETIME]), by = interval)`, +#' where interval is the user-assigned interval duration in seconds. Number of +#' intervals is a more robust surrogate than number of positions for relative +#' time spent in each grid in cases where spatial or temporal variability in +#' positioning probability are likely to significantly bias the distribution of +#' positions in the array. #' @details Calculated values (i.e., fish, positions, intervals) can be returned #' as absolute or relative, which is specified using the abs_or_rel argument; diff --git a/man/crw.Rd b/man/crw.Rd index c5c822a2..46289434 100644 --- a/man/crw.Rd +++ b/man/crw.Rd @@ -14,12 +14,12 @@ crw( } \arguments{ \item{theta}{A 2-element numeric vector with turn angle parameters -(theta\link{1} = mean; theta\link{2} = sd) from normal distribution.} +(\code{theta[1]} = mean; \code{theta[2]} = sd) from normal distribution.} \item{stepLen}{A numeric scalar with total distance moved in each step.} -\item{initPos}{A 2-element numeric vector with nital position (initPos\link{1}=x, -initPos\link{2}=y).} +\item{initPos}{A 2-element numeric vector with nital position (\code{initPos[1]}=x, +\code{initPos[2]}=y).} \item{initHeading}{A numeric scalar with initial heading in degrees.} diff --git a/man/crw_in_polygon.Rd b/man/crw_in_polygon.Rd index fca0b6ec..518efc26 100644 --- a/man/crw_in_polygon.Rd +++ b/man/crw_in_polygon.Rd @@ -24,14 +24,14 @@ features (but \code{SpatialPolygonsDataFrame} and \code{SpatialPolygons} are also accepted); \cr \emph{OR} \cr A polygon defined as data frame or matrix with numeric columns x and y.} -\item{theta}{A 2-element numeric vector with turn angle parameters (theta\link{1} -= mean; theta\link{2} = sd), in degrees, from normal distribution.} +\item{theta}{A 2-element numeric vector with turn angle parameters (\code{theta[1]} += mean; \code{theta[2]} = sd), in degrees, from normal distribution.} \item{stepLen}{A numeric scalar with total distance moved in each step, in meters.} \item{initPos}{A 2-element numeric vector with initial position -(initPos\link{1}=x, initPos\link{2}=y) in same coordinate reference system as +(\code{initPos[1]}=x, \code{initPos[2]}=y) in same coordinate reference system as \code{polyg}.} \item{initHeading}{A numeric scalar with initial heading in degrees. E.g., 0 diff --git a/man/position_heat_map.Rd b/man/position_heat_map.Rd index d8536844..c5b476ac 100644 --- a/man/position_heat_map.Rd +++ b/man/position_heat_map.Rd @@ -24,10 +24,14 @@ position_heat_map( } \arguments{ \item{positions}{A dataframe containing detection data with at least the -following 4 columns: \describe{ \item{\code{DETECTEDID}}{Individual animal -identifier; character.} \item{\code{DATETIME}}{Date-time stamps for the -positions (MUST be of class 'POSIXct')} \item{\code{LAT}}{Position -latitude.} \item{\code{LON}}{Position longitude.} }} +following 4 columns: +\describe{ +\item{\code{DETECTEDID}}{Individual animal identifier; character.} +\item{\code{DATETIME}}{Date-time stamps for the positions (MUST be of +class 'POSIXct')} +\item{\code{LAT}}{Position latitude.} +\item{\code{LON}}{Position longitude.} +}} \item{projection}{A character string indicating if the coordinates in the 'positions' dataframe are geographic (\code{projection = "LL"}) or @@ -126,13 +130,13 @@ of raw number of positions. For example, in 4 hours there are a total of 4 the 4 intervals, than the number of intervals for that fish and grid combination is 3. Intervals are determined by applying the \link[base:findInterval]{findInterval} function (base R) to a sequence of timestamps -(class: POSIXct) created using seq(from = min(positions\link{, DATETIME}), to = -min(positions\link{, DATETIME}), by = interval), where interval is the -user-assigned interval duration in seconds. Number of intervals is a more -robust surrogate than number of positions for relative time spent in each -grid in cases where spatial or temporal variability in positioning -probability are likely to significantly bias the distribution of positions -in the array. +(class: POSIXct) created using +\code{seq(from = min(positions[, DATETIME]), to = min(positions[, DATETIME]), by = interval)}, +where interval is the user-assigned interval duration in seconds. Number of +intervals is a more robust surrogate than number of positions for relative +time spent in each grid in cases where spatial or temporal variability in +positioning probability are likely to significantly bias the distribution of +positions in the array. Calculated values (i.e., fish, positions, intervals) can be returned as absolute or relative, which is specified using the abs_or_rel argument; From d520fc72269038f3d454f0f1279987b412cac5f8 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:39:33 -0400 Subject: [PATCH 50/56] useage to example --- R/extdata.r | 16 ++++++++-------- R/testdata.r | 4 ++-- man/flynn_island_transition.Rd | 3 --- man/higgins_lake_transition.Rd | 3 --- man/otn_aat_animals.Rd | 7 ++++--- man/otn_aat_receivers.Rd | 7 ++++--- man/otn_aat_tag_releases.Rd | 7 ++++--- man/raw_lamprey_workbook.Rd | 7 ++++--- man/raw_walleye_detections.Rd | 7 ++++--- man/shoreline.Rd | 7 ++++--- man/video-images.Rd | 11 ++++++----- 11 files changed, 40 insertions(+), 39 deletions(-) diff --git a/R/extdata.r b/R/extdata.r index beeac984..9a6772d7 100644 --- a/R/extdata.r +++ b/R/extdata.r @@ -8,7 +8,7 @@ #' #' @section Filename: walleye_detections.zip #' -#' @usage +#' @examples #' system.file("extdata", "walleye_detections.zip", package="glatos") #' #' @author Todd Hayden @@ -37,7 +37,7 @@ NULL #' #' @section Filename: SMRSL_GLATOS_20140828.xlsm #' -#' @usage +#' @examples #' system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package="glatos") #' #' @author Chris Holbrook @@ -53,11 +53,11 @@ NULL #' #' @format Folder contains 30 sequentially labeled .png image files #' -#' @name video images +#' @name video-images #' #' @section Filename: frames #' -#' @usage +#' @examples #' system.file("extdata", "frames", package="glatos") #' #' @author Todd Hayden @@ -77,7 +77,7 @@ NULL #' #' @section Filename: shoreline.zip #' -#' @usage +#' @examples #' system.file("extdata", "shoreline.zip", package="glatos") #' #' @author Todd Hayden @@ -95,7 +95,7 @@ NULL #' #' @section Filename: otn_aat_animals.csv #' -#' @usage +#' @examples #' system.file("extdata", "otn_aat_animals.csv", package = "glatos") #' #' @source Ryan Gosse, Ocean Tracking Network @@ -111,7 +111,7 @@ NULL #' #' @section Filename: otn_aat_receivers.csv #' -#' @usage +#' @examples #' system.file("extdata", "otn_aat_receivers.csv", package = "glatos") #' #' @source Ryan Gosse, Ocean Tracking Network @@ -127,7 +127,7 @@ NULL #' #' @section Filename: otn_aat_tag_releases.csv #' -#' @usage +#' @examples #' system.file("extdata", "otn_aat_tag_releases.csv", package = "glatos") #' #' @source Ryan Gosse, Ocean Tracking Network diff --git a/R/testdata.r b/R/testdata.r index 0bff5e2a..b490095e 100644 --- a/R/testdata.r +++ b/R/testdata.r @@ -10,7 +10,7 @@ #' #' @section Filename: higgins_lake_transition.rds #' -#' @usage +#' @example #' system.file("testdata", "higgins_lake_transition.rds", package = "glatos") #' #' @author Chris Holbrook @@ -29,7 +29,7 @@ NULL #' #' @section Filename: flynn_island_transition.rds #' -#' @usage +#' @example #' system.file("testdata", "flynn_island_transition.rds", package = "glatos") #' #' @author Chris Holbrook diff --git a/man/flynn_island_transition.Rd b/man/flynn_island_transition.Rd index a159ee1d..a16969dc 100644 --- a/man/flynn_island_transition.Rd +++ b/man/flynn_island_transition.Rd @@ -7,9 +7,6 @@ A list comprised of a TransitionLayer and RasterLayer (see \code{\link[=make_transition]{make_transition()}}). } -\usage{ -system.file("testdata", "flynn_island_transition.rds", package = "glatos") -} \description{ A transition object, created from \code{\link[=flynn_island_polygon]{flynn_island_polygon()}} for testing \code{\link[=make_transition]{make_transition()}}. diff --git a/man/higgins_lake_transition.Rd b/man/higgins_lake_transition.Rd index 75ac1d1f..c6134093 100644 --- a/man/higgins_lake_transition.Rd +++ b/man/higgins_lake_transition.Rd @@ -7,9 +7,6 @@ A list comprised of a TransitionLayer and RasterLayer (see \code{\link[=make_transition]{make_transition()}}). } -\usage{ -system.file("testdata", "higgins_lake_transition.rds", package = "glatos") -} \description{ A transition object, created from \code{\link[=higgins_lake_polygon]{higgins_lake_polygon()}} for testing \code{\link[=make_transition]{make_transition()}}. diff --git a/man/otn_aat_animals.Rd b/man/otn_aat_animals.Rd index abc242cd..de0cddd7 100644 --- a/man/otn_aat_animals.Rd +++ b/man/otn_aat_animals.Rd @@ -9,9 +9,6 @@ CSV \source{ Ryan Gosse, Ocean Tracking Network } -\usage{ -system.file("extdata", "otn_aat_animals.csv", package = "glatos") -} \description{ An example animal data file from the OTN ERDDAP } @@ -19,3 +16,7 @@ An example animal data file from the OTN ERDDAP otn_aat_animals.csv } +\examples{ +system.file("extdata", "otn_aat_animals.csv", package = "glatos") + +} diff --git a/man/otn_aat_receivers.Rd b/man/otn_aat_receivers.Rd index 80a642bd..0d5ef9c4 100644 --- a/man/otn_aat_receivers.Rd +++ b/man/otn_aat_receivers.Rd @@ -9,9 +9,6 @@ CSV \source{ Ryan Gosse, Ocean Tracking Network } -\usage{ -system.file("extdata", "otn_aat_receivers.csv", package = "glatos") -} \description{ An example receiver station data file from the OTN ERDDAP } @@ -19,3 +16,7 @@ An example receiver station data file from the OTN ERDDAP otn_aat_receivers.csv } +\examples{ +system.file("extdata", "otn_aat_receivers.csv", package = "glatos") + +} diff --git a/man/otn_aat_tag_releases.Rd b/man/otn_aat_tag_releases.Rd index b6dbefb7..538f0c65 100644 --- a/man/otn_aat_tag_releases.Rd +++ b/man/otn_aat_tag_releases.Rd @@ -9,9 +9,6 @@ CSV \source{ Ryan Gosse, Ocean Tracking Network } -\usage{ -system.file("extdata", "otn_aat_tag_releases.csv", package = "glatos") -} \description{ An example tag release data file from the OTN ERDDAP } @@ -19,3 +16,7 @@ An example tag release data file from the OTN ERDDAP otn_aat_tag_releases.csv } +\examples{ +system.file("extdata", "otn_aat_tag_releases.csv", package = "glatos") + +} diff --git a/man/raw_lamprey_workbook.Rd b/man/raw_lamprey_workbook.Rd index 2dd8fb47..a6039806 100644 --- a/man/raw_lamprey_workbook.Rd +++ b/man/raw_lamprey_workbook.Rd @@ -18,9 +18,6 @@ worksheets: \source{ \url{http://glatos.glos.us/home/project/SMRSL} } -\usage{ -system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package="glatos") -} \description{ A completed GLATOS workbook from St. Marys River Sea Lamprey project. @@ -29,6 +26,10 @@ project. SMRSL_GLATOS_20140828.xlsm } +\examples{ +system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package="glatos") + +} \author{ Chris Holbrook } diff --git a/man/raw_walleye_detections.Rd b/man/raw_walleye_detections.Rd index f9f312ba..a51e07b3 100644 --- a/man/raw_walleye_detections.Rd +++ b/man/raw_walleye_detections.Rd @@ -9,9 +9,6 @@ A zipped walleye detection file in detection file format 1.3: \source{ \url{http://glatos.glos.us/home/project/HECWL} } -\usage{ -system.file("extdata", "walleye_detections.zip", package="glatos") -} \description{ An example detection file } @@ -19,6 +16,10 @@ An example detection file walleye_detections.zip } +\examples{ +system.file("extdata", "walleye_detections.zip", package="glatos") + +} \author{ Todd Hayden } diff --git a/man/shoreline.Rd b/man/shoreline.Rd index 3c6234cf..d753755a 100644 --- a/man/shoreline.Rd +++ b/man/shoreline.Rd @@ -9,9 +9,6 @@ shapefile \source{ \url{http://glatos.glos.us/home} } -\usage{ -system.file("extdata", "shoreline.zip", package="glatos") -} \description{ Polygon coastline of Great Lakes in WGS84 projection. Includes outlines of Tittabawassee River (Lake @@ -21,6 +18,10 @@ Huron), Maumee River (Lake Erie), and Sandusky River (Lake Erie) shoreline.zip } +\examples{ +system.file("extdata", "shoreline.zip", package="glatos") + +} \author{ Todd Hayden } diff --git a/man/video-images.Rd b/man/video-images.Rd index ca13d922..5263918f 100644 --- a/man/video-images.Rd +++ b/man/video-images.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/extdata.r -\name{video images} -\alias{video images} +\name{video-images} +\alias{video-images} \title{Video frames of walleye movements in Lake Huron} \format{ Folder contains 30 sequentially labeled .png image files @@ -9,9 +9,6 @@ Folder contains 30 sequentially labeled .png image files \source{ \url{http://glatos.glos.us/home/project/HECWL} } -\usage{ -system.file("extdata", "frames", package="glatos") -} \description{ Sequential images of walleye movements in Lake Huron for testing functionality of ffmpeg function. @@ -20,6 +17,10 @@ for testing functionality of ffmpeg function. frames } +\examples{ +system.file("extdata", "frames", package="glatos") + +} \author{ Todd Hayden } From 9735e5e9869dce90b12d78f5603d69317b3482fa Mon Sep 17 00:00:00 2001 From: mhpob Date: Mon, 13 May 2024 16:41:47 +0000 Subject: [PATCH 51/56] Style code (GHA) --- R/extdata.r | 8 ++++---- R/vis-make_frames.r | 16 ++++++++-------- R/vis-make_transition.r | 2 +- R/vis-position_heat_map.r | 2 +- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/extdata.r b/R/extdata.r index 9a6772d7..40c029b8 100644 --- a/R/extdata.r +++ b/R/extdata.r @@ -9,7 +9,7 @@ #' @section Filename: walleye_detections.zip #' #' @examples -#' system.file("extdata", "walleye_detections.zip", package="glatos") +#' system.file("extdata", "walleye_detections.zip", package = "glatos") #' #' @author Todd Hayden #' @@ -38,7 +38,7 @@ NULL #' @section Filename: SMRSL_GLATOS_20140828.xlsm #' #' @examples -#' system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package="glatos") +#' system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package = "glatos") #' #' @author Chris Holbrook #' @@ -58,7 +58,7 @@ NULL #' @section Filename: frames #' #' @examples -#' system.file("extdata", "frames", package="glatos") +#' system.file("extdata", "frames", package = "glatos") #' #' @author Todd Hayden #' @@ -78,7 +78,7 @@ NULL #' @section Filename: shoreline.zip #' #' @examples -#' system.file("extdata", "shoreline.zip", package="glatos") +#' system.file("extdata", "shoreline.zip", package = "glatos") #' #' @author Todd Hayden #' diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index ac0c95cf..12fc58f7 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -63,18 +63,18 @@ #' location points, receiver location points, timeline, and slider (moves along #' the timeline). See also **Details** and **Note** sections. #' -#' @details +#' @details #' ***To customize fish location points (from `proc_obj`):*** Add any argument #' that can be passed to [points][graphics::points]. The following values will #' create the default plot: #' \itemize{ #' \item `cex`: symbol size; default = 2 -#' \item `col`: symbol color; default = "blue" -#' \item `pch`: symbol type; default = 16 +#' \item `col`: symbol color; default = "blue" +#' \item `pch`: symbol type; default = 16 #' } -#' +#' #' @details -#' +#' #' ***To customize receiver location points (from `recs`):*** Add prefix #' `recs.` to any argument that can be passed to [points][graphics::points]. The #' following values will create the default plot: @@ -102,7 +102,7 @@ #' ratio of the plot device #' \item `timeline.cex.axis`: size of labels; default = 2 #' } -#' +#' #' ***To customize time slider (symbol that slides):*** Add prefix #' `timeline.` to any argument that can be passed to [points][graphics::points]. #' The following values will create the default plot: @@ -114,7 +114,7 @@ #' "grey20" #' \item `timeslider.pch`: a single value with symbol type; default = 21 #' } -#' +#' #' ***To customize parameters controlled by `par`:*** Add prefix #' `par.` to any argument that can be passed to [par][graphics::par]. Note that #' `par.mar` controls whitespace behind default timeslider. The following values @@ -134,7 +134,7 @@ #' dimensions (size), and other ouput video characteristics can be modified by #' calling [make_video()] directly. To do this, set `animate = FALSE` and then #' use [make_video()] to create a video from the resulting set of images. -#' +#' #' #' @return Sequentially-numbered png files (one for each frame) and one mp4 file #' will be written to `out_dir`. diff --git a/R/vis-make_transition.r b/R/vis-make_transition.r index 815fa79f..32fab3db 100644 --- a/R/vis-make_transition.r +++ b/R/vis-make_transition.r @@ -52,7 +52,7 @@ #' @return A list with two elements: #' \itemize{ #' \item `transition`: a geo-corrected transition raster layer where land = 0 -#' and water=1 (see `gdistance`) +#' and water=1 (see `gdistance`) #' \item `rast`: rasterized input layer of class `raster` #' } #' Additionally, rasterized version of input shapefile (*.tif extension) is diff --git a/R/vis-position_heat_map.r b/R/vis-position_heat_map.r index ce974ee1..4f882a6e 100644 --- a/R/vis-position_heat_map.r +++ b/R/vis-position_heat_map.r @@ -8,7 +8,7 @@ #' following 4 columns: #' \describe{ #' \item{`DETECTEDID`}{Individual animal identifier; character.} -#' \item{`DATETIME`}{Date-time stamps for the positions (MUST be of +#' \item{`DATETIME`}{Date-time stamps for the positions (MUST be of #' class 'POSIXct')} #' \item{`LAT`}{Position latitude.} #' \item{`LON`}{Position longitude.} From f2e4173db4c8f70c1b9abaa239bca4e7a2234690 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:58:24 -0400 Subject: [PATCH 52/56] add back global dot var --- R/package-glatos.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/package-glatos.r b/R/package-glatos.r index ea832dbb..dae821bb 100644 --- a/R/package-glatos.r +++ b/R/package-glatos.r @@ -125,6 +125,9 @@ #' tiff "_PACKAGE" +# avoid R CMD check note +globalVariables(".") + # package startup message .onAttach <- function(libname, pkgname) { packageStartupMessage(paste0( From 063848315655c39d80ba08018b6a808729cb7d11 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 12:58:44 -0400 Subject: [PATCH 53/56] example -> exampleS --- R/testdata.r | 4 ++-- man/flynn_island_transition.Rd | 4 ++++ man/higgins_lake_transition.Rd | 4 ++++ 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/testdata.r b/R/testdata.r index b490095e..24305dc0 100644 --- a/R/testdata.r +++ b/R/testdata.r @@ -10,7 +10,7 @@ #' #' @section Filename: higgins_lake_transition.rds #' -#' @example +#' @examples #' system.file("testdata", "higgins_lake_transition.rds", package = "glatos") #' #' @author Chris Holbrook @@ -29,7 +29,7 @@ NULL #' #' @section Filename: flynn_island_transition.rds #' -#' @example +#' @examples #' system.file("testdata", "flynn_island_transition.rds", package = "glatos") #' #' @author Chris Holbrook diff --git a/man/flynn_island_transition.Rd b/man/flynn_island_transition.Rd index a16969dc..18313a9e 100644 --- a/man/flynn_island_transition.Rd +++ b/man/flynn_island_transition.Rd @@ -15,6 +15,10 @@ A transition object, created from flynn_island_transition.rds } +\examples{ +system.file("testdata", "flynn_island_transition.rds", package = "glatos") + +} \author{ Chris Holbrook } diff --git a/man/higgins_lake_transition.Rd b/man/higgins_lake_transition.Rd index c6134093..f0383651 100644 --- a/man/higgins_lake_transition.Rd +++ b/man/higgins_lake_transition.Rd @@ -15,6 +15,10 @@ A transition object, created from higgins_lake_transition.rds } +\examples{ +system.file("testdata", "higgins_lake_transition.rds", package = "glatos") + +} \author{ Chris Holbrook } From 95529b844bc8eabe42fa32070c378cfe4f7819d5 Mon Sep 17 00:00:00 2001 From: mhpob Date: Mon, 13 May 2024 17:00:45 +0000 Subject: [PATCH 54/56] Update documentation --- man/raw_lamprey_workbook.Rd | 2 +- man/raw_walleye_detections.Rd | 2 +- man/shoreline.Rd | 2 +- man/video-images.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/man/raw_lamprey_workbook.Rd b/man/raw_lamprey_workbook.Rd index a6039806..408ab09a 100644 --- a/man/raw_lamprey_workbook.Rd +++ b/man/raw_lamprey_workbook.Rd @@ -27,7 +27,7 @@ project. } \examples{ -system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package="glatos") +system.file("extdata", "SMRSL_GLATOS_20140828.xlsm", package = "glatos") } \author{ diff --git a/man/raw_walleye_detections.Rd b/man/raw_walleye_detections.Rd index a51e07b3..66997f30 100644 --- a/man/raw_walleye_detections.Rd +++ b/man/raw_walleye_detections.Rd @@ -17,7 +17,7 @@ An example detection file } \examples{ -system.file("extdata", "walleye_detections.zip", package="glatos") +system.file("extdata", "walleye_detections.zip", package = "glatos") } \author{ diff --git a/man/shoreline.Rd b/man/shoreline.Rd index d753755a..1507dc5c 100644 --- a/man/shoreline.Rd +++ b/man/shoreline.Rd @@ -19,7 +19,7 @@ Huron), Maumee River (Lake Erie), and Sandusky River (Lake Erie) } \examples{ -system.file("extdata", "shoreline.zip", package="glatos") +system.file("extdata", "shoreline.zip", package = "glatos") } \author{ diff --git a/man/video-images.Rd b/man/video-images.Rd index 5263918f..88a11e43 100644 --- a/man/video-images.Rd +++ b/man/video-images.Rd @@ -18,7 +18,7 @@ for testing functionality of ffmpeg function. } \examples{ -system.file("extdata", "frames", package="glatos") +system.file("extdata", "frames", package = "glatos") } \author{ From 2816146e57e4c3299c8acb1747006750d11f80f3 Mon Sep 17 00:00:00 2001 From: Mike O'Brien Date: Mon, 13 May 2024 15:17:47 -0400 Subject: [PATCH 55/56] remove units dependency --- DESCRIPTION | 1 - R/vis-make_transition3.r | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7dc6ebb3..3ba82b60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,6 @@ Imports: sp, tibble, tidyr, - units, zip Suggests: gganimate, diff --git a/R/vis-make_transition3.r b/R/vis-make_transition3.r index 14f8cef7..069464b2 100644 --- a/R/vis-make_transition3.r +++ b/R/vis-make_transition3.r @@ -193,7 +193,7 @@ make_transition3 <- function(poly, res = c(0.1, 0.1), receiver_points = NULL, ep recs_gl <- sf::st_transform(receiver_points, crs = epsg) # determine shortest distance from receiver to water polygon - dist_rec <- units::drop_units(sf::st_distance(recs_gl, poly_gl)) + dist_rec <- as.matrix(sf::st_distance(recs_gl, poly_gl)) recs_gl$rec_water_dist <- apply(dist_rec, 1, "min") # extract rec_water_dist > 0 From e891debbc4b827adae231f97e045244f8f6571dc Mon Sep 17 00:00:00 2001 From: chrisholbrook Date: Wed, 14 Aug 2024 19:58:49 +0000 Subject: [PATCH 56/56] Update documentation --- DESCRIPTION | 2 +- man/summarize_detections.Rd | 117 +++++++++++++++++++----------------- 2 files changed, 64 insertions(+), 55 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7dc6ebb3..19026e21 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,7 +51,7 @@ Authors@R: c( License: GPL-2 LazyLoad: yes LazyData: true -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/man/summarize_detections.Rd b/man/summarize_detections.Rd index e0cbde40..76bf76ea 100644 --- a/man/summarize_detections.Rd +++ b/man/summarize_detections.Rd @@ -137,60 +137,69 @@ the output summary. } \examples{ -#get path to example detection file - det_file <- system.file("extdata", "walleye_detections.csv", - package = "glatos") - det <- read_glatos_detections(det_file) - - #Basic summaries - - # by animal - ds <- summarize_detections(det) - - # by location - ds <- summarize_detections(det, summ_type = "location") - - # by animal and location - ds <- summarize_detections(det, summ_type = "both") - - - #Include user-defined location_col - - # by animal - det$some_place <- ifelse(grepl("^S", det$glatos_array), "s", "not_s") - - ds <- summarize_detections(det, location_col = "some_place") - - # by location - ds <- summarize_detections(det, location_col = "some_place", - summ_type = "location") - - # by animal and location - ds <- summarize_detections(det, location_col = "some_place", - summ_type = "both") - - - #Include locations where no animals detected - - #get example receiver data - rec_file <- system.file("extdata", "sample_receivers.csv", - package = "glatos") - rec <- read_glatos_receivers(rec_file) - - ds <- summarize_detections(det, receiver_locs = rec, summ_type = "location") - - - #Include animals that were not detected - #get example animal data from walleye workbook - wb_file <- system.file("extdata", "walleye_workbook.xlsm", - package = "glatos") - wb <- read_glatos_workbook(wb_file) - - ds <- summarize_detections(det, animals = wb$animals, summ_type = "animal") - - #Include by animals and locations that were not detected - ds <- summarize_detections(det, receiver_locs = rec, animals = wb$animals, - summ_type = "both") +# get path to example detection file +det_file <- system.file("extdata", "walleye_detections.csv", + package = "glatos" +) +det <- read_glatos_detections(det_file) + +# Basic summaries + +# by animal +ds <- summarize_detections(det) + +# by location +ds <- summarize_detections(det, summ_type = "location") + +# by animal and location +ds <- summarize_detections(det, summ_type = "both") + + +# Include user-defined location_col + +# by animal +det$some_place <- ifelse(grepl("^S", det$glatos_array), "s", "not_s") + +ds <- summarize_detections(det, location_col = "some_place") + +# by location +ds <- summarize_detections(det, + location_col = "some_place", + summ_type = "location" +) + +# by animal and location +ds <- summarize_detections(det, + location_col = "some_place", + summ_type = "both" +) + + +# Include locations where no animals detected + +# get example receiver data +rec_file <- system.file("extdata", "sample_receivers.csv", + package = "glatos" +) +rec <- read_glatos_receivers(rec_file) + +ds <- summarize_detections(det, receiver_locs = rec, summ_type = "location") + + +# Include animals that were not detected +# get example animal data from walleye workbook +wb_file <- system.file("extdata", "walleye_workbook.xlsm", + package = "glatos" +) +wb <- read_glatos_workbook(wb_file) + +ds <- summarize_detections(det, animals = wb$animals, summ_type = "animal") + +# Include by animals and locations that were not detected +ds <- summarize_detections(det, + receiver_locs = rec, animals = wb$animals, + summ_type = "both" +) } \author{