diff --git a/.Rbuildignore b/.Rbuildignore index 3fb97925..c6b10c45 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,11 +1,12 @@ ^Meta$ ^doc$ -ReadMe.md -CONTRIBUTING.md -glatos.pdf +^ReadMe\.md$ +^CONTRIBUTING\.md$ +^glatos\.pdf$ ^data-raw$ ^.*\.Rproj$ ^\.Rproj\.user$ ^README\.Rmd$ ^README-.*\.png$ ^\.github$ +^R/util-intern_pkg_man\.r$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index eb1a694f..96316318 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,7 +29,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -47,3 +47,4 @@ jobs: - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true + error-on: '"error"' diff --git a/.github/workflows/document.yaml b/.github/workflows/document.yaml index 6c118dde..8ac7bab3 100644 --- a/.github/workflows/document.yaml +++ b/.github/workflows/document.yaml @@ -13,7 +13,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - name: Checkout repo - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml index 71f335b3..f3267b87 100644 --- a/.github/workflows/pr-commands.yaml +++ b/.github/workflows/pr-commands.yaml @@ -14,7 +14,7 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/pr-fetch@v2 with: diff --git a/.github/workflows/style.yaml b/.github/workflows/style.yaml index bee3e482..6eea13f3 100644 --- a/.github/workflows/style.yaml +++ b/.github/workflows/style.yaml @@ -13,7 +13,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - name: Checkout repo - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 diff --git a/DESCRIPTION b/DESCRIPTION index 1fad99af..febe6f14 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,38 +2,40 @@ Package: glatos Type: Package Title: A package for the Great Lakes Acoustic Telemetry Observation System Description: Functions useful to members of the Great Lakes Acoustic Telemetry Observation System https://glatos.glos.us; many more broadly relevant to simulating, processing, analysing, and visualizing acoustic telemetry data. -Version: 0.8.0.9000 -Date: 2024-01-04 +Version: 0.8.0.9004 +Date: 2024-02-16 Depends: R (>= 3.5.0) Imports: av, data.table, dplyr, fasterize, - fasttime, gdalUtilities, geodist, gdistance, geosphere, jsonlite, - knitr, lubridate, magrittr, - methods, plotrix, purrr, raster, readxl, - rmarkdown, sf, sp, tibble, - tidyr + tidyr, + units, + zip Suggests: gganimate, gifski, + knitr, + methods, png, - testthat (>= 3.0.0), + rmarkdown, + terra, + testthat (>= 3.0.0), tint URL: https://github.com/ocean-tracking-network/glatos BugReports: https://github.com/ocean-tracking-network/glatos/issues @@ -49,7 +51,7 @@ Authors@R: c( License: GPL-2 LazyLoad: yes LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/NEWS.md b/NEWS.md index 1300a864..e82042cd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,22 @@ +---- # glatos 0.8.0 (dev) -### Bug fixes +### Bug fixes and minor changes + +- Add `@srs` slot to `greatLakesTrLayer` data object and rename file + 'data/greatLakesTrLayer.rda'. + - fixes [issue #213](https://github.com/ocean-tracking-network/glatos/issues/213) + +- Fix bug in `read_glatos_workbook()` where timestamps during daylight savings + were shifted one hour on linux operating system (not an issue on windows or + mac). + - fixes [issue #208](https://github.com/ocean-tracking-network/glatos/issues/208) + +- Omit data.table from class of object returned by `read_glatos_detections()` + and `read_glatos_receivers()`. + - fixes [issue #200](https://github.com/ocean-tracking-network/glatos/issues/200) - Fix typo in Description to Suggest 'gifski' (not 'gifsky'). - fixes [issue #185](https://github.com/ocean-tracking-network/glatos/issues/185) @@ -10,6 +24,13 @@ ### New features +#### 2024-01-19 + +- In `make_frames()`, allow `terra::SpatVector` input for background map + (`bg_map` arg). + - add test for `terra::SpatVector` input + + #### 2023-08-30 - Add new functions to create, check, and validate `glatos_animals` objects: @@ -62,6 +83,20 @@ using VDAT.exe (e.g., using `vdat_convert()`). +---- + +# glatos 0.7.1 (2024-01-19) + + +### Bug fixes and minor changes + + +- Fix bug introduced in glatos 0.7.0 where x and y limits were switched + when `bg_map` was supplied. + - Add test for various inputs of `background_xlim`, `background_ylim`, and + `bg_map` to function `make_frames`. + + ---- # glatos 0.7.0 (2024-01-04) diff --git a/R/class-glatos_animals.r b/R/class-glatos_animals.r index 998b0b5d..a2de0ad5 100644 --- a/R/class-glatos_animals.r +++ b/R/class-glatos_animals.r @@ -71,6 +71,8 @@ #' ga_tbl <- as_glatos_animals(x_tbl) #' #' +#' # All below will error as invalid +#' #' # data.frame input; missing column name #' library(dplyr) # for rename #' x2 <- rename(x, @@ -78,17 +80,19 @@ #' release_timestamp = utc_release_date_time #' ) #' -#' ga2 <- as_glatos_animals(x2) -#' +#' try( +#' ga2 <- as_glatos_animals(x2) +#' ) #' -#' # data.grame input; wrong column class +#' # data.frame input; wrong column class #' x3 <- mutate(x, #' animal_id = as.integer(animal_id), #' utc_release_date_time = as.character(utc_release_date_time) #' ) #' -#' ga3 <- as_glatos_animals(x3) -#' +#' try( +#' ga3 <- as_glatos_animals(x3) +#' ) #' #' # Validation and checking #' diff --git a/R/class-glatos_detections.r b/R/class-glatos_detections.r index 5905bcb5..3856b770 100644 --- a/R/class-glatos_detections.r +++ b/R/class-glatos_detections.r @@ -73,6 +73,8 @@ #' gd_tbl <- as_glatos_detections(x_tbl) #' #' +#' # All below will error as invalid +#' #' # data.frame input; missing column name #' library(dplyr) # for rename #' x2 <- rename(x, @@ -80,8 +82,9 @@ #' det_date_time = detection_timestamp_utc #' ) #' -#' gd2 <- as_glatos_detections(x2) -#' +#' try( +#' gd2 <- as_glatos_detections(x2) +#' ) #' #' # data.frame input; wrong column class #' x3 <- mutate(x, @@ -89,8 +92,9 @@ #' detection_timestamp_utc = as.character(detection_timestamp_utc) #' ) #' -#' gr3 <- as_glatos_detections(x3) -#' +#' try( +#' gr3 <- as_glatos_detections(x3) +#' ) #' #' # Validation and checking #' diff --git a/R/class-glatos_receivers.r b/R/class-glatos_receivers.r index 3d0b3786..d8f6c39a 100644 --- a/R/class-glatos_receivers.r +++ b/R/class-glatos_receivers.r @@ -86,6 +86,7 @@ #' #' gr_tbl <- as_glatos_receivers(x_tbl) #' +#' # All below will error as invalid #' #' # data.frame input; missing column name #' library(dplyr) # for rename @@ -94,8 +95,9 @@ #' deploy_timestamp = deploy_date_time #' ) #' -#' gr2 <- as_glatos_receivers(x2) -#' +#' try( +#' gr2 <- as_glatos_receivers(x2) +#' ) #' #' # data.frame input; wrong column class #' x3 <- mutate(x, @@ -103,8 +105,9 @@ #' deploy_date_time = as.character(deploy_date_time) #' ) #' -#' gr3 <- as_glatos_receivers(x3) -#' +#' try( +#' gr3 <- as_glatos_receivers(x3) +#' ) #' #' # Validation and checking #' diff --git a/R/load-read_glatos_detections.r b/R/load-read_glatos_detections.r index 7ca5151e..a4b3d9f1 100644 --- a/R/load-read_glatos_detections.r +++ b/R/load-read_glatos_detections.r @@ -53,9 +53,9 @@ read_glatos_detections <- function(det_file, version = NULL) { # Identify detection file version id_det_version <- function(det_file) { det_col_names <- names(data.table::fread(det_file, nrows = 0)) - if (all(glatos:::glatos_detection_schema$v1.4$name %in% det_col_names)) { + if (all(glatos_detection_schema$v1.4$name %in% det_col_names)) { return("1.4") - } else if (all(glatos:::glatos_detection_schema$v1.3$name %in% det_col_names)) { + } else if (all(glatos_detection_schema$v1.3$name %in% det_col_names)) { return("1.3") } else { stop("Detection file version could not be identified.") @@ -65,7 +65,7 @@ read_glatos_detections <- function(det_file, version = NULL) { if (is.null(version)) { version <- id_det_version(det_file) } else if (!(paste0("v", version) %in% - names(glatos:::glatos_detection_schema))) { + names(glatos_detection_schema))) { stop(paste0("Detection file version ", version, " is not supported.")) } @@ -73,7 +73,7 @@ read_glatos_detections <- function(det_file, version = NULL) { if (version %in% c("1.3", "1.4")) { vversion <- paste0("v", version) - col_classes <- glatos:::glatos_detection_schema[[vversion]]$type + col_classes <- glatos_detection_schema[[vversion]]$type timestamp_cols <- which(col_classes == "POSIXct") date_cols <- which(col_classes == "Date") col_classes[c(timestamp_cols, date_cols)] <- "character" @@ -89,9 +89,9 @@ read_glatos_detections <- function(det_file, version = NULL) { options(lubridate.fasttime = TRUE) for (j in timestamp_cols) { data.table::set(dtc, - j = glatos:::glatos_detection_schema[[vversion]]$name[j], + j = glatos_detection_schema[[vversion]]$name[j], value = lubridate::parse_date_time( - dtc[[glatos:::glatos_detection_schema[[vversion]]$name[j]]], + dtc[[glatos_detection_schema[[vversion]]$name[j]]], orders = "ymd HMS", tz = "UTC" ) @@ -100,15 +100,15 @@ read_glatos_detections <- function(det_file, version = NULL) { # coerce dates to date for (j in date_cols) { data.table::set(dtc, - j = glatos:::glatos_detection_schema[[vversion]]$name[j], - value = ifelse(dtc[[glatos:::glatos_detection_schema[[vversion]]$name[j]]] == "", + j = glatos_detection_schema[[vversion]]$name[j], + value = ifelse(dtc[[glatos_detection_schema[[vversion]]$name[j]]] == "", NA, - dtc[[glatos:::glatos_detection_schema[[vversion]]$name[j]]] + dtc[[glatos_detection_schema[[vversion]]$name[j]]] ) ) data.table::set(dtc, - j = glatos:::glatos_detection_schema[[vversion]]$name[j], - value = as.Date(dtc[[glatos:::glatos_detection_schema[[vversion]]$name[j]]]) + j = glatos_detection_schema[[vversion]]$name[j], + value = as.Date(dtc[[glatos_detection_schema[[vversion]]$name[j]]]) ) } } @@ -128,7 +128,9 @@ read_glatos_detections <- function(det_file, version = NULL) { )) } - # assign class + # strip data.table and assign glatos_detections class + data.table::setDF(dtc) + dtc <- as_glatos_detections(dtc) return(dtc) diff --git a/R/load-read_glatos_receivers.r b/R/load-read_glatos_receivers.r index 1a184aaa..5b45e328 100644 --- a/R/load-read_glatos_receivers.r +++ b/R/load-read_glatos_receivers.r @@ -49,9 +49,9 @@ read_glatos_receivers <- function(rec_file, version = NULL) { # Identify file version id_file_version <- function(rec_file) { col_names <- names(data.table::fread(rec_file, nrows = 0)) - if (all(glatos:::glatos_receivers_schema$v1.1$name %in% col_names)) { + if (all(glatos_receivers_schema$v1.1$name %in% col_names)) { return("1.1") - } else if (all(glatos:::glatos_receivers_schema$v1.0$name %in% col_names)) { + } else if (all(glatos_receivers_schema$v1.0$name %in% col_names)) { return("1.0") } else { stop("Receiver location file version could not be identified.") @@ -61,7 +61,7 @@ read_glatos_receivers <- function(rec_file, version = NULL) { if (is.null(version)) { version <- id_file_version(rec_file) } else if (!(paste0("v", version) %in% - names(glatos:::glatos_receivers_schema))) { + names(glatos_receivers_schema))) { stop(paste0( "Receiver locations file version ", version, " is not supported." @@ -72,7 +72,7 @@ read_glatos_receivers <- function(rec_file, version = NULL) { if (version %in% c("1.0", "1.1")) { ver_txt <- paste0("v", version) - col_classes <- glatos:::glatos_receivers_schema[[ver_txt]]$type + col_classes <- glatos_receivers_schema[[ver_txt]]$type timestamp_cols <- which(col_classes == "POSIXct") date_cols <- which(col_classes == "Date") col_classes[c(timestamp_cols, date_cols)] <- "character" @@ -109,7 +109,9 @@ read_glatos_receivers <- function(rec_file, version = NULL) { } #-end v1.x---------------------------------------------------------------- - # assign class + # strip data.table and assign glatos_receivers class + data.table::setDF(rec) + rec <- as_glatos_receivers(rec) return(rec) diff --git a/R/load-read_glatos_workbook.r b/R/load-read_glatos_workbook.r index 5aa93219..b8ea3866 100644 --- a/R/load-read_glatos_workbook.r +++ b/R/load-read_glatos_workbook.r @@ -93,6 +93,8 @@ #' wb <- read_glatos_workbook(wb_file) #' #' @export + + read_glatos_workbook <- function( wb_file, read_all = FALSE, wb_version = NULL) { @@ -107,7 +109,7 @@ read_glatos_workbook <- function( # Identify workbook version (based on sheet names) id_workbook_version <- function(wb_file, sheets) { - if (all(names(glatos:::glatos_workbook_schema$v1.3) %in% sheets)) { + if (all(names(glatos_workbook_schema$v1.3) %in% sheets)) { return("1.3") } else { stop(paste0( @@ -122,7 +124,7 @@ read_glatos_workbook <- function( if (is.null(wb_version)) { wb_version <- id_workbook_version(wb_file, sheets) } else if (!(paste0("v", wb_version) %in% - names(glatos:::glatos_workbook_schema))) { + names(glatos_workbook_schema))) { stop(paste0("Workbook version ", wb_version, " is not supported.")) } @@ -132,7 +134,7 @@ read_glatos_workbook <- function( #-Workbook v1.3-------------------------------------------------------------- if (wb_version == "1.3") { - wb[names(glatos:::glatos_workbook_schema$v1.3)] <- NA + wb[names(glatos_workbook_schema$v1.3)] <- NA # Get project data tmp <- tryCatch( @@ -168,18 +170,18 @@ read_glatos_workbook <- function( # Read all sheets except project if (read_all) { sheets_to_read <- sheets - extra_sheets <- setdiff(sheets, names(glatos:::glatos_workbook_schema[[ + extra_sheets <- setdiff(sheets, names(glatos_workbook_schema[[ paste0("v", wb_version) ]])) } else { - sheets_to_read <- names(glatos:::glatos_workbook_schema[[ + sheets_to_read <- names(glatos_workbook_schema[[ paste0("v", wb_version) ]]) } sheets_to_read <- setdiff(sheets_to_read, "project") # exclude project for (i in 1:length(sheets_to_read)) { - schema_i <- glatos:::glatos_workbook_schema[[ + schema_i <- glatos_workbook_schema[[ paste0("v", wb_version) ]][[sheets_to_read[i]]] @@ -325,9 +327,12 @@ read_glatos_workbook <- function( rows_k <- tzone_j %in% tz_cmd[k] # get rows with kth tz # round to nearest minute and force to correct timezone posix_as_num[rows_k] <- as.POSIXct( - round( - posix_as_num[rows_k], - "mins" + format( + round( + posix_as_num[rows_k], + "mins" + ), + "%Y-%m-%d %H:%M", ), tz = tz_cmd[k] ) @@ -527,7 +532,7 @@ read_glatos_workbook <- function( # assign classes wb2$animals <- as_glatos_animals(wb2$animals) wb2$receivers <- as_glatos_receivers(wb2$receivers) - wb2 <- glatos:::glatos_workbook(wb2) + wb2 <- glatos_workbook(wb2) return(wb2) } diff --git a/R/load-read_otn_deployments.R b/R/load-read_otn_deployments.R index 774d4c0e..5f4aa9d7 100644 --- a/R/load-read_otn_deployments.R +++ b/R/load-read_otn_deployments.R @@ -31,11 +31,13 @@ #' @author A. Nunes, \email{anunes@dal.ca} #' #' @examples +#' \dontrun{ #' # get path to example deployments file #' deployment_file <- system.file("extdata", "hfx_deployments.csv", #' package = "glatos" #' ) #' dep <- read_otn_deployments(deployment_file) +#' } #' #' @importFrom lubridate parse_date_time #' @importFrom tidyr extract diff --git a/R/load-read_vdat_csv.r b/R/load-read_vdat_csv.r index d673dc18..ccc3230a 100644 --- a/R/load-read_vdat_csv.r +++ b/R/load-read_vdat_csv.r @@ -1,260 +1,289 @@ -#' 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. -#' -#' @param record_types An optional vector of character strings with names of -#' record types to read from the file. E.g., "DET" for detection records. -#' Default (\code{NULL}) will read all record types present in input CSV -#' \code{src}. -#' -#' @param show_progress Optional argument passed to \code{data.table::fread}'s -#' \code{showProgress}. -#' -#' @details Reading is done via \code{\link[data.table]{fread}}. -#' -#' @details All timestamp columns are assumed to be in UTC and are assigned -#' class \code{POSIXct}. The internal value of timestamps will include -#' fractional seconds but the printed value (i.e., displayed or written to -#' file) will be truncated according to \code{options()$digits.secs}. By -#' default (\code{options()$digits.secs = NULL}), values are truncated (i.e., -#' rounded down) to the nearest second. To maintain the full resolution -#' present in the input Fathom CSV file, set \code{options(digits.secs = 6)}. -#' -#' @return A list of class \code{vdat_list} with one named element for each -#' record type and attributes: \code{fathom_csv_format_version} with version -#' of the input Fathom CSV format; \code{source} with version of -#' VDAT.exe used to create the input file. -#' -#' -#' @author C. Holbrook (cholbrook@@usgs.gov) -#' -#' @examples -#' -#' # Example 1. Read a single file -#' -#' vrl_file <- system.file("extdata", "detection_files_raw", -#' "VR2W_109924_20110718_1.vrl", package="glatos") -#' -#' temp_dir <- tempdir() -#' -#' csv_file <- vdat_convert(vrl_file, out_dir = temp_dir) -#' -#' #utils::browseURL(temp_dir) -#' -#' #read all record types -#' vdat <- read_vdat_csv(csv_file) -#' -#' #read only one record type -#' vdat <- read_vdat_csv(csv_file, record_types = c("DET")) -#' -#' -#' # Example 2. Read and combine detection records from multiple files -#' -#' # get two example files -#' vrl_files <- system.file("extdata", "detection_files_raw", -#' c("VR2W_109924_20110718_1.vrl", -#' "HR2-180 461396 2021-04-20 173145.vdat"), -#' package="glatos") -#' -#' csv_files <- vdat_convert(vrl_files, out_dir = temp_dir) -#' -#' -#' # using dplyr -#' -#' library(dplyr) -#' -#' # basic steps: import each to list element, subset DET records, -#' add column with source file name, combine. -#' -#' det2_tbl <- csv_files %>% -#' lapply( -#' function(x) { -#' read_vdat_csv(x, record_types = "DET")$DET %>% -#' as_tibble %>% -#' mutate(source_file = basename(x)) -#' }) %>% -#' bind_rows -#' -#' -#' #using data.table -#' -#' library(data.table) -#' -#' det2_dt <- rbindlist( -#' lapply(csv_files, -#' function(x) { -#' read_vdat_csv(x, record_types = "DET")$DET[, -#' source_file := basename(x)] -#' })) -#' -#' \dontrun{ -#' -#' # get current version of digits.secs -#' op_digits.secs <- options()$digits.secs -#' -#' # set digits.secs = NULL (default, truncates to nearest second) -#' options(digits.secs = NULL) -#' -#' # note truncation to nearest second -#' vdat$DET$Time[2] -#' -#' # set digits.secs to see fractional seconds -#' options(digits.secs = 6) -#' -#' # note fractional seconds -#' vdat$DET$Time[2] -#' -#' # return to default values -#' options(digits.secs = op_digits.secs) -#' -#' # or specify via format %OSn e.g., when writing to disk or external database -#' # see ?strptime -#' format(vdat$DET$Time[2], format = "%Y-%m-%d %H:%M:%OS6") -#' -#' } -#' -#' @export -read_vdat_csv <- function(src, - record_types = NULL, - show_progress = FALSE){ - - #Check if exists - if(!file.exists(src)){ - warning("File not found: ", src) - return() - } - - #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 - src_version <- data.table::data.table(fathom_csv = vdat_header$V2[1], - vdat_exe = vdat_header$V3[1]) - } else if (all(c("Receiver", - "Transmitter", - "Transmitter Name", - "Transmitter Serial", - "Sensor Value", - "Sensor Unit", - "Station Name", - "Latitude", - "Longitude") %in% - 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, - skip = 2, - header = FALSE, - sep = ",", - select = 1, - 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 = ", ")) - } - - #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) - - data(vdat_csv_schema) - - vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] - - - # Preallocate list; element = record type - vdat <- 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"), - sep = ",", na.strings = "", - colClasses = "character", - header = TRUE, - 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] - } - - # POSIXct - timestamp_cols <- schema_i$name[schema_i$type == "POSIXct"] - - if(length(timestamp_cols) > 0){ - vdat[[i]][, (timestamp_cols) := lapply(.SD, - function(x) - lubridate::fast_strptime( - x, - format = "%Y-%m-%d %H:%M:%OS", - lt = FALSE)), - .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) - - return(vdat_list) -} - \ No newline at end of file +#' 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. +#' +#' @param record_types An optional vector of character strings with names of +#' record types to read from the file. E.g., "DET" for detection records. +#' Default (\code{NULL}) will read all record types present in input CSV +#' \code{src}. +#' +#' @param show_progress Optional argument passed to \code{data.table::fread}'s +#' \code{showProgress}. +#' +#' @details Reading is done via \code{\link[data.table]{fread}}. +#' +#' @details All timestamp columns are assumed to be in UTC and are assigned +#' class \code{POSIXct}. The internal value of timestamps will include +#' fractional seconds but the printed value (i.e., displayed or written to +#' file) will be truncated according to \code{options()$digits.secs}. By +#' default (\code{options()$digits.secs = NULL}), values are truncated (i.e., +#' rounded down) to the nearest second. To maintain the full resolution +#' present in the input Fathom CSV file, set \code{options(digits.secs = 6)}. +#' +#' @return A list of class \code{vdat_list} with one named element for each +#' record type and attributes: \code{fathom_csv_format_version} with version +#' of the input Fathom CSV format; \code{source} with version of +#' VDAT.exe used to create the input file. +#' +#' +#' @author C. Holbrook (cholbrook@@usgs.gov) +#' +#' @examples +#' \dontrun{ +#' # Example 1. Read a single file +#' +#' vrl_file <- system.file("extdata", "detection_files_raw", +#' "VR2W_109924_20110718_1.vrl", +#' package = "glatos" +#' ) +#' +#' temp_dir <- tempdir() +#' +#' csv_file <- vdat_convert(vrl_file, out_dir = temp_dir) +#' +#' # utils::browseURL(temp_dir) +#' +#' # read all record types +#' vdat <- read_vdat_csv(csv_file) +#' +#' # read only one record type +#' vdat <- read_vdat_csv(csv_file, record_types = c("DET")) +#' +#' +#' # Example 2. Read and combine detection records from multiple files +#' +#' # get two example files +#' vrl_files <- system.file("extdata", "detection_files_raw", +#' c( +#' "VR2W_109924_20110718_1.vrl", +#' "HR2-180 461396 2021-04-20 173145.vdat" +#' ), +#' package = "glatos" +#' ) +#' +#' csv_files <- vdat_convert(vrl_files, out_dir = temp_dir) +#' +#' +#' # using dplyr +#' +#' library(dplyr) +#' +#' # basic steps: import each to list element, subset DET records, +#' # add column with source file name, combine. +#' +#' det2_tbl <- csv_files %>% +#' lapply( +#' function(x) { +#' read_vdat_csv(x, record_types = "DET")$DET %>% +#' as_tibble() %>% +#' mutate(source_file = basename(x)) +#' } +#' ) %>% +#' bind_rows() +#' +#' +#' # using data.table +#' +#' library(data.table) +#' +#' det2_dt <- rbindlist( +#' lapply( +#' csv_files, +#' function(x) { +#' read_vdat_csv(x, record_types = "DET")$DET[ +#' , +#' source_file := basename(x) +#' ] +#' } +#' ) +#' ) +#' +#' +#' # get current version of digits.secs +#' op_digits.secs <- options()$digits.secs +#' +#' # set digits.secs = NULL (default, truncates to nearest second) +#' options(digits.secs = NULL) +#' +#' # note truncation to nearest second +#' vdat$DET$Time[2] +#' +#' # set digits.secs to see fractional seconds +#' options(digits.secs = 6) +#' +#' # note fractional seconds +#' vdat$DET$Time[2] +#' +#' # return to default values +#' options(digits.secs = op_digits.secs) +#' +#' # or specify via format %OSn e.g., when writing to disk or external database +#' # see ?strptime +#' format(vdat$DET$Time[2], format = "%Y-%m-%d %H:%M:%OS6") +#' } +#' +#' @export +read_vdat_csv <- function(src, + record_types = NULL, + show_progress = FALSE) { + # Check if exists + if (!file.exists(src)) { + warning("File not found: ", src) + return() + } + + # 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 + src_version <- data.table::data.table( + fathom_csv = vdat_header$V2[1], + vdat_exe = vdat_header$V3[1] + ) + } else if (all(c( + "Receiver", + "Transmitter", + "Transmitter Name", + "Transmitter Serial", + "Sensor Value", + "Sensor Unit", + "Station Name", + "Latitude", + "Longitude" + ) %in% + 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, + skip = 2, + header = FALSE, + sep = ",", + select = 1, + 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 = ", " + ) + ) + } + } + + # 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 + ) + + data(vdat_csv_schema) + + vdat_csv_schema <- vdat_csv_schema[[paste0("v", src_version$fathom_csv)]] + + + # Preallocate list; element = record type + vdat <- 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" + ), + sep = ",", na.strings = "", + colClasses = "character", + header = TRUE, + 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 + ] + } + + # POSIXct + timestamp_cols <- schema_i$name[schema_i$type == "POSIXct"] + + if (length(timestamp_cols) > 0) { + vdat[[i]][, (timestamp_cols) := lapply( + .SD, + function(x) { + lubridate::fast_strptime( + x, + format = "%Y-%m-%d %H:%M:%OS", + lt = FALSE + ) + } + ), + .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 + ) + + return(vdat_list) +} diff --git a/R/load-write_vdat_csv.r b/R/load-write_vdat_csv.r index d804f96c..6ffd201d 100644 --- a/R/load-write_vdat_csv.r +++ b/R/load-write_vdat_csv.r @@ -44,6 +44,7 @@ #' @author C. Holbrook (cholbrook@@usgs.gov) #' #' @examples +#' \dontrun{ #' #' # Example 1. Read and write a single file #' @@ -66,7 +67,7 @@ #' #' # write to multiple files #' write_vdat_csv(vdat, output_format = "csv.fathom.split") -#' +#' } #' @export write_vdat_csv <- function(vdat, record_types = NULL, diff --git a/R/sim-calc_collision_prob.r b/R/sim-calc_collision_prob.r index 93d2538f..158febc6 100644 --- a/R/sim-calc_collision_prob.r +++ b/R/sim-calc_collision_prob.r @@ -1,28 +1,28 @@ #' Estimate probability of collision for telemetry transmitters -#' -#' Estimate (by simulation) probability of collision for co-located telemetry -#' transmitters with pulse-period-modulation type encoding #' -#' @param delayRng A 2-element numeric vector with minimum and maximum delay +#' Estimate (by simulation) probability of collision for co-located telemetry +#' transmitters with pulse-period-modulation type encoding +#' +#' @param delayRng A 2-element numeric vector with minimum and maximum delay #' (time in seconds from end of one coded burst to beginning of next). -#' -#' @param burstDur A numeric scalar with duration (in seconds) of each coded +#' +#' @param burstDur A numeric scalar with duration (in seconds) of each coded #' burst (i.e., pulse train). -#' -#' @param maxTags A numeric scalar with maximum number of co-located +#' +#' @param maxTags A numeric scalar with maximum number of co-located #' transmitters (within detection range at same time). -#' -#' @param nTrans A numeric scalar with the number of transmissions to simulate +#' +#' @param nTrans A numeric scalar with the number of transmissions to simulate #' for each co-located transmitter. #' #' @details #' Calculates the detection probability associated with collision, given delay -#' range (delayRng), burst duration (burstDur), maximum number of co-located +#' range (delayRng), burst duration (burstDur), maximum number of co-located #' tags (maxTags), and number of simulated transmission per tag (nTrans). The #' simulation estimates detection probability due only to collisions (i.e., when -#' no other variables influence detection probability) and assuming that all +#' no other variables influence detection probability) and assuming that all #' tags are co-located at a receiver for the duration of the simulation. -#' +#' #' @return A data frame containing summary statistics: #' \item{nTags}{Number of tags within detection range at one time} #' \item{min}{Minimum detection probability among simulated tags} @@ -31,12 +31,12 @@ #' \item{q3}{Third quartile of detection probabilities among simulated tags} #' \item{max}{Maximum detection probability among simulated tags} #' \item{mean}{Mean detection probability among simulated tags} -#' \item{expDetsPerHr}{Expected number of detections per hour assuming -#' perfect detection probability, given the number of tags within +#' \item{expDetsPerHr}{Expected number of detections per hour assuming +#' perfect detection probability, given the number of tags within #' detection range} -#' \item{totDetsPerHr}{Observed number of detections per hour for a given +#' \item{totDetsPerHr}{Observed number of detections per hour for a given #' number of tags} -#' \item{effDelay}{Eeffective delay of the transmitter after incorporating +#' \item{effDelay}{Eeffective delay of the transmitter after incorporating #' collisions} #' \item{detsPerTagPerHr}{Mean number of detections per hour per tag} @@ -50,77 +50,86 @@ #' @author C. Holbrook (cholbrook@usgs.gov) and T. Binder #' #' @examples -#' #parameters analagous to Vemco tag, global coding, 45 s nominal delay -#' foo <- calc_collision_prob(delayRng = c(45, 90), burstDur = 5.12, maxTags = 50, -#' nTrans = 10000) -#' -#' #plot probabilities of detection -#' plot(med~nTags, data=foo, type='p', pch=20, ylim=c(0,1), -#' b -#' -#' #plot probability of collision by subtracting detection probability from 1 -#' plot((1 - med)~nTags, data=foo, type='p', pch=20, ylim=c(0,1), -#' xlab="# of transmitters within range", ylab="Probability of collision") +#' # parameters analagous to Vemco tag, global coding, 45 s nominal delay +#' foo <- calc_collision_prob( +#' delayRng = c(45, 90), burstDur = 5.12, maxTags = 50, +#' nTrans = 10000 +#' ) +#' +#' # plot probabilities of detection +#' plot(med ~ nTags, +#' data = foo, type = "p", pch = 20, ylim = c(0, 1), +#' xlab = "# of transmitters within range", ylab = "Probability of detection" +#' ) +#' +#' # plot probability of collision by subtracting detection probability from 1 +#' plot((1 - med) ~ nTags, +#' data = foo, type = "p", pch = 20, ylim = c(0, 1), +#' xlab = "# of transmitters within range", ylab = "Probability of collision" +#' ) #' #' @export -calc_collision_prob = function(delayRng = c(60, 180), burstDur = 5.0, - maxTags = 50, nTrans = 10000) - { +calc_collision_prob <- function( + delayRng = c(60, 180), burstDur = 5.0, + maxTags = 50, nTrans = 10000) { + # preallocate objects - # preallocate objects - # transmission history (before collisions) - pingHist <- vector("list", length = maxTags) - # list of logical value; indicates collision - collide <- vector("list", length = maxTags) - # preallocate - detProbs <- data.frame(nTags= 1:maxTags, min= NA, q1= NA, med= NA, q3= NA, - max= NA, mean= NA) - # observed detection history (after collisions) - pingHistObs <- vector("list", length = maxTags) + pingHist <- vector("list", length = maxTags) + # list of logical value; indicates collision + collide <- vector("list", length = maxTags) + # preallocate + detProbs <- data.frame( + nTags = 1:maxTags, min = NA, q1 = NA, med = NA, q3 = NA, + max = NA, mean = NA + ) + # observed detection history (after collisions) + pingHistObs <- vector("list", length = maxTags) # define transmission and detection histories for each tag - for (i in 1:maxTags){ - #create transmission history; each list element is a tag, - # odd ind = start, even ind = end - # draw transmissions from uniform distribution within delayRng - #random start time - pingStart <- cumsum(runif(nTrans, delayRng[1], delayRng[2])+burstDur) + for (i in 1:maxTags) { + # create transmission history; each list element is a tag, + # odd ind = start, even ind = end + # draw transmissions from uniform distribution within delayRng + # random start time + pingStart <- cumsum(runif(nTrans, delayRng[1], delayRng[2]) + burstDur) pingHist[[i]] <- sort(c(pingStart, pingStart + burstDur)) - - if(i==1) detProbs[i,] <- c(i, rep(1,6)) - if(i>1){ # check to see if collided with any previous tag - for(j in 1:(i-1)) { - #check to see if ith tag transmissions overlaps + + if (i == 1) detProbs[i, ] <- c(i, rep(1, 6)) + if (i > 1) { # check to see if collided with any previous tag + for (j in 1:(i - 1)) { + # check to see if ith tag transmissions overlaps # with any jth tag transmissions - pingInts <- findInterval(pingHist[[i]], pingHist[[j]]) - - #identify collisions (TRUE) or nonCollisions (FALSE) - collisions <- (pingInts/2) != floor(pingInts/2) - - collide[[j]] <- unique(c(collide[[j]], ceiling(pingInts[collisions]/2))) - collide[[i]] <- unique(c(collide[[i]], - ceiling(row(as.matrix(collisions))[collisions]/2))) + pingInts <- findInterval(pingHist[[i]], pingHist[[j]]) + + # identify collisions (TRUE) or nonCollisions (FALSE) + collisions <- (pingInts / 2) != floor(pingInts / 2) + + collide[[j]] <- unique(c(collide[[j]], ceiling(pingInts[collisions] / 2))) + collide[[i]] <- unique(c( + collide[[i]], + ceiling(row(as.matrix(collisions))[collisions] / 2) + )) } - - detProb.k <- 1 - (sapply(collide[1:i], length)/ - (sapply(pingHist[1:i], length)/2)) - - detProbs[i,2:7] <- c(fivenum(detProb.k), mean(detProb.k)) - } #end if - - detProbs <- round(detProbs, 3) - } #end i - + + detProb.k <- 1 - (sapply(collide[1:i], length) / + (sapply(pingHist[1:i], length) / 2)) + + detProbs[i, 2:7] <- c(fivenum(detProb.k), mean(detProb.k)) + } # end if + + detProbs <- round(detProbs, 3) + } # end i + # calculate total number of hourly detects across all fish nomDelay <- median(delayRng) # nominal delay - #expected detects per tag per hour - expDetsPerTagPerHr <- (3600/(nomDelay + burstDur)) + # expected detects per tag per hour + expDetsPerTagPerHr <- (3600 / (nomDelay + burstDur)) - detProbs$expDetsPerHr <- expDetsPerTagPerHr*detProbs$nTags - detProbs$totDetsPerHr <- round(with(detProbs, expDetsPerHr*mean), 0) - detProbs$effDelay <- round(with(detProbs, nomDelay*(1/mean)), 0) - detProbs$detsPerTagPerHr <- round(with(detProbs, totDetsPerHr/nTags)) + detProbs$expDetsPerHr <- expDetsPerTagPerHr * detProbs$nTags + detProbs$totDetsPerHr <- round(with(detProbs, expDetsPerHr * mean), 0) + detProbs$effDelay <- round(with(detProbs, nomDelay * (1 / mean)), 0) + detProbs$detsPerTagPerHr <- round(with(detProbs, totDetsPerHr / nTags)) return(detProbs) } diff --git a/R/sim-receiver_line_det_sim.r b/R/sim-receiver_line_det_sim.r index 81d93506..aba4638a 100644 --- a/R/sim-receiver_line_det_sim.r +++ b/R/sim-receiver_line_det_sim.r @@ -93,20 +93,20 @@ #' dp #' #' # Again with only 10 virtual fish and optional plot to see simulated data -#' dp <- receiver_line_det_sim(rngFun = pdrf, nsim = 10, showPlot = T) # w/ optional plot +#' dp <- receiver_line_det_sim(rngFun = pdrf, nsim = 10, showPlot = TRUE) # w/ optional plot #' dp #' #' # Again but six receivers and allow fish to pass to left and right of line #' dp <- receiver_line_det_sim( #' rngFun = pdrf, recSpc = rep(1000, 5), -#' outerLim = c(1000, 1000), nsim = 10, showPlot = T +#' outerLim = c(1000, 1000), nsim = 10, showPlot = TRUE #' ) #' dp #' #' # Again but four receivers with irregular spacing #' dp <- receiver_line_det_sim( #' rngFun = pdrf, recSpc = c(2000, 4000, 2000), -#' outerLim = c(1000, 1000), nsim = 10, showPlot = T +#' outerLim = c(1000, 1000), nsim = 10, showPlot = TRUE #' ) #' dp #' @@ -173,7 +173,7 @@ #' ) #' #' # use empirical curve (edrf) in simulation -#' dp <- receiver_line_det_sim(rngFun = edrf, nsim = 10, showPlot = T) # w/ optional plot +#' dp <- receiver_line_det_sim(rngFun = edrf, nsim = 10, showPlot = TRUE) # w/ optional plot #' dp #' #' @export diff --git a/R/summ-receiver_efficiency.r b/R/summ-receiver_efficiency.r index 9a4f3036..aafd20df 100644 --- a/R/summ-receiver_efficiency.r +++ b/R/summ-receiver_efficiency.r @@ -35,6 +35,7 @@ #' @author Alex Nunes \email{anunes@dal.ca} #' #' @examples +#' \dontrun{ #' det_file <- system.file("extdata", "hfx_detections.csv", #' package = "glatos" #' ) @@ -47,7 +48,7 @@ #' dets <- glatos::read_otn_detections(det_file) #' #' hfx_receiver_efficiency_index <- glatos::REI(dets, hfx_deployments) -#' +#' } #' @importFrom dplyr group_by mutate coalesce filter summarise #' @importFrom magrittr "%>%" #' diff --git a/R/summ-residence_index.r b/R/summ-residence_index.r index 0085fa1a..2b5959a5 100644 --- a/R/summ-residence_index.r +++ b/R/summ-residence_index.r @@ -437,15 +437,15 @@ get_days <- function(dets, calculation_method = "kessel", time_interval_size = "1 day") { days <- 0 if (calculation_method == "aggregate_with_overlap") { - days <- glatos:::aggregate_total_with_overlap(dets) + days <- aggregate_total_with_overlap(dets) } else if (calculation_method == "aggregate_no_overlap") { - days <- glatos:::aggregate_total_no_overlap(dets) + days <- aggregate_total_no_overlap(dets) } else if (calculation_method == "timedelta") { - days <- glatos:::total_diff_days(dets) + days <- total_diff_days(dets) } else if (calculation_method == "kessel") { - days <- glatos:::interval_count(dets, time_interval_size = "1 day") + days <- interval_count(dets, time_interval_size = "1 day") } else if (calculation_method == "time_interval") { - days <- glatos:::interval_count(dets, time_interval_size) + days <- interval_count(dets, time_interval_size) } else { stop("Unsupported 'calculated_method'.") } diff --git a/R/sysdata.rda b/R/sysdata.rda index 78130134..430958ae 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/util-convert_otn_erddap_to_att.r b/R/util-convert_otn_erddap_to_att.r index 4aa0f13f..931532a8 100644 --- a/R/util-convert_otn_erddap_to_att.r +++ b/R/util-convert_otn_erddap_to_att.r @@ -5,6 +5,7 @@ #' metadata from the OTN ERDDAP to \code{ATT} format for use in the Animal #' Tracking Toolbox (\url{https://github.com/vinayudyawer/ATT}). #' +#' #' @param detectionObj a data frame from \code{read_glatos_detections} #' #' @param erdTags a data frame with tag release data from the OTN ERDDAP @@ -73,7 +74,7 @@ #' tags, stations, animals #' ) #' @export - +#' convert_otn_erddap_to_att <- function(detectionObj, erdTags, erdRcv, erdAni, crs = sf::st_crs(4326)) { transmitters <- @@ -194,11 +195,11 @@ convert_otn_erddap_to_att <- function(detectionObj, erdTags, erdRcv, erdAni, class(att_obj) <- "ATT" - if (inherits(crs, "CRS")) { - attr(att_obj, "CRS") <- crs + if (inherits(crs, "crs")) { + attr(att_obj, "crs") <- crs } else { message("Geographic projection for detection positions not recognised, reverting to WGS84 global coordinate reference system") - attr(att_obj, "CRS") <- eval(formals()$crs) + attr(att_obj, "crs") <- eval(formals()$crs) } return(att_obj) diff --git a/R/util-convert_otn_to_att.r b/R/util-convert_otn_to_att.r index 7e316639..e104ce15 100644 --- a/R/util-convert_otn_to_att.r +++ b/R/util-convert_otn_to_att.r @@ -38,7 +38,7 @@ #' and station metadata, to be ingested by VTrack/ATT #' #' @examples -#' +#' \dontrun{ #' #-------------------------------------------------- #' # EXAMPLE #1 - loading from Deployment Object #' @@ -59,7 +59,7 @@ #' deploy <- read_otn_deployments(deploy_path) #' #' ATTdata <- convert_otn_to_att(dets, tags, deploymentObj = deploy) -#' +#' } #' #-------------------------------------------------- #' # EXAMPLE #2 - loading from Deployment Sheet #' @@ -88,7 +88,7 @@ convert_otn_to_att <- function(detectionObj, deploymentObj = NULL, deploymentSheet = NULL, timeFilter = TRUE, - crs = sf::st_crs(3426)) { + crs = sf::st_crs(4326)) { 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))) { @@ -201,11 +201,11 @@ convert_otn_to_att <- function(detectionObj, class(att_obj) <- "ATT" - if (inherits(crs, "CRS")) { - attr(att_obj, "CRS") <- crs + if (inherits(crs, "crs")) { + attr(att_obj, "crs") <- crs } else { message("Geographic projection for detection positions not recognised, reverting to WGS84 global coordinate reference system") - attr(att_obj, "CRS") <- eval(formals()$crs) + attr(att_obj, "crs") <- eval(formals()$crs) } return(att_obj) diff --git a/R/util-kml_to_csv.r b/R/util-kml_to_csv.r index f3b39dba..01971d40 100644 --- a/R/util-kml_to_csv.r +++ b/R/util-kml_to_csv.r @@ -26,7 +26,7 @@ #' @examples #' #' # Get example kml with two polygons -#' kml_file <- system.file("inst/extdata", "example_polygons.kml", +#' kml_file <- system.file("extdata", "example_polygons.kml", #' package = "glatos" #' ) #' diff --git a/R/util-vrl2csv.r b/R/util-vrl2csv.r index bd26d027..6c17872f 100644 --- a/R/util-vrl2csv.r +++ b/R/util-vrl2csv.r @@ -65,7 +65,7 @@ #' vrl2csv(myVRL) # file name input #' #' # setting 'overwrite=FALSE' will make new file with '_n'added to name -#' vrl2csv(myVRL, overwrite = F) +#' vrl2csv(myVRL, overwrite = FALSE) #' } #' #' @name vrl2csv-deprecated diff --git a/R/vis-make_frames.r b/R/vis-make_frames.r index 16efd3f6..231817f3 100644 --- a/R/vis-make_frames.r +++ b/R/vis-make_frames.r @@ -53,8 +53,8 @@ #' @param preview write first frame only. Useful for checking output before #' processing large number of frames. Default `preview = FALSE` #' -#' @param bg_map A sf points, lines, or polygons object. Spatial `sp` objects -#' will be converted to `sf` +#' @param bg_map A sf points, lines, or polygons object. Spatial `sp` or `terra` objects +#' will be converted to `sf`. Coordinate system of map must be latitude/longitude (WGS 84). #' #' @param show_progress Logical. Progress bar and status messages will be shown #' if TRUE (default) and not shown if FALSE. @@ -397,19 +397,32 @@ make_frames <- function(proc_obj, recs = NULL, out_dir = getwd(), } else { background <- bg_map - if (inherits(map, "Spatial")) { - map <- sf::st_as_sf(map) + # convert to sf if sp::Spatial object + if (inherits(background, "Spatial")) { + background <- sf::st_as_sf(background) message("Converted sp object to sf") } - # if not equal to default or NULL, then set to extent of bg_map - if (is.null(background_ylim) | all(background_ylim == c(41.3, 49.0))) { - background_ylim <- - as.numeric(st_bbox(bg_map)[c("xmin", "xmax")]) + # 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") } - if (is.null(background_xlim) | all(background_xlim == c(-92.45, -75.87))) { - background_xlim <- - as.numeric(st_bbox(bg_map)[c("ymin", "ymax")]) + + # 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")]) } } diff --git a/R/vis-make_transition3.r b/R/vis-make_transition3.r index 42108190..14f8cef7 100644 --- a/R/vis-make_transition3.r +++ b/R/vis-make_transition3.r @@ -1,154 +1,156 @@ -##' Create transition layer from polygon shapefile -##' -##' Create transition layer for [interpolate_path] from polygon shapefile. -##' -##' @param poly A spatial polygon object of class -##' [SpatialPolygonsDataFrame][SpatialPolygons] or a -##' [sf::sf()][sf::sf] object with a geometry column of polygon -##' and/or multipolygon objects. -##' -##' @param res two element vector that specifies the x and y dimension -##' of output raster cells. Units of res are same as input -##' shapefile. -##' -##' @param receiver_points A SpatialPointsDataFrame object that -##' contains coordinates of receivers dataset or a "glatos_receivers" object. -##' -##' @param epsg coordinate reference code that describes projection -##' used for map calculation and rasterization. Defaults to -##' NAD83/Great Lakes and St. Lawrence Albers. -##' -##' @details `make_transition` uses [fasterize][fasterize::fasterize] -##' to convert a polygon shapefile into a raster layer and -##' geo-corrected transition layer [interpolate_path]. Raster -##' cell values on land equal 1 cells in water equal 0. Output is a -##' 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 -##' 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. -##' -##' @details Poly object is transformed into planer map projection -##' specified by epsg argument for calculation of transition object -##' if receiver_points is provided. Output is projected to WGS84 -##' (epsg- 4326). -##' -##' @details output transition layer is corrected for projection -##' distortions using `gdistance::geoCorrection`. Adjacent -##' cells are connected by 16 directions and transition function -##' returns 0 (land) for movements between land and water and 1 for -##' all over-water movements. -##' -##' -##' @return A list with two elements: -##' \describe{ -##' \item{transition}{a geo-corrected transition raster layer where land = 0 -##' and water=1 -##' (see `gdistance`)} -##' \item{rast}{rasterized input layer of class `raster`}} -##' Additonally, rasterized version of input shapefile (*.tif extension) is written to computer -##' at `output_dir` -##' -##' -##' @author Todd Hayden, Tom Binder, Chris Holbrook -##' -##' @examples -##' -##' #Example 1 - read from SpatialPolygonsDataFrame -##' # use example polygon for Great lakes -##' -##' #get polygon of the Great Lakes -##' data(great_lakes_polygon) #glatos example data; a sf polygon object -##' -##' # make_transition layer -##' tst <- make_transition3(great_lakes_polygon, res = c(0.1, 0.1)) -##' -##' # plot raster layer -##' # notice land = 1, water = 0 -##' plot(terra::rast(tst$rast)) -##' -##' #compare to polygon -##' plot(st_geometry(great_lakes_polygon), add = TRUE, fill = NA) -##' -##' #Example 2 - read from ESRI Shapefile and include receiver file -##' # to account for any receivers outside of great lakes polygon -##' -##' # path to polygon shapefile -##' poly <- system.file("extdata", "shoreline.zip", package = "glatos") -##' poly <- unzip(poly, exdir = tempdir()) -##' poly <- sf::st_read(poly[grepl("*.shp", poly)]) -##' -##' # read in glatos receivers object -##' rec_file <- system.file("extdata", "sample_receivers.csv", package="glatos") -##' recs <- read_glatos_receivers(rec_file) -##' -##' # change a coordinate to on-land to show impact... -##' recs[1, "deploy_lat"] <- recs[1,"deploy_lat"]+4 -##' -##' # make_transition layer -##' tst <- make_transition3(poly, res = c(0.1, 0.1), receiver_points = recs) -##' -##' # plot raster layer -##' # notice the huge circle rasterized as "water" north of Lake Superior. -##' # This occurred because we had a "receiver" deployed at that locations -##' plot(terra::rast(tst$rast)) -##' points(recs$deploy_long, recs$deploy_lat, col = "red", pch = 20) -##' -##' # plot transition layer -##' plot(raster::raster(tst$transition)) -##' -##' Example 3- transition layer of Lake Huron only with receivers -##' -##' # read polygon layer of Great Lakes -##' data(great_lakes_polygon) -##' -##' # transform to great lakes projection -##' poly <- sf::st_transform(great_lakes_polygon, crs = 3175) -##' -##' # set attribute-geometry relationship to constant. -##' # this avoids error when cropping -##' sf::st_agr(poly) = "constant" -##' -##' # crop Great lakes polygon file -##' poly <- sf::st_crop(x = poly, xmin = 829242.55, ymin = 698928.27, -##' xmax = 1270000.97, ymax = 1097196.15) -##' -##' # read in glatos receivers object -##' rec_file <- system.file("extdata", "sample_receivers.csv", package="glatos") -##' recs <- read_glatos_receivers(rec_file) -##' -##' # extract receivers in "HECWL" project -##' # all receiver stations except one is in Lake Huron -##' recs <- recs[recs$glatos_project == "HECWL",] -##' -##' # remove two stations not in Lake Huron -##' recs <- recs[!recs$glatos_array %in% c("MAU","LVD"),] -##' -##' # convert recs to simple feature object (sf) -##' recs <- sf::st_as_sf(recs, coords = c("deploy_long", "deploy_lat"), crs = 4326 ) -##' -##' # transform receivers to same projection as great lakes polygon -##' recs <- sf::st_transform(recs, crs = 3175) -##' -##' # check by plotting -##' plot(sf::st_geometry(poly), col = NA) -##' plot(sf::st_geometry(recs), col = "red", add = TRUE) -##' -##' # create slightly higher resolution transition layer -##' tst1 <- make_transition3(poly, res = c(0.01, 0.01), receiver_points = recs) -##' -##' # plot raster layer -##' plot(terra::rast(tst1$rast)) -##' plot(sf::st_transform(sf::st_geometry(recs), crs = 4326), add = TRUE, col = "red", pch = 20) -##' -##' # plot transition layer -##' raster::plot(raster::raster(tst1$transition)) -##' -##' -##' @export +#' Create transition layer from polygon shapefile +#' +#' Create transition layer for [interpolate_path] from polygon shapefile. +#' +#' @param poly A spatial polygon object of class +#' [SpatialPolygonsDataFrame][SpatialPolygons] or a +#' [sf::sf()][sf::sf] object with a geometry column of polygon +#' and/or multipolygon objects. +#' +#' @param res two element vector that specifies the x and y dimension +#' of output raster cells. Units of res are same as input +#' shapefile. +#' +#' @param receiver_points A SpatialPointsDataFrame object that +#' contains coordinates of receivers dataset or a "glatos_receivers" object. +#' +#' @param epsg coordinate reference code that describes projection +#' used for map calculation and rasterization. Defaults to +#' NAD83/Great Lakes and St. Lawrence Albers. +#' +#' @details `make_transition` uses [fasterize][fasterize::fasterize] +#' to convert a polygon shapefile into a raster layer and +#' geo-corrected transition layer [interpolate_path]. Raster +#' cell values on land equal 1 cells in water equal 0. Output is a +#' 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 +#' 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. +#' +#' @details Poly object is transformed into planer map projection +#' specified by epsg argument for calculation of transition object +#' if receiver_points is provided. Output is projected to WGS84 +#' (epsg- 4326). +#' +#' @details output transition layer is corrected for projection +#' distortions using `gdistance::geoCorrection`. Adjacent +#' cells are connected by 16 directions and transition function +#' returns 0 (land) for movements between land and water and 1 for +#' all over-water movements. +#' +#' +#' @return A list with two elements: +#' \describe{ +#' \item{transition}{a geo-corrected transition raster layer where land = 0 +#' and water=1 +#' (see `gdistance`)} +#' \item{rast}{rasterized input layer of class `raster`}} +#' Additonally, rasterized version of input shapefile (*.tif extension) is written to computer +#' at `output_dir` +#' +#' +#' @author Todd Hayden, Tom Binder, Chris Holbrook +#' +#' @examples +#' +#' # Example 1 - read from SpatialPolygonsDataFrame +#' # use example polygon for Great lakes +#' +#' # get polygon of the Great Lakes +#' data(great_lakes_polygon) # glatos example data; a sf polygon object +#' +#' # make_transition layer +#' tst <- make_transition3(great_lakes_polygon, res = c(0.1, 0.1)) +#' +#' # plot raster layer +#' # notice land = 1, water = 0 +#' raster::plot(tst$rast) +#' +#' # compare to polygon +#' plot(sf::st_geometry(great_lakes_polygon), add = TRUE, fill = NA) +#' +#' # Example 2 - read from ESRI Shapefile and include receiver file +#' # to account for any receivers outside of great lakes polygon +#' +#' # path to polygon shapefile +#' poly <- system.file("extdata", "shoreline.zip", package = "glatos") +#' poly <- sf::st_read(paste0("/vsizip/", poly)) +#' +#' # read in glatos receivers object +#' rec_file <- system.file("extdata", "sample_receivers.csv", package = "glatos") +#' recs <- read_glatos_receivers(rec_file) +#' +#' # change a coordinate to on-land to show impact... +#' recs[1, "deploy_lat"] <- recs[1, "deploy_lat"] + 4 +#' +#' # make_transition layer +#' tst <- make_transition3(poly, res = c(0.1, 0.1), receiver_points = recs) +#' +#' # plot raster layer +#' # notice the huge circle rasterized as "water" north of Lake Superior. +#' # This occurred because we had a "receiver" deployed at that locations +#' raster::plot(tst$rast) +#' points(recs$deploy_long, recs$deploy_lat, col = "red", pch = 20) +#' +#' # plot transition layer +#' raster::plot(raster::raster(tst$transition)) +#' +#' # Example 3- transition layer of Lake Huron only with receivers +#' +#' # read polygon layer of Great Lakes +#' data(great_lakes_polygon) +#' +#' # transform to great lakes projection +#' poly <- sf::st_transform(great_lakes_polygon, crs = 3175) +#' +#' # set attribute-geometry relationship to constant. +#' # this avoids error when cropping +#' sf::st_agr(poly) <- "constant" +#' +#' # crop Great lakes polygon file +#' poly <- sf::st_crop( +#' x = poly, xmin = 829242.55, ymin = 698928.27, +#' xmax = 1270000.97, ymax = 1097196.15 +#' ) +#' +#' # read in glatos receivers object +#' rec_file <- system.file("extdata", "sample_receivers.csv", package = "glatos") +#' recs <- read_glatos_receivers(rec_file) +#' +#' # extract receivers in "HECWL" project +#' # all receiver stations except one is in Lake Huron +#' recs <- recs[recs$glatos_project == "HECWL", ] +#' +#' # remove two stations not in Lake Huron +#' recs <- recs[!recs$glatos_array %in% c("MAU", "LVD"), ] +#' +#' # convert recs to simple feature object (sf) +#' recs <- sf::st_as_sf(recs, coords = c("deploy_long", "deploy_lat"), crs = 4326) +#' +#' # transform receivers to same projection as great lakes polygon +#' recs <- sf::st_transform(recs, crs = 3175) +#' +#' # check by plotting +#' plot(sf::st_geometry(poly), col = NA) +#' plot(sf::st_geometry(recs), col = "red", add = TRUE) +#' +#' # create slightly higher resolution transition layer +#' tst1 <- make_transition3(poly, res = c(0.01, 0.01), receiver_points = recs) +#' +#' # plot raster layer +#' raster::plot(tst1$rast) +#' plot(sf::st_transform(sf::st_geometry(recs), crs = 4326), +#' add = TRUE, col = "red", pch = 20 +#' ) +#' +#' # plot transition layer +#' raster::plot(raster::raster(tst1$transition)) +#' +#' @export make_transition3 <- function(poly, res = c(0.1, 0.1), receiver_points = NULL, epsg = 3175) { message("Making transition layer...") diff --git a/R/vis-position_heat_map.r b/R/vis-position_heat_map.r index 4f54e28f..9b00992b 100644 --- a/R/vis-position_heat_map.r +++ b/R/vis-position_heat_map.r @@ -512,7 +512,7 @@ position_heat_map <- function(positions, file.remove(png_file) } if (output %in% c("png", "kmz")) { - message(paste0("Output file are located in: ", file_path)) + message(paste0("Output file is located in: ", file_path)) } diff --git a/data-raw/data-greatLakesTrLayer.r b/data-raw/data-greatLakesTrLayer.r new file mode 100644 index 00000000..cb347bd3 --- /dev/null +++ b/data-raw/data-greatLakesTrLayer.r @@ -0,0 +1,15 @@ +# Make data object great_lakes_polygon + +# get path to example detections file +data("greatLakesPoly") + +# coerce to sf +great_lakes_polygon <- sf::st_as_sf(greatLakesPoly) + +# set CRS +sf::st_crs(great_lakes_polygon) <- 4326 + +#---------------------------------------------------- + +# add to (exported) data +usethis::use_data(great_lakes_polygon, overwrite = TRUE) diff --git a/data/greatLakesTrLayer.rda b/data/greatLakesTrLayer.rda new file mode 100644 index 00000000..366d35db Binary files /dev/null and b/data/greatLakesTrLayer.rda differ diff --git a/data/greatLakesTrLayer.rdata b/data/greatLakesTrLayer.rdata deleted file mode 100644 index ab9827ed..00000000 Binary files a/data/greatLakesTrLayer.rdata and /dev/null differ diff --git a/man/REI.Rd b/man/REI.Rd index 77c5bd22..a4ff9312 100644 --- a/man/REI.Rd +++ b/man/REI.Rd @@ -41,6 +41,7 @@ REI = (Tr/Ta) x (Sr/Sa) x (DDr/DDa) x (Da/Dr) } } \examples{ +\dontrun{ det_file <- system.file("extdata", "hfx_detections.csv", package = "glatos" ) @@ -53,7 +54,7 @@ hfx_deployments <- glatos::read_otn_deployments(dep_file) dets <- glatos::read_otn_detections(det_file) hfx_receiver_efficiency_index <- glatos::REI(dets, hfx_deployments) - +} } \author{ Alex Nunes \email{anunes@dal.ca} diff --git a/man/calc_collision_prob.Rd b/man/calc_collision_prob.Rd index 75059668..9720a91a 100644 --- a/man/calc_collision_prob.Rd +++ b/man/calc_collision_prob.Rd @@ -55,17 +55,23 @@ no other variables influence detection probability) and assuming that all tags are co-located at a receiver for the duration of the simulation. } \examples{ -#parameters analagous to Vemco tag, global coding, 45 s nominal delay -foo <- calc_collision_prob(delayRng = c(45, 90), burstDur = 5.12, maxTags = 50, - nTrans = 10000) - -#plot probabilities of detection -plot(med~nTags, data=foo, type='p', pch=20, ylim=c(0,1), - b - -#plot probability of collision by subtracting detection probability from 1 -plot((1 - med)~nTags, data=foo, type='p', pch=20, ylim=c(0,1), - xlab="# of transmitters within range", ylab="Probability of collision") +# parameters analagous to Vemco tag, global coding, 45 s nominal delay +foo <- calc_collision_prob( + delayRng = c(45, 90), burstDur = 5.12, maxTags = 50, + nTrans = 10000 +) + +# plot probabilities of detection +plot(med ~ nTags, + data = foo, type = "p", pch = 20, ylim = c(0, 1), + xlab = "# of transmitters within range", ylab = "Probability of detection" +) + +# plot probability of collision by subtracting detection probability from 1 +plot((1 - med) ~ nTags, + data = foo, type = "p", pch = 20, ylim = c(0, 1), + xlab = "# of transmitters within range", ylab = "Probability of collision" +) } \references{ diff --git a/man/convert_otn_to_att.Rd b/man/convert_otn_to_att.Rd index 0d3a0bf8..f581bbf4 100644 --- a/man/convert_otn_to_att.Rd +++ b/man/convert_otn_to_att.Rd @@ -11,7 +11,7 @@ convert_otn_to_att( deploymentObj = NULL, deploymentSheet = NULL, timeFilter = TRUE, - crs = sf::st_crs(3426) + crs = sf::st_crs(4326) ) } \arguments{ @@ -52,7 +52,7 @@ are found here: https://github.com/ocean-tracking-network/glatos/issues/75#issue in a comment by Ryan Gosse. } \examples{ - +\dontrun{ #-------------------------------------------------- # EXAMPLE #1 - loading from Deployment Object @@ -73,7 +73,7 @@ tags <- prepare_tag_sheet(tag_path, 5, 2) deploy <- read_otn_deployments(deploy_path) ATTdata <- convert_otn_to_att(dets, tags, deploymentObj = deploy) - +} #-------------------------------------------------- # EXAMPLE #2 - loading from Deployment Sheet diff --git a/man/glatos.Rd b/man/glatos.Rd index 9f8f0444..9401faf3 100644 --- a/man/glatos.Rd +++ b/man/glatos.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/package-glatos.r \docType{package} \name{glatos} +\alias{-package} \alias{glatos} \title{An R package for the Great Lakes Acoustic Telemetry Observation System} \description{ diff --git a/man/glatos_animals.Rd b/man/glatos_animals.Rd index 207f92eb..36401af8 100644 --- a/man/glatos_animals.Rd +++ b/man/glatos_animals.Rd @@ -108,6 +108,8 @@ x_tbl <- as_tibble(x) ga_tbl <- as_glatos_animals(x_tbl) +# All below will error as invalid + # data.frame input; missing column name library(dplyr) # for rename x2 <- rename(x, @@ -115,17 +117,19 @@ x2 <- rename(x, release_timestamp = utc_release_date_time ) -ga2 <- as_glatos_animals(x2) - +try( + ga2 <- as_glatos_animals(x2) +) -# data.grame input; wrong column class +# data.frame input; wrong column class x3 <- mutate(x, animal_id = as.integer(animal_id), utc_release_date_time = as.character(utc_release_date_time) ) -ga3 <- as_glatos_animals(x3) - +try( + ga3 <- as_glatos_animals(x3) +) # Validation and checking diff --git a/man/glatos_detections.Rd b/man/glatos_detections.Rd index edbf8d43..c389708a 100644 --- a/man/glatos_detections.Rd +++ b/man/glatos_detections.Rd @@ -110,6 +110,8 @@ x_tbl <- as_tibble(x) gd_tbl <- as_glatos_detections(x_tbl) +# All below will error as invalid + # data.frame input; missing column name library(dplyr) # for rename x2 <- rename(x, @@ -117,8 +119,9 @@ x2 <- rename(x, det_date_time = detection_timestamp_utc ) -gd2 <- as_glatos_detections(x2) - +try( + gd2 <- as_glatos_detections(x2) +) # data.frame input; wrong column class x3 <- mutate(x, @@ -126,8 +129,9 @@ x3 <- mutate(x, detection_timestamp_utc = as.character(detection_timestamp_utc) ) -gr3 <- as_glatos_detections(x3) - +try( + gr3 <- as_glatos_detections(x3) +) # Validation and checking diff --git a/man/glatos_receivers.Rd b/man/glatos_receivers.Rd index 70cbe91e..1d533a59 100644 --- a/man/glatos_receivers.Rd +++ b/man/glatos_receivers.Rd @@ -123,6 +123,7 @@ x_tbl <- as_tibble(x) gr_tbl <- as_glatos_receivers(x_tbl) +# All below will error as invalid # data.frame input; missing column name library(dplyr) # for rename @@ -131,8 +132,9 @@ x2 <- rename(x, deploy_timestamp = deploy_date_time ) -gr2 <- as_glatos_receivers(x2) - +try( + gr2 <- as_glatos_receivers(x2) +) # data.frame input; wrong column class x3 <- mutate(x, @@ -140,8 +142,9 @@ x3 <- mutate(x, deploy_date_time = as.character(deploy_date_time) ) -gr3 <- as_glatos_receivers(x3) - +try( + gr3 <- as_glatos_receivers(x3) +) # Validation and checking diff --git a/man/kml_to_csv.Rd b/man/kml_to_csv.Rd index b2f470aa..80c64206 100644 --- a/man/kml_to_csv.Rd +++ b/man/kml_to_csv.Rd @@ -35,7 +35,7 @@ saved as kml. Or extract (unzip) kml from kmz. \examples{ # Get example kml with two polygons -kml_file <- system.file("inst/extdata", "example_polygons.kml", +kml_file <- system.file("extdata", "example_polygons.kml", package = "glatos" ) diff --git a/man/make_frames.Rd b/man/make_frames.Rd index 5414ab52..1bc8658c 100644 --- a/man/make_frames.Rd +++ b/man/make_frames.Rd @@ -70,8 +70,8 @@ and will result in error if the file exists. Passed to \code{\link[=make_video]{ \item{preview}{write first frame only. Useful for checking output before processing large number of frames. Default \code{preview = FALSE}} -\item{bg_map}{A sf points, lines, or polygons object. Spatial \code{sp} objects -will be converted to \code{sf}} +\item{bg_map}{A sf points, lines, or polygons object. Spatial \code{sp} or \code{terra} objects +will be converted to \code{sf}. Coordinate system of map must be latitude/longitude (WGS 84).} \item{show_progress}{Logical. Progress bar and status messages will be shown if TRUE (default) and not shown if FALSE.} diff --git a/man/make_transition3.Rd b/man/make_transition3.Rd index cd31ce4a..47b406c3 100644 --- a/man/make_transition3.Rd +++ b/man/make_transition3.Rd @@ -63,36 +63,36 @@ all over-water movements. } \examples{ -#Example 1 - read from SpatialPolygonsDataFrame +# Example 1 - read from SpatialPolygonsDataFrame # use example polygon for Great lakes -#get polygon of the Great Lakes -data(great_lakes_polygon) #glatos example data; a sf polygon object + +# get polygon of the Great Lakes +data(great_lakes_polygon) # glatos example data; a sf polygon object # make_transition layer tst <- make_transition3(great_lakes_polygon, res = c(0.1, 0.1)) # plot raster layer # notice land = 1, water = 0 -plot(terra::rast(tst$rast)) +raster::plot(tst$rast) -#compare to polygon -plot(st_geometry(great_lakes_polygon), add = TRUE, fill = NA) +# compare to polygon +plot(sf::st_geometry(great_lakes_polygon), add = TRUE, fill = NA) -#Example 2 - read from ESRI Shapefile and include receiver file +# Example 2 - read from ESRI Shapefile and include receiver file # to account for any receivers outside of great lakes polygon # path to polygon shapefile poly <- system.file("extdata", "shoreline.zip", package = "glatos") -poly <- unzip(poly, exdir = tempdir()) -poly <- sf::st_read(poly[grepl("*.shp", poly)]) +poly <- sf::st_read(paste0("/vsizip/", poly)) # read in glatos receivers object -rec_file <- system.file("extdata", "sample_receivers.csv", package="glatos") +rec_file <- system.file("extdata", "sample_receivers.csv", package = "glatos") recs <- read_glatos_receivers(rec_file) # change a coordinate to on-land to show impact... -recs[1, "deploy_lat"] <- recs[1,"deploy_lat"]+4 +recs[1, "deploy_lat"] <- recs[1, "deploy_lat"] + 4 # make_transition layer tst <- make_transition3(poly, res = c(0.1, 0.1), receiver_points = recs) @@ -100,13 +100,13 @@ tst <- make_transition3(poly, res = c(0.1, 0.1), receiver_points = recs) # plot raster layer # notice the huge circle rasterized as "water" north of Lake Superior. # This occurred because we had a "receiver" deployed at that locations -plot(terra::rast(tst$rast)) +raster::plot(tst$rast) points(recs$deploy_long, recs$deploy_lat, col = "red", pch = 20) # plot transition layer -plot(raster::raster(tst$transition)) +raster::plot(raster::raster(tst$transition)) -Example 3- transition layer of Lake Huron only with receivers +# Example 3- transition layer of Lake Huron only with receivers # read polygon layer of Great Lakes data(great_lakes_polygon) @@ -116,25 +116,27 @@ poly <- sf::st_transform(great_lakes_polygon, crs = 3175) # set attribute-geometry relationship to constant. # this avoids error when cropping -sf::st_agr(poly) = "constant" +sf::st_agr(poly) <- "constant" # crop Great lakes polygon file -poly <- sf::st_crop(x = poly, xmin = 829242.55, ymin = 698928.27, - xmax = 1270000.97, ymax = 1097196.15) +poly <- sf::st_crop( + x = poly, xmin = 829242.55, ymin = 698928.27, + xmax = 1270000.97, ymax = 1097196.15 +) # read in glatos receivers object -rec_file <- system.file("extdata", "sample_receivers.csv", package="glatos") +rec_file <- system.file("extdata", "sample_receivers.csv", package = "glatos") recs <- read_glatos_receivers(rec_file) # extract receivers in "HECWL" project # all receiver stations except one is in Lake Huron -recs <- recs[recs$glatos_project == "HECWL",] +recs <- recs[recs$glatos_project == "HECWL", ] # remove two stations not in Lake Huron -recs <- recs[!recs$glatos_array \%in\% c("MAU","LVD"),] +recs <- recs[!recs$glatos_array \%in\% c("MAU", "LVD"), ] # convert recs to simple feature object (sf) -recs <- sf::st_as_sf(recs, coords = c("deploy_long", "deploy_lat"), crs = 4326 ) +recs <- sf::st_as_sf(recs, coords = c("deploy_long", "deploy_lat"), crs = 4326) # transform receivers to same projection as great lakes polygon recs <- sf::st_transform(recs, crs = 3175) @@ -147,13 +149,14 @@ plot(sf::st_geometry(recs), col = "red", add = TRUE) tst1 <- make_transition3(poly, res = c(0.01, 0.01), receiver_points = recs) # plot raster layer -plot(terra::rast(tst1$rast)) -plot(sf::st_transform(sf::st_geometry(recs), crs = 4326), add = TRUE, col = "red", pch = 20) +raster::plot(tst1$rast) +plot(sf::st_transform(sf::st_geometry(recs), crs = 4326), + add = TRUE, col = "red", pch = 20 +) # plot transition layer raster::plot(raster::raster(tst1$transition)) - } \author{ Todd Hayden, Tom Binder, Chris Holbrook diff --git a/man/read_otn_deployments.Rd b/man/read_otn_deployments.Rd index aa9c88b6..ead0dbfb 100644 --- a/man/read_otn_deployments.Rd +++ b/man/read_otn_deployments.Rd @@ -42,11 +42,13 @@ Column names are changed to match GLATOS standard columns when possible. Otherwise, OTN columns and column names are retained. } \examples{ +\dontrun{ # get path to example deployments file deployment_file <- system.file("extdata", "hfx_deployments.csv", package = "glatos" ) dep <- read_otn_deployments(deployment_file) +} } \author{ diff --git a/man/read_vdat_csv.Rd b/man/read_vdat_csv.Rd index 4b15428d..d8a681dd 100644 --- a/man/read_vdat_csv.Rd +++ b/man/read_vdat_csv.Rd @@ -40,32 +40,37 @@ rounded down) to the nearest second. To maintain the full resolution present in the input Fathom CSV file, set \code{options(digits.secs = 6)}. } \examples{ - +\dontrun{ # Example 1. Read a single file -vrl_file <- system.file("extdata", "detection_files_raw", - "VR2W_109924_20110718_1.vrl", package="glatos") +vrl_file <- system.file("extdata", "detection_files_raw", + "VR2W_109924_20110718_1.vrl", + package = "glatos" +) temp_dir <- tempdir() csv_file <- vdat_convert(vrl_file, out_dir = temp_dir) -#utils::browseURL(temp_dir) +# utils::browseURL(temp_dir) -#read all record types +# read all record types vdat <- read_vdat_csv(csv_file) -#read only one record type +# read only one record type vdat <- read_vdat_csv(csv_file, record_types = c("DET")) - + # Example 2. Read and combine detection records from multiple files # get two example files vrl_files <- system.file("extdata", "detection_files_raw", - c("VR2W_109924_20110718_1.vrl", - "HR2-180 461396 2021-04-20 173145.vdat"), - package="glatos") + c( + "VR2W_109924_20110718_1.vrl", + "HR2-180 461396 2021-04-20 173145.vdat" + ), + package = "glatos" +) csv_files <- vdat_convert(vrl_files, out_dir = temp_dir) @@ -74,35 +79,40 @@ csv_files <- vdat_convert(vrl_files, out_dir = temp_dir) library(dplyr) -# basic steps: import each to list element, subset DET records, - add column with source file name, combine. - -det2_tbl <- csv_files \%>\% - lapply( - function(x) { - read_vdat_csv(x, record_types = "DET")$DET \%>\% - as_tibble \%>\% - mutate(source_file = basename(x)) - }) \%>\% - bind_rows +# basic steps: import each to list element, subset DET records, +# add column with source file name, combine. + +det2_tbl <- csv_files \%>\% + lapply( + function(x) { + read_vdat_csv(x, record_types = "DET")$DET \%>\% + as_tibble() \%>\% + mutate(source_file = basename(x)) + } + ) \%>\% + bind_rows() -#using data.table +# using data.table library(data.table) det2_dt <- rbindlist( - lapply(csv_files, - function(x) { - read_vdat_csv(x, record_types = "DET")$DET[, - source_file := basename(x)] - })) - -\dontrun{ + lapply( + csv_files, + function(x) { + read_vdat_csv(x, record_types = "DET")$DET[ + , + source_file := basename(x) + ] + } + ) +) + # get current version of digits.secs op_digits.secs <- options()$digits.secs - + # set digits.secs = NULL (default, truncates to nearest second) options(digits.secs = NULL) @@ -121,7 +131,6 @@ options(digits.secs = op_digits.secs) # or specify via format \%OSn e.g., when writing to disk or external database # see ?strptime format(vdat$DET$Time[2], format = "\%Y-\%m-\%d \%H:\%M:\%OS6") - } } diff --git a/man/receiver_line_det_sim.Rd b/man/receiver_line_det_sim.Rd index 70a4811c..8df77c71 100644 --- a/man/receiver_line_det_sim.Rd +++ b/man/receiver_line_det_sim.Rd @@ -100,20 +100,20 @@ dp <- receiver_line_det_sim(rngFun = pdrf) dp # Again with only 10 virtual fish and optional plot to see simulated data -dp <- receiver_line_det_sim(rngFun = pdrf, nsim = 10, showPlot = T) # w/ optional plot +dp <- receiver_line_det_sim(rngFun = pdrf, nsim = 10, showPlot = TRUE) # w/ optional plot dp # Again but six receivers and allow fish to pass to left and right of line dp <- receiver_line_det_sim( rngFun = pdrf, recSpc = rep(1000, 5), - outerLim = c(1000, 1000), nsim = 10, showPlot = T + outerLim = c(1000, 1000), nsim = 10, showPlot = TRUE ) dp # Again but four receivers with irregular spacing dp <- receiver_line_det_sim( rngFun = pdrf, recSpc = c(2000, 4000, 2000), - outerLim = c(1000, 1000), nsim = 10, showPlot = T + outerLim = c(1000, 1000), nsim = 10, showPlot = TRUE ) dp @@ -180,7 +180,7 @@ plot(edrf(0:2000), ) # use empirical curve (edrf) in simulation -dp <- receiver_line_det_sim(rngFun = edrf, nsim = 10, showPlot = T) # w/ optional plot +dp <- receiver_line_det_sim(rngFun = edrf, nsim = 10, showPlot = TRUE) # w/ optional plot dp } diff --git a/man/vrl2csv-deprecated.Rd b/man/vrl2csv-deprecated.Rd index 28f5e77a..cf90cd60 100644 --- a/man/vrl2csv-deprecated.Rd +++ b/man/vrl2csv-deprecated.Rd @@ -64,7 +64,7 @@ vrl2csv(dirname(myVRL)) # directory input vrl2csv(myVRL) # file name input # setting 'overwrite=FALSE' will make new file with '_n'added to name -vrl2csv(myVRL, overwrite = F) +vrl2csv(myVRL, overwrite = FALSE) } } diff --git a/man/write_vdat_csv.Rd b/man/write_vdat_csv.Rd index fdf19361..c2b9080a 100644 --- a/man/write_vdat_csv.Rd +++ b/man/write_vdat_csv.Rd @@ -58,6 +58,7 @@ Write a vdat_list object to disk in Innovasea Fathom VDAT CSV format Writing is done via \code{\link[data.table]{fwrite}}. } \examples{ +\dontrun{ # Example 1. Read and write a single file @@ -80,7 +81,7 @@ write_vdat_csv(vdat) # write to multiple files write_vdat_csv(vdat, output_format = "csv.fathom.split") - +} } \author{ C. Holbrook (cholbrook@usgs.gov) diff --git a/tests/testthat/_snaps/crw_in_polygon.md b/tests/testthat/_snaps/crw_in_polygon.md new file mode 100644 index 00000000..b8e32d85 --- /dev/null +++ b/tests/testthat/_snaps/crw_in_polygon.md @@ -0,0 +1,93 @@ +# data.frame input, sf output gives expected result + + Code + dfin_sfout + Output + Simple feature collection with 6 features and 0 fields + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -19.63178 ymin: 0 xmax: 0 ymax: 43.70673 + CRS: NA + geometry + 1 POINT (0 0) + 2 POINT (-4.347654 9.005438) + 3 POINT (-9.753604 17.41827) + 4 POINT (-16.59357 24.71312) + 5 POINT (-19.63178 34.24041) + 6 POINT (-16.4086 43.70673) + +# data.frame input, data.frame output gives expected result + + Code + dfin_dfout + Output + x y + 1 0.000000 0.000000 + 2 -4.347654 9.005438 + 3 -9.753604 17.418267 + 4 -16.593567 24.713122 + 5 -19.631781 34.240412 + 6 -16.408604 43.706727 + +# SpatialPolygonsDataFrame input, data.frame output gives expected result + + Code + spin_dfout + Output + x y + 1 -87.49017 48.42314 + 2 -87.56828 48.49653 + 3 -87.66241 48.56116 + 4 -87.77630 48.60994 + 5 -87.83445 48.69117 + 6 -87.95955 48.72632 + +# SpatialPolygonsDataFrame input, sf output gives expected result + + Code + spin_sfout + Output + Simple feature collection with 6 features and 0 fields + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.95955 ymin: 48.42314 xmax: -87.49017 ymax: 48.72632 + Geodetic CRS: WGS 84 (with axis order normalized for visualization) + geometry + 1 POINT (-87.49017 48.42314) + 2 POINT (-87.56828 48.49653) + 3 POINT (-87.66241 48.56116) + 4 POINT (-87.7763 48.60994) + 5 POINT (-87.83445 48.69117) + 6 POINT (-87.95955 48.72632) + +# sf input, data.frame output gives expected result + + Code + sfin_dfout + Output + x y + 1 -87.49017 48.42314 + 2 -87.56828 48.49653 + 3 -87.66241 48.56116 + 4 -87.77630 48.60994 + 5 -87.83445 48.69117 + 6 -87.95955 48.72632 + +# sf input, sf output gives expected result + + Code + sfin_sfout + Output + Simple feature collection with 6 features and 0 fields + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.95955 ymin: 48.42314 xmax: -87.49017 ymax: 48.72632 + Geodetic CRS: WGS 84 + geometry + 1 POINT (-87.49017 48.42314) + 2 POINT (-87.56828 48.49653) + 3 POINT (-87.66241 48.56116) + 4 POINT (-87.7763 48.60994) + 5 POINT (-87.83445 48.69117) + 6 POINT (-87.95955 48.72632) + diff --git a/tests/testthat/_snaps/detect_transmissions.md b/tests/testthat/_snaps/detect_transmissions.md new file mode 100644 index 00000000..9c53e5e1 --- /dev/null +++ b/tests/testthat/_snaps/detect_transmissions.md @@ -0,0 +1,72 @@ +# data.frame input, spatial output gives expected result + + Code + dfin_spout + Output + Simple feature collection with 8 features and 3 fields + Active geometry column: rec_geometry + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.65 ymin: 48.6 xmax: -87.65 ymax: 48.6 + Geodetic CRS: WGS 84 (with axis order normalized for visualization) + trns_id rec_id time rec_geometry trns_geometry + 1 1 4 600.8733 POINT (-87.65 48.6) POINT (-87.51364 48.44519) + 2 1 4 1791.7514 POINT (-87.65 48.6) POINT (-87.56015 48.48889) + 3 1 4 2833.5955 POINT (-87.65 48.6) POINT (-87.60753 48.52348) + 4 1 4 3943.3385 POINT (-87.65 48.6) POINT (-87.65978 48.55936) + 5 1 4 4909.4957 POINT (-87.65 48.6) POINT (-87.7143 48.58339) + 6 1 4 5691.6579 POINT (-87.65 48.6) POINT (-87.75888 48.60248) + 7 1 4 7374.9478 POINT (-87.65 48.6) POINT (-87.81634 48.66588) + 8 1 4 8248.2156 POINT (-87.65 48.6) POINT (-87.85012 48.69558) + +# data.frame input, data.frame output gives expected result + + Code + dfin_dfout + Output + trns_id rec_id rec_x rec_y trns_x trns_y time + 1 1 4 -87.65 48.6 -87.51364 48.44519 600.8733 + 2 1 4 -87.65 48.6 -87.56015 48.48889 1791.7514 + 3 1 4 -87.65 48.6 -87.60753 48.52348 2833.5955 + 4 1 4 -87.65 48.6 -87.65978 48.55936 3943.3385 + 5 1 4 -87.65 48.6 -87.71430 48.58339 4909.4957 + 6 1 4 -87.65 48.6 -87.75888 48.60248 5691.6579 + 7 1 4 -87.65 48.6 -87.81634 48.66588 7374.9478 + 8 1 4 -87.65 48.6 -87.85012 48.69558 8248.2156 + +# spatial input, data.frame output gives expected result + + Code + spin_dfout + Output + trns_id rec_id rec_x rec_y trns_x trns_y time + 1 1 4 -87.65 48.6 -87.51364 48.44519 600.8733 + 2 1 4 -87.65 48.6 -87.56015 48.48889 1791.7514 + 3 1 4 -87.65 48.6 -87.60753 48.52348 2833.5955 + 4 1 4 -87.65 48.6 -87.65978 48.55936 3943.3385 + 5 1 4 -87.65 48.6 -87.71430 48.58339 4909.4957 + 6 1 4 -87.65 48.6 -87.75888 48.60248 5691.6579 + 7 1 4 -87.65 48.6 -87.81634 48.66588 7374.9478 + 8 1 4 -87.65 48.6 -87.85012 48.69558 8248.2156 + +# spatial input, spatial output gives expected result + + Code + spin_spout + Output + Simple feature collection with 8 features and 3 fields + Active geometry column: rec_geometry + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.65 ymin: 48.6 xmax: -87.65 ymax: 48.6 + Geodetic CRS: WGS 84 (with axis order normalized for visualization) + trns_id rec_id time rec_geometry trns_geometry + 1 1 4 600.8733 POINT (-87.65 48.6) POINT (-87.51364 48.44519) + 2 1 4 1791.7514 POINT (-87.65 48.6) POINT (-87.56015 48.48889) + 3 1 4 2833.5955 POINT (-87.65 48.6) POINT (-87.60753 48.52348) + 4 1 4 3943.3385 POINT (-87.65 48.6) POINT (-87.65978 48.55936) + 5 1 4 4909.4957 POINT (-87.65 48.6) POINT (-87.7143 48.58339) + 6 1 4 5691.6579 POINT (-87.65 48.6) POINT (-87.75888 48.60248) + 7 1 4 7374.9478 POINT (-87.65 48.6) POINT (-87.81634 48.66588) + 8 1 4 8248.2156 POINT (-87.65 48.6) POINT (-87.85012 48.69558) + diff --git a/tests/testthat/_snaps/false_detections.md b/tests/testthat/_snaps/false_detections.md new file mode 100644 index 00000000..6e9b89c2 --- /dev/null +++ b/tests/testthat/_snaps/false_detections.md @@ -0,0 +1,199 @@ +# data.frame input gives expected result + + Code + df_result + Output + animal_id detection_timestamp_utc glatos_array station_no + 129 153 2012-05-23 02:54:19 SBI 1 + 130 153 2012-05-23 03:17:13 SBI 1 + 131 153 2012-05-23 03:21:18 SBI 3 + 132 153 2012-05-23 03:23:16 SBI 1 + 133 153 2012-05-23 03:26:12 SBI 1 + 134 153 2012-05-23 03:39:04 SBI 1 + 135 153 2012-05-23 03:41:31 SBI 1 + 136 153 2012-05-23 03:41:31 SBI 2 + 137 153 2012-05-23 03:44:46 SBI 1 + 138 153 2012-05-23 03:57:01 SBI 1 + transmitter_codespace transmitter_id sensor_value sensor_unit deploy_lat + 129 A69-9001 32054 NA 44.17873 + 130 A69-9001 32054 NA 44.17873 + 131 A69-9001 32054 NA 44.17255 + 132 A69-9001 32054 NA 44.17873 + 133 A69-9001 32054 NA 44.17873 + 134 A69-9001 32054 NA 44.17873 + 135 A69-9001 32054 NA 44.17873 + 136 A69-9001 32054 NA 44.17714 + 137 A69-9001 32054 NA 44.17873 + 138 A69-9001 32054 NA 44.17873 + deploy_long receiver_sn tag_type tag_model tag_serial_number common_name_e + 129 -83.54767 109991 walleye + 130 -83.54767 109991 walleye + 131 -83.53090 109999 walleye + 132 -83.54767 109991 walleye + 133 -83.54767 109991 walleye + 134 -83.54767 109991 walleye + 135 -83.54767 109991 walleye + 136 -83.54169 109956 walleye + 137 -83.54767 109991 walleye + 138 -83.54767 109991 walleye + capture_location length weight sex release_group release_location + 129 Tittabawassee River 0.565 NA F Tittabawassee + 130 Tittabawassee River 0.565 NA F Tittabawassee + 131 Tittabawassee River 0.565 NA F Tittabawassee + 132 Tittabawassee River 0.565 NA F Tittabawassee + 133 Tittabawassee River 0.565 NA F Tittabawassee + 134 Tittabawassee River 0.565 NA F Tittabawassee + 135 Tittabawassee River 0.565 NA F Tittabawassee + 136 Tittabawassee River 0.565 NA F Tittabawassee + 137 Tittabawassee River 0.565 NA F Tittabawassee + 138 Tittabawassee River 0.565 NA F Tittabawassee + release_latitude release_longitude utc_release_date_time + 129 NA NA 2012-03-20 20:00:00 + 130 NA NA 2012-03-20 20:00:00 + 131 NA NA 2012-03-20 20:00:00 + 132 NA NA 2012-03-20 20:00:00 + 133 NA NA 2012-03-20 20:00:00 + 134 NA NA 2012-03-20 20:00:00 + 135 NA NA 2012-03-20 20:00:00 + 136 NA NA 2012-03-20 20:00:00 + 137 NA NA 2012-03-20 20:00:00 + 138 NA NA 2012-03-20 20:00:00 + glatos_project_transmitter glatos_project_receiver glatos_tag_recovered + 129 HECWL HECWL NO + 130 HECWL HECWL NO + 131 HECWL HECWL NO + 132 HECWL HECWL NO + 133 HECWL HECWL NO + 134 HECWL HECWL NO + 135 HECWL HECWL NO + 136 HECWL HECWL NO + 137 HECWL HECWL NO + 138 HECWL HECWL NO + glatos_caught_date station min_lag passed_filter + 129 SBI-001 1374 1 + 130 SBI-001 363 1 + 131 SBI-003 4180 0 + 132 SBI-001 176 1 + 133 SBI-001 176 1 + 134 SBI-001 147 1 + 135 SBI-001 147 1 + 136 SBI-002 4478 0 + 137 SBI-001 195 1 + 138 SBI-001 735 1 + +# data.table input gives expected result + + Code + dt_result + Output + animal_id detection_timestamp_utc glatos_array station_no + + 1: 153 2012-05-23 02:54:19 SBI 1 + 2: 153 2012-05-23 03:17:13 SBI 1 + 3: 153 2012-05-23 03:21:18 SBI 3 + 4: 153 2012-05-23 03:23:16 SBI 1 + 5: 153 2012-05-23 03:26:12 SBI 1 + 6: 153 2012-05-23 03:39:04 SBI 1 + 7: 153 2012-05-23 03:41:31 SBI 1 + 8: 153 2012-05-23 03:41:31 SBI 2 + 9: 153 2012-05-23 03:44:46 SBI 1 + 10: 153 2012-05-23 03:57:01 SBI 1 + transmitter_codespace transmitter_id sensor_value sensor_unit deploy_lat + + 1: A69-9001 32054 NA 44.17873 + 2: A69-9001 32054 NA 44.17873 + 3: A69-9001 32054 NA 44.17255 + 4: A69-9001 32054 NA 44.17873 + 5: A69-9001 32054 NA 44.17873 + 6: A69-9001 32054 NA 44.17873 + 7: A69-9001 32054 NA 44.17873 + 8: A69-9001 32054 NA 44.17714 + 9: A69-9001 32054 NA 44.17873 + 10: A69-9001 32054 NA 44.17873 + deploy_long receiver_sn tag_type tag_model tag_serial_number common_name_e + + 1: -83.54767 109991 walleye + 2: -83.54767 109991 walleye + 3: -83.53090 109999 walleye + 4: -83.54767 109991 walleye + 5: -83.54767 109991 walleye + 6: -83.54767 109991 walleye + 7: -83.54767 109991 walleye + 8: -83.54169 109956 walleye + 9: -83.54767 109991 walleye + 10: -83.54767 109991 walleye + capture_location length weight sex release_group release_location + + 1: Tittabawassee River 0.565 NA F Tittabawassee + 2: Tittabawassee River 0.565 NA F Tittabawassee + 3: Tittabawassee River 0.565 NA F Tittabawassee + 4: Tittabawassee River 0.565 NA F Tittabawassee + 5: Tittabawassee River 0.565 NA F Tittabawassee + 6: Tittabawassee River 0.565 NA F Tittabawassee + 7: Tittabawassee River 0.565 NA F Tittabawassee + 8: Tittabawassee River 0.565 NA F Tittabawassee + 9: Tittabawassee River 0.565 NA F Tittabawassee + 10: Tittabawassee River 0.565 NA F Tittabawassee + release_latitude release_longitude utc_release_date_time + + 1: NA NA 2012-03-20 20:00:00 + 2: NA NA 2012-03-20 20:00:00 + 3: NA NA 2012-03-20 20:00:00 + 4: NA NA 2012-03-20 20:00:00 + 5: NA NA 2012-03-20 20:00:00 + 6: NA NA 2012-03-20 20:00:00 + 7: NA NA 2012-03-20 20:00:00 + 8: NA NA 2012-03-20 20:00:00 + 9: NA NA 2012-03-20 20:00:00 + 10: NA NA 2012-03-20 20:00:00 + glatos_project_transmitter glatos_project_receiver glatos_tag_recovered + + 1: HECWL HECWL NO + 2: HECWL HECWL NO + 3: HECWL HECWL NO + 4: HECWL HECWL NO + 5: HECWL HECWL NO + 6: HECWL HECWL NO + 7: HECWL HECWL NO + 8: HECWL HECWL NO + 9: HECWL HECWL NO + 10: HECWL HECWL NO + glatos_caught_date station min_lag passed_filter + + 1: SBI-001 1374 1 + 2: SBI-001 363 1 + 3: SBI-003 4180 0 + 4: SBI-001 176 1 + 5: SBI-001 176 1 + 6: SBI-001 147 1 + 7: SBI-001 147 1 + 8: SBI-002 4478 0 + 9: SBI-001 195 1 + 10: SBI-001 735 1 + +# tibble input gives expected result + + Code + tbl_result + Output + # A tibble: 10 x 31 + animal_id detection_timestamp_utc glatos_array station_no + + 1 153 2012-05-23 02:54:19 SBI 1 + 2 153 2012-05-23 03:17:13 SBI 1 + 3 153 2012-05-23 03:21:18 SBI 3 + 4 153 2012-05-23 03:23:16 SBI 1 + 5 153 2012-05-23 03:26:12 SBI 1 + 6 153 2012-05-23 03:39:04 SBI 1 + 7 153 2012-05-23 03:41:31 SBI 1 + 8 153 2012-05-23 03:41:31 SBI 2 + 9 153 2012-05-23 03:44:46 SBI 1 + 10 153 2012-05-23 03:57:01 SBI 1 + # i 27 more variables: transmitter_codespace , transmitter_id , + # sensor_value , sensor_unit , deploy_lat , deploy_long , + # receiver_sn , tag_type , tag_model , + # tag_serial_number , common_name_e , capture_location , + # length , weight , sex , release_group , + # release_location , release_latitude , release_longitude , + # utc_release_date_time , glatos_project_transmitter , ... + diff --git a/tests/testthat/_snaps/make_transition.md b/tests/testthat/_snaps/make_transition.md new file mode 100644 index 00000000..e4456ddd --- /dev/null +++ b/tests/testthat/_snaps/make_transition.md @@ -0,0 +1,54 @@ +# make_transition: Transition matrix for Higgins Lake water polygon as expected + + Code + water + Output + class : TransitionLayer + dimensions : 10, 12, 120 (nrow, ncol, ncell) + resolution : 0.01, 0.01 (x, y) + extent : -84.78355, -84.66355, 44.41726, 44.51726 (xmin, xmax, ymin, ymax) + crs : +proj=longlat +datum=WGS84 +no_defs + values : conductance + matrix class: dsCMatrix + +# make_transition: Raster values for Higgins Lake water polygon as expected + + Code + water + Output + class : RasterLayer + dimensions : 10, 12, 120 (nrow, ncol, ncell) + resolution : 0.01, 0.01 (x, y) + extent : -84.78355, -84.66355, 44.41726, 44.51726 (xmin, xmax, ymin, ymax) + crs : +proj=longlat +datum=WGS84 +no_defs + source : out.tif + names : out + + +# make_transition: Transition matrix for Flynn Island land polygon as expected + + Code + land + Output + class : TransitionLayer + dimensions : 7, 9, 63 (nrow, ncol, ncell) + resolution : 0.001, 0.001 (x, y) + extent : -84.73151, -84.72251, 44.47648, 44.48348 (xmin, xmax, ymin, ymax) + crs : +proj=longlat +datum=WGS84 +no_defs + values : conductance + matrix class: dsCMatrix + +# make_transition: Raster values for Flynn Island polygon as expected + + Code + land + Output + class : RasterLayer + dimensions : 7, 9, 63 (nrow, ncol, ncell) + resolution : 0.001, 0.001 (x, y) + extent : -84.73151, -84.72251, 44.47648, 44.48348 (xmin, xmax, ymin, ymax) + crs : +proj=longlat +datum=WGS84 +no_defs + source : out.tif + names : out + + diff --git a/tests/testthat/_snaps/transmit_along_path.md b/tests/testthat/_snaps/transmit_along_path.md new file mode 100644 index 00000000..84eeb787 --- /dev/null +++ b/tests/testthat/_snaps/transmit_along_path.md @@ -0,0 +1,70 @@ +# data.frame input, spatial output gives expected result + + Code + tr_dfin_spout + Output + Simple feature collection with 8 features and 1 field + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.85012 ymin: 48.44519 xmax: -87.51364 ymax: 48.69558 + Geodetic CRS: WGS 84 (with axis order normalized for visualization) + time geometry + 1 600.8733 POINT (-87.51364 48.44519) + 2 1791.7514 POINT (-87.56015 48.48889) + 3 2833.5955 POINT (-87.60753 48.52348) + 4 3943.3385 POINT (-87.65978 48.55936) + 5 4909.4957 POINT (-87.7143 48.58339) + 6 5691.6579 POINT (-87.75888 48.60248) + 7 7374.9478 POINT (-87.81634 48.66588) + 8 8248.2156 POINT (-87.85012 48.69558) + +# data.frame input, data.frame output gives expected result + + Code + tr_dfin_dfout + Output + x y time + 1 -87.51364 48.44519 600.8733 + 2 -87.56015 48.48889 1791.7514 + 3 -87.60753 48.52348 2833.5955 + 4 -87.65978 48.55936 3943.3385 + 5 -87.71430 48.58339 4909.4957 + 6 -87.75888 48.60248 5691.6579 + 7 -87.81634 48.66588 7374.9478 + 8 -87.85012 48.69558 8248.2156 + +# spatial input, data.frame output gives expected result + + Code + tr_spin_dfout + Output + x y time + 1 -87.51364 48.44519 600.8733 + 2 -87.56015 48.48889 1791.7514 + 3 -87.60753 48.52348 2833.5955 + 4 -87.65978 48.55936 3943.3385 + 5 -87.71430 48.58339 4909.4957 + 6 -87.75888 48.60248 5691.6579 + 7 -87.81634 48.66588 7374.9478 + 8 -87.85012 48.69558 8248.2156 + +# spatial input, spatial output gives expected result + + Code + tr_spin_spout + Output + Simple feature collection with 8 features and 1 field + Geometry type: POINT + Dimension: XY + Bounding box: xmin: -87.85012 ymin: 48.44519 xmax: -87.51364 ymax: 48.69558 + Geodetic CRS: WGS 84 (with axis order normalized for visualization) + time geometry + 1 600.8733 POINT (-87.51364 48.44519) + 2 1791.7514 POINT (-87.56015 48.48889) + 3 2833.5955 POINT (-87.60753 48.52348) + 4 3943.3385 POINT (-87.65978 48.55936) + 5 4909.4957 POINT (-87.7143 48.58339) + 6 5691.6579 POINT (-87.75888 48.60248) + 7 7374.9478 POINT (-87.81634 48.66588) + 8 8248.2156 POINT (-87.85012 48.69558) + diff --git a/tests/testthat/_snaps/vrl2csv.md b/tests/testthat/_snaps/vrl2csv.md new file mode 100644 index 00000000..d0a18ee0 --- /dev/null +++ b/tests/testthat/_snaps/vrl2csv.md @@ -0,0 +1,48 @@ +# one vrl gives expected result + + Code + readLines(good_csv, n = 10) + Output + [1] "Date and Time (UTC),Receiver,Transmitter,Transmitter Name,Transmitter Serial,Sensor Value,Sensor Unit,Station Name,Latitude,Longitude,Transmitter Type,Sensor Precision" + [2] "2011-04-11 20:17:49,VR2W-109924,A69-1303-63366,,,,,,+0,+0" + [3] "2011-05-08 05:38:32,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [4] "2011-05-08 05:41:09,VR2W-109924,A69-9002-4043,,,7,ADC,,+0,+0" + [5] "2011-05-08 05:43:14,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + [6] "2011-05-08 05:44:15,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [7] "2011-05-08 05:45:59,VR2W-109924,A69-9002-4043,,,16,ADC,,+0,+0" + [8] "2011-05-08 05:46:36,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [9] "2011-05-08 05:48:07,VR2W-109924,A69-9002-4043,,,6,ADC,,+0,+0" + [10] "2011-05-08 05:48:31,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + +# one vrl in dir with space in name gives expected result + + Code + readLines(good_csv, n = 10) + Output + [1] "Date and Time (UTC),Receiver,Transmitter,Transmitter Name,Transmitter Serial,Sensor Value,Sensor Unit,Station Name,Latitude,Longitude,Transmitter Type,Sensor Precision" + [2] "2011-04-11 20:17:49,VR2W-109924,A69-1303-63366,,,,,,+0,+0" + [3] "2011-05-08 05:38:32,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [4] "2011-05-08 05:41:09,VR2W-109924,A69-9002-4043,,,7,ADC,,+0,+0" + [5] "2011-05-08 05:43:14,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + [6] "2011-05-08 05:44:15,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [7] "2011-05-08 05:45:59,VR2W-109924,A69-9002-4043,,,16,ADC,,+0,+0" + [8] "2011-05-08 05:46:36,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [9] "2011-05-08 05:48:07,VR2W-109924,A69-9002-4043,,,6,ADC,,+0,+0" + [10] "2011-05-08 05:48:31,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + +# one good vrl in dir with corrupt vrl gives expected result + + Code + readLines(out_csv, n = 10) + Output + [1] "Date and Time (UTC),Receiver,Transmitter,Transmitter Name,Transmitter Serial,Sensor Value,Sensor Unit,Station Name,Latitude,Longitude,Transmitter Type,Sensor Precision" + [2] "2011-04-11 20:17:49,VR2W-109924,A69-1303-63366,,,,,,+0,+0" + [3] "2011-05-08 05:38:32,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [4] "2011-05-08 05:41:09,VR2W-109924,A69-9002-4043,,,7,ADC,,+0,+0" + [5] "2011-05-08 05:43:14,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + [6] "2011-05-08 05:44:15,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [7] "2011-05-08 05:45:59,VR2W-109924,A69-9002-4043,,,16,ADC,,+0,+0" + [8] "2011-05-08 05:46:36,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0" + [9] "2011-05-08 05:48:07,VR2W-109924,A69-9002-4043,,,6,ADC,,+0,+0" + [10] "2011-05-08 05:48:31,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + diff --git a/tests/testthat/helper-make-test-data.R b/tests/testthat/helper-make-test-data.R new file mode 100644 index 00000000..7a42836e --- /dev/null +++ b/tests/testthat/helper-make-test-data.R @@ -0,0 +1,627 @@ +# For test-position_head_map.r +phm_values_known <- function() { + structure(c( + 43L, 20L, 23L, 19L, 21L, 19L, 25L, + 17L, 21L, 19L, 12L, 16L, 13L, 8L, 8L, 9L, 3L, 2L, 3L, 2L, 1L, + 4L, 2L, 35L, 19L, 20L, 18L, 22L, 20L, 21L, 14L, 15L, 18L, 14L, + 22L, 11L, 5L, 9L, 4L, 4L, 4L, 2L, 1L, 2L, 2L, 3L, 30L, 16L, 12L, + 11L, 15L, 14L, 12L, 16L, 10L, 13L, 16L, 13L, 14L, 10L, 8L, 4L, + NA, 2L, 4L, 4L, 5L, 4L, 3L, 22L, 13L, 9L, 10L, 11L, 10L, 14L, + 18L, 16L, 19L, 11L, 13L, 11L, 9L, 9L, 6L, 4L, 5L, 4L, 3L, 5L, + 4L, 1L, 23L, 5L, 7L, 9L, 10L, 10L, 12L, 14L, 17L, 12L, 9L, 7L, + 5L, 5L, 5L, 4L, 7L, 4L, 2L, 2L, 4L, 3L, 3L, 20L, 4L, 3L, 5L, + 8L, 10L, 13L, 16L, 12L, 15L, 13L, 11L, 7L, 6L, 4L, 5L, 3L, 2L, + 1L, 1L, 4L, 4L, NA, 19L, 2L, 7L, 7L, 12L, 14L, 11L, 11L, 11L, + 9L, 9L, 8L, 7L, 5L, 8L, 6L, 5L, 3L, 3L, 4L, 3L, 3L, 5L, 15L, + 3L, 8L, 9L, 10L, 11L, 11L, 11L, 13L, 13L, 15L, 12L, 9L, 5L, 5L, + 9L, 3L, 5L, 6L, 4L, 4L, 4L, 4L, 18L, 7L, 7L, 7L, 7L, 12L, 6L, + 12L, 10L, 11L, 15L, 17L, 11L, 9L, 11L, 3L, 7L, 7L, 5L, 5L, 7L, + 1L, 2L, 17L, 4L, 7L, 9L, 8L, 6L, 9L, 10L, 9L, 12L, 11L, 7L, 7L, + 8L, 10L, 10L, 8L, 5L, 1L, 5L, 5L, 6L, 2L, 16L, 7L, 2L, 5L, 8L, + 8L, 6L, 7L, 9L, 8L, 10L, 6L, 7L, 9L, 7L, 8L, 4L, 6L, 8L, 8L, + 7L, 3L, 3L, 17L, 6L, 4L, 8L, 7L, 8L, 6L, 9L, 10L, 9L, 13L, 8L, + 10L, 10L, 12L, 9L, 11L, 9L, 13L, 8L, 2L, 3L, 4L, 17L, 2L, 5L, + 9L, 10L, 6L, 9L, 9L, 12L, 8L, 9L, 7L, 11L, 5L, 6L, 11L, 8L, 10L, + 7L, 2L, 4L, 5L, 4L, 18L, 3L, 7L, 5L, 5L, 7L, 8L, 3L, 7L, 9L, + 8L, 12L, 12L, 15L, 12L, 12L, 8L, 7L, 5L, 5L, 6L, 2L, 1L, 12L, + 8L, 7L, 5L, 9L, 5L, 10L, 9L, 4L, 6L, 12L, 14L, 9L, 14L, 15L, + 7L, 5L, 4L, 5L, 5L, 3L, 6L, 4L, 12L, 7L, 7L, 7L, 10L, 5L, 9L, + 11L, 14L, 15L, 16L, 11L, 14L, 15L, 6L, 4L, 6L, 5L, 5L, 2L, 3L, + 6L, 6L, 26L, 12L, 15L, 20L, 28L, 31L, 36L, 37L, 46L, 49L, 54L, + 57L, 60L, 63L, 58L, 49L, 47L, 48L, 39L, 33L, 25L, 21L, 19L + ), .Dim = c( + 23L, + 17L + ), .Dimnames = structure(list(c( + "5150222", "5150122", "5150022", + "5149922", "5149822", "5149722", "5149622", "5149522", "5149422", + "5149322", "5149222", "5149122", "5149022", "5148922", "5148822", + "5148722", "5148622", "5148522", "5148422", "5148322", "5148222", + "5148122", "5148022" + ), c( + "719569", "719669", "719769", "719869", + "719969", "720069", "720169", "720269", "720369", "720469", "720569", + "720669", "720769", "720869", "720969", "721069", "721169" + )), .Names = c( + "", + "" + ))) +} + + +# For test-receiver_efficiency.r +hfx_receiver_efficiency_index <- function() { + structure( + list(station = c( + "HFX001", "HFX002", "HFX003", "HFX004", + "HFX005", "HFX006", "HFX007", "HFX008", "HFX009", "HFX010", "HFX011", + "HFX012", "HFX013", "HFX014", "HFX015", "HFX016", "HFX017", "HFX018", + "HFX019", "HFX020", "HFX021", "HFX022", "HFX023", "HFX024", "HFX025", + "HFX026", "HFX027", "HFX028", "HFX029", "HFX030", "HFX031", "HFX032", + "HFX033", "HFX034", "HFX035", "HFX036", "HFX037", "HFX038", "HFX039", + "HFX040", "HFX041", "HFX042", "HFX043", "HFX044", "HFX045", "HFX046", + "HFX047", "HFX048", "HFX049", "HFX050", "HFX051", "HFX052", "HFX053", + "HFX054", "HFX055", "HFX056", "HFX057", "HFX058", "HFX059", "HFX060", + "HFX061", "HFX062", "HFX063", "HFX064", "HFX065", "HFX066", "HFX067", + "HFX068", "HFX069", "HFX070", "HFX071", "HFX072", "HFX073", "HFX074", + "HFX075", "HFX076", "HFX077", "HFX078", "HFX079", "HFX080", "HFX081", + "HFX082", "HFX083", "HFX084", "HFX085", "HFX086", "HFX087", "HFX088", + "HFX089", "HFX090", "HFX091", "HFX092", "HFX093", "HFX094", "HFX095", + "HFX096", "HFX097", "HFX098", "HFX099", "HFX100", "HFX101", "HFX102", + "HFX103", "HFX104", "HFX105", "HFX106", "HFX107", "HFX108", "HFX109", + "HFX110", "HFX111", "HFX112", "HFX113", "HFX114", "HFX115", "HFX116", + "HFX117", "HFX118", "HFX119", "HFX120", "HFX121", "HFX122", "HFX123", + "HFX124", "HFX125", "HFX126", "HFX127", "HFX128", "HFX129", "HFX130", + "HFX131", "HFX132", "HFX133", "HFX134", "HFX135", "HFX136", "HFX137", + "HFX138", "HFX139", "HFX140", "HFX141", "HFX142", "HFX143", "HFX144", + "HFX145", "HFX146", "HFX147", "HFX148", "HFX149", "HFX150", "HFX151", + "HFX152", "HFX153", "HFX154", "HFX155", "HFX156", "HFX157", "HFX158", + "HFX159", "HFX160", "HFX161", "HFX162", "HFX163", "HFX164", "HFX165", + "HFX166", "HFX167", "HFX168", "HFX169", "HFX170", "HFX171", "HFX172", + "HFX173", "HFX174", "HFX175", "HFX176", "HFX177", "HFX178", "HFX179", + "HFX180", "HFX181", "HFX182", "HFX183", "HFX184", "HFX185", "HFX186", + "HFX187", "HFX188", "HFX189", "HFX190", "HFX191", "HFX192", "HFX193", + "HFX194", "HFX195", "HFX196", "HFX197", "HFX198", "HFX199", "HFX200", + "HFX201", "HFX202", "HFX203", "HFX204", "HFX205", "HFX206", "HFX207", + "HFX208", "HFX209", "HFX210", "HFX211", "HFX212", "HFX213", "HFX214", + "HFX215", "HFX216", "HFX217", "HFX218", "HFX219", "HFX220", "HFX221", + "HFX222", "HFX223", "HFX224", "HFX225", "HFX226", "HFX227", "HFX228", + "HFX229", "HFX230", "HFX231", "HFX232", "HFX233", "HFX234", "HFX235", + "HFX236", "HFX237", "HFX238", "HFX239", "HFX240", "HFX241", "HFX242", + "HFX243", "HFX244", "HFX245", "HFX246", "HFX247", "HFX248", "HFX249", + "HFX250", "HFX251", "HFX252", "HFX253", "HFX254", "HFX255", "HFX256" + ), latitude = c( + 44.4784398019802, 44.4723024482759, 44.4666508064516, + 44.4610676153846, 44.4551916666667, 44.4495551342282, 44.4435718960674, + 44.4376724347826, 44.4322934263959, 44.4263002160494, 44.4201856701031, + 44.4146651076321, 44.4087329514563, 44.403021013986, 44.3970783737024, + 44.3914915625, 44.3855497835498, 44.3798768561485, 44.3741773574045, + 44.3684355159648, 44.362973256262, 44.3571419512195, 44.3512523391089, + 44.3451172286374, 44.3393246019629, 44.3340587029624, 44.3277182426128, + 44.3226188888889, 44.3165625172414, 44.3105936758893, 44.3047808, + 44.2990175064488, 44.2931161571125, 44.2873048487141, 44.2816719847328, + 44.2195895147679, 44.2846399468085, 43.6516402863962, 44.2586467034068, + 44.252981980116, 44.2472888926175, 44.242369331307, 44.2362211627907, + 44.230495298913, 44.2206545991561, 44.21905, 44.2132852822581, + 44.2071202259887, 44.2020485818182, 44.1964227734375, 44.1907233548387, + 44.1850885384615, 44.1794826277372, 44.17387, 44.1681454153846, + 44.1626348537005, 44.15686, 44.1513683488372, 44.1135019434629, + 44.1398208445946, 44.1342792727273, 44.1288728384279, 44.1229017255717, + 44.1173704, 44.1116368674699, 44.1058232432432, 44.1000438741722, + 44.0945382736156, 44.0881734986945, 44.0832373353752, 44.0776513176265, + 44.0720459965035, 44.06625, 44.05994, 44.05354, 44.04911, 44.0384475431034, + 44.134063537415, 44.0279, 44.02162, 44.01518, 44.00873, 44.0027, + 43.99641, 43.98999, 43.98365, 43.97717, 43.97074, 43.96465, 43.95812, + 43.95173, 43.94532, 43.93904, 43.93265, 43.92633, 43.91994, 43.9134, + 43.90728, 43.90088, 43.89448, 43.88814, 43.88175, 43.87541, 43.86916, + 43.86264, 43.85627, 43.85201, 43.84738, 43.84366, 43.83852, 43.83428, + 43.83007, 43.82618, 43.82182, 43.81778, 43.8131980645161, 43.80840968, + 43.804304333996, 43.7998687804878, 43.7932530808081, 43.7865957142857, + 43.7798796629213, 43.7733213095238, 43.7667, 43.76021, 43.752952, + 43.74669703125, 43.73983, 43.7332184210526, 43.7267892307692, + 43.7199793103448, 43.713423125, 43.70638, 43.6998570588235, 43.6926779710145, + 43.685098974359, 43.6776485714286, 43.6704656521739, 43.6630838461538, + 43.65541, 43.64797, 43.640729, 43.63336, 43.627094, 43.6207466666667, + 43.614184, 43.6076310169492, 43.60166, 43.5954530357143, 43.5890148387097, + 43.5825766129032, 43.5761444067797, 43.5696846341463, 43.5634651724138, + 43.5571024, 43.5506, 43.5444, 43.5381164646465, 43.531735, 43.52528, + 43.51892, 43.5126674358974, 43.506225, 43.4998591891892, 43.4926146666667, + 43.48532, 43.47827, 43.47112, 43.46386, 43.45657, 43.4495, 43.4421, + 43.43491, 43.42778, 43.42051, 43.41323, 43.40624, 43.39898, 43.3919, + 43.3839113559322, 43.37737, 43.36992, 43.3631, 43.35567, 43.34852, + 43.34131, 43.33252, 43.32693, 43.31976, 43.31267, 43.30535, 43.29809, + 43.29098, 43.28379, 43.27641, 43.26901, 43.26221, 43.25488, 43.24799, + 43.24071, 43.23345, 43.22632, 43.21909, 43.21196, 43.20489, 43.1974648648649, + 43.19034, 43.18252, 43.17557, 43.1687, 43.16141, 43.15449, 43.14712, + 43.13988, 43.13266, 43.12533, 43.11846, 43.11101, 43.10386, 43.09654, + 43.08928, 43.08235, 43.07501, 43.06784, 43.06054, 43.05329, 43.04632, + 43.0391, 43.03187, 43.02455, 43.01746, 43.01016, 43.00303, 42.9958, + 42.98856, 42.98146, 42.97416, 42.96708, 42.95967, 42.95246, 42.94533, + 42.93799, 42.93086, 42.92372, 42.916286744186, 42.90925, 42.90203, + 42.89487, 42.88764, 42.88042, 42.87317, 42.86598, 42.8588, 42.85166, + 42.84442, 42.83737 + ), longitude = c( + -63.5333763366337, -63.5269339655172, + -63.5200411693548, -63.5140228461538, -63.5077485087719, -63.5009823825503, + -63.4941791432584, -63.4880379130435, -63.4813606218274, -63.4751074382716, + -63.4685693519882, -63.4621277886497, -63.4558474174757, -63.4487153146853, + -63.4426002076125, -63.4360236979167, -63.4298772438672, -63.4230945475638, + -63.4168982940869, -63.4101426654327, -63.4023615992293, -63.3974944850948, + -63.3909311262376, -63.3842537759815, -63.377850348964, -63.3713183827062, + -63.3647795489891, -63.3597477777778, -63.3519217931035, -63.3453266007905, + -63.3386898434783, -63.3323952450559, -63.3259785138004, -63.3197691906203, + -63.3130440330789, -63.9073214345992, -63.3202238297872, -64.9284846300716, + -63.2876916533066, -63.2810401077051, -63.2749722818792, -63.2681703951368, + -63.2620515742397, -63.2564305434783, -63.2499893670886, -63.2434346047431, + -63.2371794354839, -63.2312440112994, -63.2246610545455, -63.2189780078125, + -63.2126161935484, -63.2062673461538, -63.2000200729927, -63.1937021282401, + -63.1875617846154, -63.1811118072289, -63.1749595793499, -63.1685094883721, + -63.2591738162544, -63.1561848141892, -63.1495723636364, -63.1436744323144, + -63.1375132016632, -63.1309038909091, -63.1247902409639, -63.1182235735736, + -63.112007615894, -63.1054898045603, -63.1005381462141, -63.0933156814701, + -63.0868376178011, -63.0806824125874, -63.07414, -63.0792, -63.08357, + -63.08809, -63.0969261206897, -62.9843613605442, -63.10217, -63.10683, + -63.11176, -63.11657, -63.1213, -63.12604, -63.13182, -63.1366, + -63.14147, -63.14619, -63.15083, -63.15571, -63.16059, -63.16522, + -63.16999, -63.17481, -63.17962, -63.18439, -63.1888349367089, + -63.19393, -63.19874, -63.20349, -63.20832, -63.21309, -63.21791, + -63.22261, -63.22745, -63.23223, -63.23979, -63.2469, -63.25558, + -63.2625, -63.27016, -63.27802, -63.28576, -63.29423, -63.30154, + -63.3093506451613, -63.31715816, -63.3255161232604, -63.3331092195122, + -63.3373797979798, -63.34226, -63.3464540449438, -63.3506098809524, + -63.35541, -63.36019, -63.364389, -63.3691428125, -63.3727, -63.3775568421053, + -63.3824750769231, -63.3866017241379, -63.391106875, -63.39574, + -63.4000829411765, -63.3999888405797, -63.4000625641026, -63.3999214285714, + -63.399828115942, -63.3997935897436, -63.39962, -63.39958, -63.3996306666667, + -63.39955, -63.404484, -63.4092066666667, -63.414138, -63.4190913559322, + -63.42339, -63.42824375, -63.4330585483871, -63.4379172580645, + -63.4428172881356, -63.4475014634146, -63.4522996551724, -63.4571352, + -63.46193, -63.4665314285714, -63.4712249494949, -63.4762175, + -63.481, -63.48577, -63.4904820512821, -63.495327631579, -63.500117027027, + -63.500012, -63.49993, -63.49999, -63.50007, -63.49996, -63.50004, + -63.50019, -63.50004, -63.49997, -63.50003, -63.50009, -63.50002, + -63.50004, -63.49997, -63.49997, -63.4988177966102, -63.50005, + -63.50012, -63.50003, -63.50009, -63.50005, -63.49999, -63.49986, + -63.50003, -63.49999, -63.50004, -63.5, -63.50006, -63.50002, + -63.50001, -63.49989, -63.4998, -63.5, -63.49993, -63.49988, + -63.5, -63.50009, -63.5001, -63.5001, -63.5, -63.50003, -63.4998275675676, + -63.49998, -63.49755, -63.4989, -63.50024, -63.49966, -63.49789, + -63.50007, -63.49985, -63.49995, -63.49983, -63.50012, -63.4999, + -63.49987, -63.50001, -63.5, -63.50011, -63.50005, -63.50017, + -63.49996, -63.49983, -63.50005, -63.50001, -63.50005, -63.50002, + -63.50025, -63.49989, -63.5001, -63.5, -63.49994, -63.50004, + -63.49993, -63.50002, -63.49997, -63.49992, -63.49998, -63.49992, + -63.49999, -63.50004, -63.4993546511628, -63.49999, -63.49995, + -63.50002, -63.50002, -63.49993, -63.50004, -63.49995, -63.49997, + -63.49995, -63.50003, -63.49981 + ), rei = c( + 0.00580962595813294, + 0.00367974146481378, 0.00539465267540915, 0.00237666516469075, + 0.000616975249894385, 0.00605000338855328, 0.0102685716970085, + 0.00940763294356754, 0.0154615103597092, 0.0045924944994297, + 0.00987950455711003, 0.00710948303275562, 0.0108631411736046, + 0.0133844375869352, 0.0103145677269121, 0.0151580743135218, 0.0109762569773178, + 0.0175116715379229, 0.0193365593241384, 0.0222672565967032, 0.0221161897269833, + 0.0178835807361363, 0.0180370531995448, 0.0172777683805761, 0.0144151936180136, + 0.0153620948583662, 0.00844098548747172, 0.00581493964041172, + 0.0124007237265634, 0.021779150551173, 0.0103719793984492, 0.0246520082878421, + 0.0251013938555892, 0.0309982419752233, 0.0369323090167397, 0.00347540124281167, + 0.00602265863414448, 0.018715344304749, 0.0207190190354482, 0.0255471611243613, + 0.0195522377469652, 0.00413253545156261, 0.0212486376004305, + 0.00599967097300492, 0.0047843815878331, 0.0232577804139694, + 0.0196386309600345, 0.00400984628733441, 0.00561428454528765, + 0.00692997841256096, 0.00824428466321907, 0.0175639108042493, + 0.0132983896089316, 0.0147232170670315, 0.013172933103187, 0.0177431343838845, + 0.010036520459571, 0.00815467287340147, 0.00676259482025538, + 0.00746018150231508, 0.00165326390894481, 0.0149114018256484, + 0.0127129259154567, 0.00885364483397874, 0.0109147159997835, + 0.00581317114355189, 0.00234539325462903, 0.00736448661001295, + 0.00300540487039514, 0.00309126598444988, 0.00545517526667626, + 0.00590693196844789, 0.00343520698422078, 0.00403825740602252, + 0.00389323458211689, 0.00479835115118015, 0.00177387997563415, + 0.00466563653309299, 0.000875488631092519, 0.00131323294663878, + 0.00172403915045911, 0.00202035837944427, 0.00272748381224977, + 0.00214663077815954, 0.00243284821524748, 0.00266081996345123, + 0.000814877879709191, 0.000925997590578626, 0.00170720283063041, + 0.00121221502766657, 0.00176781358201374, 0.00243116458326461, + 0.00194627857219799, 0.000673452793148092, 0.00105058635731102, + 0.000963037494201771, 0.000353976052508596, 0.0013095991499966, + 0.00096215447754852, 0.00096215447754852, 0.000668162831630916, + 0.000601346548467825, 0.000280628389284985, 0.00024053861938713, + 0.000668162831630916, 0.0013095991499966, 0.000808477026273409, + 0.000180403964540347, 5.34530265304733e-05, 0.000467713982141642, + 0.000668162831630917, 0.000534530265304733, 0.000751683185584781, + 0.000601346548467825, 0.000601346548467825, 0.00132942570800301, + 0.00132942570800301, 0.00147259463040333, 0.00261794600960592, + 0.00472457443921068, 0.00157485814640356, 0.00159531084960361, + 0.00112489867600254, 0.000102263516000231, 3.06790548000694e-05, + 0.000284757807643562, 0.000681756773334875, 0.000165760915675258, + 0.00088405821693471, 0.000696195845836084, 0.00016122805496926, + 0.000138134096396048, 0.000270742828936255, 0.000663043662701033, + 0.000994565494051549, 0.00088333893879963, 8.8405821693471e-05, + 0.000276268192792097, 0.000117874428924628, 0.000165760915675258, + 6.63043662701033e-05, 0.000206280250618099, 0.000138134096396048, + 1.47343036155785e-05, 1.22867720705463e-05, 2.76452371587292e-05, + 0.000214700436513799, 0.00043003702246912, 0.00101365869582007, + 0.000622017836071406, 0.00128725051071688, 0.00043003702246912, + 0.000232685362859043, 0.000735571720409645, 0.000552904743174583, + 0.000122867720705463, 0.000552904743174583, 0.00110580948634917, + 0.000387033320222208, 0.000115188488161372, 0.000184301581058194, + 0.000184301581058194, 0.000393176706257481, 0.000258022213481472, + 0.000301025915728384, 0.000301025915728384, 0.000234092734005368, + 0.000156061822670245, 0.000156061822670245, 5.09589625045699e-05, + 0.000171986498452923, 0.000119435068370086, 7.96233789133905e-05, + 7.64384437568548e-05, 6.36987031307124e-05, 0.00010191792500914, + 7.64384437568548e-05, 0.000445890921914987, 0.000445890921914987, + 0.000313988238250925, 0.000458630662541129, 0.00031212364534049, + 0.000119435068370086, 7.64384437568548e-05, 0.000390154556675613, + 0.000229315331270565, 0.000200766563804027, 0.000267688751738703, + 5.09883336645149e-05, 0.000267688751738703, 0.000267688751738703, + 0.000458895002980634, 9.56031256209654e-05, 7.64825004967723e-05, + 7.64825004967723e-05, 2.86809376862896e-05, 6.37354170806436e-06, + 5.73618753725793e-05, 0.000229447501490317, 0.000717023442157241, + 0.000750323083318946, 0.000675290774987051, 0.000210090463329305, + 0.000150064616663789, 0.000240103386662063, 0.000675290774987051, + 0.00032013784888275, 8.00344622206876e-05, 5.78621242857122e-05, + 1.66738462959766e-06, 1.50064616663789e-05, 0.000129731839180628, + 0.000175075386107754, 0.000210090463329305, 0.000194489105639301, + 0.000138920789742358, 4.93940585750605e-05, 0.000345758410025423, + 0.000345758410025423, 0.000444546527175544, 0.000222273263587772, + 0.000302538608772245, 0.000302538608772245, 0.000138920789742358, + 0.000115767324785298, 0.000296364351450363, 0.000162074254699417, + 0.00100331681480592, 0.00075435065735447, 0.000432198012531779, + 0.000491159035814985, 0.000284170585007241, 0.000105248364817497, + 1.75413941362495e-06, 1.75413941362495e-06, 0.000221021566116743, + 0.000157872547226245, 5.61324612359983e-05, 0.000171905662535245, + 0.000171905662535245, 3.1574509445249e-05, 0.000368369276861239, + 0.000589390842977982, 0.000463092805196986, 0.000197576234300242, + 0.000561324612359983, 0.00171028592828432, 0.000877069706812474, + 0.00125420968074184, 0.00171905662535245, 0.00137524530028196, + 0.00100336774459347, 0.000993907960703525, 0.00136822874262746, + 0.00136822874262746, 0.00147347710744496 + )), + class = "data.frame", + row.names = c( + NA, + -256L + ) + ) +} + +glatos_receiver_efficiency_index <- function() { + structure( + list(station = c( + "DRF-004", "DRL-004", "DRL-010", "DRL-011", + "DRU-001", "DRU-002", "DRU-004", "DRU-005", "DRU-006", "DRU-007", + "DRU-008", "FMP-001", "FMP-002", "FMP-003", "MAU-001", "MAU-002", + "MAU-003", "MAU-011", "MAU-012", "OSC-001", "OSC-002", "OSC-003", + "PRS-001", "PRS-002", "PRS-003", "RAR-001", "RAR-002", "RAR-003", + "RAR-004", "RAR-005", "SBI-001", "SBI-002", "SBI-003", "SBI-007", + "SBI-008", "SBI-009", "SBI-010", "SBI-011", "SBI-012", "SBI-013", + "SBI-014", "SBI-015", "SBI-016", "SBI-017", "SBI-018", "SBI-019", + "SBI-020", "SBO-001", "SBO-002", "SBO-003", "SBO-004", "SBO-005", + "SBO-006", "SBO-007", "SBO-008", "SBO-009", "SBO-010", "SBO-012", + "SCL-001", "SCL-002", "SCL-004", "SCL-005", "SCM-001", "SCM-002", + "SCM-003", "SGR-001", "SHR-001", "STG-006", "THB-003", "THB-004", + "THB-005", "THB-006", "THB-007", "THB-008", "THB-009", "THB-010", + "THB-011", "THB-014", "THB-015", "THB-016", "TSR-001", "TTB-001" + ), latitude = c( + 42.24937, 42.12746, 42.0769, 42.09637, 42.35693, + 42.35278, 42.35469, 42.35085, 42.34447, 42.33541, 42.33204, 45.48983, + 45.49914, 45.50756, 41.57098, 41.57417, 41.57612, 41.63532, 41.6443, + 44.45198, 44.45157, 44.45144, 45.33385, 45.33986, 45.34603, 41.63719, + 41.63648, 41.64165, 41.63846, 41.63288, 44.17873, 44.1771329411765, + 44.17255, 44.15439, 44.14975, 44.14524, 44.14066, 44.13613, 44.13149, + 44.12695, 44.12241, 44.11781, 44.11329, 44.10875, 44.10408, 44.09961, + 44.09214, 44.2464643333333, 44.2417948571429, 44.2370746835443, + 44.2323153731343, 44.22771, 44.2229290625, 44.21828, 44.21342, + 44.2088, 44.2041, 44.19472, 42.61334, 42.61462, 42.55267, 42.54992, + 42.77913, 42.76994, 42.6352, 43.61235, 43.37698, 44.71315, 44.90447, + 44.91327, 44.92215, 44.9308, 44.93957, 44.94818, 44.95714, 44.96585, + 44.97452, 45.00077, 45.0095, 45.01824, 41.62433, 43.387016744186 + ), longitude = c( + -83.11824, -83.11873, -83.12096, -83.11681, + -82.93016, -82.92844, -82.94291, -82.93774, -82.93849, -83.00901, + -83.00352, -83.91048, -83.9059, -83.90137, -83.61776, -83.60687, + -83.61071, -83.53083, -83.53426, -83.31861, -83.30572, -83.29315, + -83.45837, -83.44852, -83.43862, -82.97453, -82.96842, -82.97328, + -82.98027, -82.97516, -83.5477078947368, -83.5417041176471, -83.5309, + -83.48782, -83.47694, -83.46626, -83.45551, -83.44487, -83.43403, + -83.42327, -83.41245, -83.40174, -83.39079, -83.38007, -83.36923, + -83.35869, -83.35204, -83.445841, -83.4350991428571, -83.4244859493671, + -83.4138805970149, -83.4031, -83.3923328125, -83.38175, -83.37122, + -83.36047, -83.34985, -83.32868, -82.52119, -82.52926, -82.58909, + -82.58493, -82.47231, -82.47034, -82.49834, -83.8609006451613, + -83.99115, -83.2011, -83.31385, -83.31073, -83.30769, -83.30461, + -83.30165, -83.29828, -83.29516, -83.29228, -83.28925, -83.27969, + -83.27665, -83.27346, -83.01284, -83.9873130232558 + ), rei = c( + 0.00123899096401187, + 0.00156294731698745, 0.00141378636972309, 0.00116287547816814, + 0.00168674512427359, 0.001577419051404, 0.00154873870501484, + 0.00347676035819657, 0.00329200497684313, 0.00181235380374077, + 0.00120609739859563, 0.0335136900101571, 0.00645919459911402, + 0.00903773249610781, 0.042590314387908, 0.00900588145647395, + 0.0278709623806351, 0.127770943163724, 0.0448319098820085, 0.00146863153061752, + 0.00146863153061752, 0.00104676655945703, 0.00740701119789705, + 0.0126977334821092, 0.0105814445684244, 0.106732354128733, 0.0903119919550821, + 0.0985221730419077, 0.0985221730419077, 0.106732354128733, 0.00205564111676178, + 0.00217020710256856, 0.00102627263585321, 0.000953069972316823, + 0.000939924179595212, 0.00187984835919042, 0.00187725903638162, + 0.00187725903638162, 0.00187725903638162, 0.00187725903638162, + 0.000938629518190811, 0.00187725903638162, 0.00100360092813922, + 0.00100508116549635, 0.000938629518190811, 0.000945138738150525, + 0.00100508116549635, 0.00216103075118349, 0.00373906738110578, + 0.00285920991695047, 0.00285920991695047, 0.00190613994463365, + 0.00285920991695047, 0.000953069972316823, 0.000953069972316823, + 0.000957085716582203, 0.000957085716582203, 0.000957085716582203, + 0.00176998709144553, 0.00176998709144553, 0.00176998709144553, + 0.0033568720699829, 0.00117897064049572, 0.00117897064049572, + 0.0016224881671584, 0.00410509054341282, 0.00327617802983908, + 0.00109733499228104, 0.0011008805011414, 0.00104196487799163, + 0.00104196487799163, 0.00208392975598327, 0.00104196487799163, + 0.000994810263075224, 0.000994810263075224, 0.000994810263075224, + 0.0011008805011414, 0.000994810263075224, 0.00198962052615045, + 0.00194977118800151, 0.0574712676077795, 0.00411335028293679 + )), + class = "data.frame", row.names = c( + NA, + -82L + ) + ) +} + + +# For test-residence_index.r +blueshark_ri_kessel_data <- function() { + structure(list( + days_detected = c( + 9, 9, 7, 8, 9, 3, 2, 10, 10, + 9, 7, 4, 2, 1, 2, 1, 2, 2, 2, 2, 10, 5, 3, 2, 3, 3, 3, 2, 2, + 4, 2, 2, 2, 2, 2, 1, 2, 2, 1, 1 + ), residency_index = c( + 0.818181818181818, + 0.818181818181818, 0.636363636363636, 0.727272727272727, 0.818181818181818, + 0.272727272727273, 0.181818181818182, 0.909090909090909, 0.909090909090909, + 0.818181818181818, 0.636363636363636, 0.363636363636364, 0.181818181818182, + 0.0909090909090909, 0.181818181818182, 0.0909090909090909, 0.181818181818182, + 0.181818181818182, 0.181818181818182, 0.181818181818182, 0.909090909090909, + 0.454545454545455, 0.272727272727273, 0.181818181818182, 0.272727272727273, + 0.272727272727273, 0.272727272727273, 0.181818181818182, 0.181818181818182, + 0.363636363636364, 0.181818181818182, 0.181818181818182, 0.181818181818182, + 0.181818181818182, 0.181818181818182, 0.0909090909090909, 0.181818181818182, + 0.181818181818182, 0.0909090909090909, 0.0909090909090909 + ), + location = c( + "HFX034", + "HFX035", "HFX047", "HFX046", "HFX043", "HFX053", "HFX054", "HFX041", + "HFX040", "HFX038(lost/found)", "HFX033", "HFX052", "HFX051", + "HFX062", "HFX063", "HFX060", "HFX059(lost/found)", "HFX057", + "HFX058", "HFX056", "HFX039", "HFX048", "HFX049", "HFX055", "HFX032", + "HFX031", "HFX030", "HFX029", "HFX028", "HFX024", "HFX023", "HFX050", + "HFX027", "HFX025", "HFX026", "HFX021", "HFX017", "HFX016", "HFX013", + "HFX014" + ), mean_latitude = c( + 44.28729, 44.28173, 44.2133, 44.21905, + 44.23626, 44.17948, 44.17387, 44.24714, 44.25293, 43.4, 44.29311, + 44.18508, 44.19071, 44.12893, 44.12289, 44.13981, 44.1, 44.15686, + 44.15139, 44.16265, 44.25865, 44.20696, 44.20203, 44.16814, 44.29906, + 44.30479, 44.3106, 44.31668, 44.32302, 44.34509, 44.35121, 44.19641, + 44.32771, 44.33924, 44.33408, 44.36267, 44.3855, 44.39144, 44.40863, + 44.403 + ), mean_longitude = c( + -63.31992, -63.3131, -63.23715, -63.24336, + -63.26195, -63.20007, -63.19376, -63.27502, -63.28102, -65.6, + -63.32598, -63.20632, -63.21268, -63.14374, -63.13765, -63.15623, + -63.3, -63.17499, -63.16853, -63.18116, -63.28784, -63.23135, + -63.2246, -63.18762, -63.33237, -63.33867, -63.34534, -63.35154, + -63.36093, -63.38422, -63.39103, -63.21911, -63.36478, -63.37781, + -63.3713, -63.40261, -63.42997, -63.43603, -63.45589, -63.44875 + ) + ), class = "data.frame", row.names = c(NA, -40L)) +} + + +blueshark_ri_td_data <- function() { + structure(list(days_detected = c( + 0, 0.0119907407407407, 0.229189814814815, + 0.236770833333333, 0, 0.0171296296296296, 5.30424768518519, 4.31056712962963, + 4.33679398148148, 0.132662037037037, 0.374652777777778, 0.417314814814815, + 1.61196759259259, 2.45387731481481, 2.45918981481482, 7.69414351851852, + 9.8066087962963, 9.83518518518519, 10.2265046296296, 9.73806712962963, + 9.64605324074074, 10.383599537037, 10.0781134259259, 8.96850694444444, + 8.33770833333333, 7.58980324074074, 7.56431712962963, 2.16046296296296, + 0.714791666666667, 7.77197916666667, 7.0502662037037, 7.26163194444444, + 7.20189814814815, 7.28798611111111, 7.31960648148148, 7.31309027777778, + 7.33803240740741, 0.0037037037037037, 0.029212962962963, 1.98929398148148 + ), total_days = c( + 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, + 10.6743055555556 + ), residency_index = c( + 0, 0.0011233274781515, + 0.0214711686509227, 0.0221813805217618, 0, 0.00160475354021642, + 0.496917355192679, 0.40382646975907, 0.406283477544293, 0.0124281655932167, + 0.0350985622275714, 0.0390952659770564, 0.151013813891961, 0.229886366100666, + 0.230384056556719, 0.72080974996205, 0.91871164313751, 0.921388762388047, + 0.958048706438531, 0.912290460390779, 0.903670331576779, 0.972765814412422, + 0.94414698674994, 0.840195823303624, 0.781100774185154, 0.711034849174853, + 0.708647236137315, 0.202398455966864, 0.0669637629301932, 0.728101619933641, + 0.660489449829766, 0.680290807364518, 0.674694771539479, 0.682759742371999, + 0.685722030663804, 0.685111573742762, 0.687448225012469, 0.000346973738425173, + 0.00273675536182855, 0.186362847786958 + ), location = c( + "HFX013", + "HFX014", "HFX016", "HFX017", "HFX021", "HFX023", "HFX024", "HFX025", + "HFX026", "HFX027", "HFX028", "HFX029", "HFX030", "HFX031", "HFX032", + "HFX033", "HFX034", "HFX035", "HFX038(lost/found)", "HFX039", + "HFX040", "HFX041", "HFX043", "HFX046", "HFX047", "HFX048", "HFX049", + "HFX050", "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", "HFX056", + "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", "HFX062", + "HFX063" + ), mean_latitude = c( + 44.40863, 44.403, 44.39144, 44.3855, + 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, 44.32771, 44.32302, + 44.31668, 44.3106, 44.30479, 44.29906, 44.29311, 44.28729, 44.28173, + 43.4, 44.25865, 44.25293, 44.24714, 44.23626, 44.21905, 44.2133, + 44.20696, 44.20203, 44.19641, 44.19071, 44.18508, 44.17948, 44.17387, + 44.16814, 44.16265, 44.15686, 44.15139, 44.1, 44.13981, 44.12893, + 44.12289 + ), mean_longitude = c( + -63.45589, -63.44875, -63.43603, + -63.42997, -63.40261, -63.39103, -63.38422, -63.37781, -63.3713, + -63.36478, -63.36093, -63.35154, -63.34534, -63.33867, -63.33237, + -63.32598, -63.31992, -63.3131, -65.6, -63.28784, -63.28102, + -63.27502, -63.26195, -63.24336, -63.23715, -63.23135, -63.2246, + -63.21911, -63.21268, -63.20632, -63.20007, -63.19376, -63.18762, + -63.18116, -63.17499, -63.16853, -63.3, -63.15623, -63.14374, + -63.13765 + )), class = "data.frame", row.names = c(NA, -40L)) +} + +blueshark_ri_awo_data <- function() { + structure(list( + days_detected = c( + 1.15740740740741e-05, 0.0119907407407407, + 0.0194560185185185, 0.0268055555555556, 1.15740740740741e-05, + 0.00408564814814815, 0.0284259259259259, 0.0267708333333333, + 0.0147222222222222, 0.00701388888888889, 0.0450115740740741, + 0.0911342592592593, 0.0759027777777778, 0.0404050925925926, 0.0612847222222222, + 0.0534259259259259, 0.159791666666667, 0.209270833333333, 0.408425925925926, + 0.191180555555556, 0.209421296296296, 0.389039351851852, 0.572581018518519, + 0.262407407407407, 1.3865625, 0.0394097222222222, 0.0647106481481481, + 0.0103472222222222, 0.0173263888888889, 0.039837962962963, 0.0577199074074074, + 0.0722106481481481, 0.019212962962963, 2.31481481481481e-05, + 0.0226157407407407, 0.00652777777777778, 0.00385416666666667, + 0.0037037037037037, 0.0180555555555556, 0.0218865740740741 + ), + total_days = c( + 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, + 4.69258101851852 + ), residency_index = c( + 2.46646227915913e-06, + 0.00255525492120886, 0.0041461230912665, 0.00571232663853255, + 2.46646227915913e-06, 0.000870661184543174, 0.00605763135761483, + 0.00570492725169508, 0.00313734001909042, 0.00149467614117043, + 0.00959207180364987, 0.019420923986099, 0.0161750596267256, + 0.00861041981654453, 0.0130599177681476, 0.0113851898805986, + 0.034051978226071, 0.0445961044694763, 0.0870365209069675, + 0.0407410239271506, 0.0446281684791054, 0.082905196589376, + 0.122018355412281, 0.0559196327930959, 0.295479714580985, + 0.00839830406053685, 0.0137899906027787, 0.00220501727756827, + 0.00369229403190122, 0.00848956316486574, 0.0123002473861666, + 0.0153882581596738, 0.00409432738340416, 4.93292455831827e-06, + 0.00481946729347695, 0.00139108472544575, 0.000821331938959991, + 0.000789267929330923, 0.00384768115548825, 0.00466408016988992 + ), location = c( + "HFX013", "HFX014", "HFX016", "HFX017", "HFX021", + "HFX023", "HFX024", "HFX025", "HFX026", "HFX027", "HFX028", + "HFX029", "HFX030", "HFX031", "HFX032", "HFX033", "HFX034", + "HFX035", "HFX038(lost/found)", "HFX039", "HFX040", "HFX041", + "HFX043", "HFX046", "HFX047", "HFX048", "HFX049", "HFX050", + "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", "HFX056", + "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", "HFX062", + "HFX063" + ), mean_latitude = c( + 44.40863, 44.403, 44.39144, + 44.3855, 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, + 44.32771, 44.32302, 44.31668, 44.3106, 44.30479, 44.29906, + 44.29311, 44.28729, 44.28173, 43.4, 44.25865, 44.25293, 44.24714, + 44.23626, 44.21905, 44.2133, 44.20696, 44.20203, 44.19641, + 44.19071, 44.18508, 44.17948, 44.17387, 44.16814, 44.16265, + 44.15686, 44.15139, 44.1, 44.13981, 44.12893, 44.12289 + ), + mean_longitude = c( + -63.45589, -63.44875, -63.43603, -63.42997, + -63.40261, -63.39103, -63.38422, -63.37781, -63.3713, -63.36478, + -63.36093, -63.35154, -63.34534, -63.33867, -63.33237, -63.32598, + -63.31992, -63.3131, -65.6, -63.28784, -63.28102, -63.27502, + -63.26195, -63.24336, -63.23715, -63.23135, -63.2246, -63.21911, + -63.21268, -63.20632, -63.20007, -63.19376, -63.18762, -63.18116, + -63.17499, -63.16853, -63.3, -63.15623, -63.14374, -63.13765 + ) + ), class = "data.frame", row.names = c(NA, -40L)) +} + + +blueshark_ri_ano_data <- function() { + structure(list(days_detected = c( + 0, 0.0119907407407407, 0.0194328703703704, + 0.0267708333333333, 0, 0.00405092592592593, 0.0283449074074074, + 0.0266782407407407, 0.0146759259259259, 0.00700231481481481, + 0.0447916666666667, 0.0909027777777778, 0.0752199074074074, 0.0400578703703704, + 0.0607291666666667, 0.0529050925925926, 0.159155092592593, 0.208831018518519, + 0.406840277777778, 0.180983796296296, 0.20625, 0.388391203703704, + 0.565081018518519, 0.262349537037037, 1.3865162037037, 0.0392013888888889, + 0.0642708333333333, 0.0100115740740741, 0.0171990740740741, 0.0394097222222222, + 0.0570949074074074, 0.0702546296296296, 0.0190046296296296, 0, + 0.0225347222222222, 0.00640046296296296, 0.00375, 0.0037037037037037, + 0.0180324074074074, 0.0218518518518519 + ), total_days = c( + 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, + 4.046875, 4.046875, 4.046875, 4.046875 + ), residency_index = c( + 0, + 0.00296296296296296, 0.0048019448019448, 0.00661518661518662, + 0, 0.001001001001001, 0.007004147004147, 0.00659230659230659, + 0.00362648362648363, 0.00173030173030173, 0.0110682110682111, + 0.0224624624624625, 0.0185871585871586, 0.0098984698984699, 0.015006435006435, + 0.0130730730730731, 0.0393278993278993, 0.0516030316030316, 0.100531960531961, + 0.0447218647218647, 0.050965250965251, 0.095973115973116, 0.13963391963392, + 0.0648276848276848, 0.342614042614043, 0.00968682968682969, 0.0158815958815959, + 0.00247390247390247, 0.00424996424996425, 0.00973830973830974, + 0.0141083941083941, 0.0173602173602174, 0.0046961246961247, 0, + 0.00556842556842557, 0.00158158158158158, 0.000926640926640927, + 0.000915200915200915, 0.00445588445588446, 0.0053996853996854 + ), location = c( + "HFX013", "HFX014", "HFX016", "HFX017", "HFX021", + "HFX023", "HFX024", "HFX025", "HFX026", "HFX027", "HFX028", "HFX029", + "HFX030", "HFX031", "HFX032", "HFX033", "HFX034", "HFX035", "HFX038(lost/found)", + "HFX039", "HFX040", "HFX041", "HFX043", "HFX046", "HFX047", "HFX048", + "HFX049", "HFX050", "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", + "HFX056", "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", + "HFX062", "HFX063" + ), mean_latitude = c( + 44.40863, 44.403, 44.39144, + 44.3855, 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, 44.32771, + 44.32302, 44.31668, 44.3106, 44.30479, 44.29906, 44.29311, 44.28729, + 44.28173, 43.4, 44.25865, 44.25293, 44.24714, 44.23626, 44.21905, + 44.2133, 44.20696, 44.20203, 44.19641, 44.19071, 44.18508, 44.17948, + 44.17387, 44.16814, 44.16265, 44.15686, 44.15139, 44.1, 44.13981, + 44.12893, 44.12289 + ), mean_longitude = c( + -63.45589, -63.44875, + -63.43603, -63.42997, -63.40261, -63.39103, -63.38422, -63.37781, + -63.3713, -63.36478, -63.36093, -63.35154, -63.34534, -63.33867, + -63.33237, -63.32598, -63.31992, -63.3131, -65.6, -63.28784, + -63.28102, -63.27502, -63.26195, -63.24336, -63.23715, -63.23135, + -63.2246, -63.21911, -63.21268, -63.20632, -63.20007, -63.19376, + -63.18762, -63.18116, -63.17499, -63.16853, -63.3, -63.15623, + -63.14374, -63.13765 + )), class = "data.frame", row.names = c( + NA, + -40L + )) +} diff --git a/tests/testthat/test-adjust_playback_time.r b/tests/testthat/test-adjust_playback_time.r index 67d980f8..54abe565 100644 --- a/tests/testthat/test-adjust_playback_time.r +++ b/tests/testthat/test-adjust_playback_time.r @@ -1,76 +1,95 @@ -context("Check adjust_playback_time") - # load example frames frames <- system.file("extdata", "frames", package = "glatos") # make video animation temp_dir <- tempdir() -temp_file <- tempfile(fileext = ".mp4") -make_video( + +temp_file <- make_video( input_dir = frames, intput_ext = ".png", - output = temp_file + output = tempfile(fileext = ".mp4") ) +# Testing file size results # slow video down by a factor of 10 -temp_file_1 <- tempfile(fileext = ".mp4") -adjust_playback_time( - scale_factor = 10, - input = temp_file, - output_dir = temp_dir, - output = basename(temp_file_1) -) - -# speed up by a factor of 10 -temp_file_2 <- tempfile(fileext = ".mp4") -adjust_playback_time( - scale_factor = 0.1, - input = temp_file, - output_dir = temp_dir, - output = basename(temp_file_2) -) - -# call from input path and name containing spaces and parentheses -temp_dir_3 <- file.path(temp_dir, "path with ( spaces)") -dir.create(temp_dir_3) -temp_file_3 <- tempfile( - pattern = "fname with ( special)", - tmpdir = temp_dir_3, - fileext = ".mp4" -) -adjust_playback_time( - scale_factor = 0.1, - input = temp_file, - output_dir = temp_dir_3, - output = basename(temp_file_3) -) - -# Actual file sizes -vid_size <- file.info(c(temp_file_1, temp_file_2, temp_file_3))$size -# round to MB -vid_size <- round(vid_size * 0.001) - -# Expected file sizes -size_should_be <- round(c(93158, 56817, 56817) * 0.001) +test_that("slow down gives expected result", { + temp_file_1 <- tempfile(fileext = ".mp4") -# Clean up -unlink(list.files(temp_dir, - full.names = TRUE, recursive = TRUE, - include.dirs = TRUE -), recursive = TRUE) + # check no error + expect_no_error( + slow_down <- adjust_playback_time( + scale_factor = 10, + input = temp_file, + output_dir = temp_dir, + output = basename(temp_file_1) + ) + ) -# Testing file size results -test_that("slow down gives expected result", { # Check if expected and actual file sizes - expect_equal(vid_size[1], size_should_be[1]) + expect_equal( + file.size(slow_down), + 93158, + tolerance = 0.005 # 0.5% difference + ) }) + +# speed up by a factor of 10 test_that("speed up gives expected result", { + temp_file_2 <- tempfile(fileext = ".mp4") + + expect_no_error( + speed_up <- adjust_playback_time( + scale_factor = 0.1, + input = temp_file, + output_dir = temp_dir, + output = basename(temp_file_2) + ) + ) + # Check if expected and actual file sizes - expect_equal(vid_size[2], size_should_be[2]) + expect_equal( + file.size(speed_up), + 56817, + tolerance = 0.005 # 0.5% difference + ) }) +# call from input path and name containing spaces and parentheses test_that("input/output with space/parenth gives expected result", { + temp_dir_3 <- file.path(temp_dir, "path with ( spaces)") + dir.create(temp_dir_3) + + temp_file_3 <- tempfile( + pattern = "fname with ( special)", + tmpdir = temp_dir_3, + fileext = ".mp4" + ) + + expect_no_error( + path_spaces <- adjust_playback_time( + scale_factor = 0.1, + input = temp_file, + output_dir = temp_dir_3, + output = basename(temp_file_3) + ) + ) + # Check if expected and actual file sizes - expect_equal(vid_size[3], size_should_be[3]) + expect_equal( + file.size(path_spaces), + 56817, + tolerance = 0.005 + ) }) + + +# Clean up +unlink( + list.files(temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE +) diff --git a/tests/testthat/test-convert_glatos_to_att.r b/tests/testthat/test-convert_glatos_to_att.r index c18694a1..c45f3744 100644 --- a/tests/testthat/test-convert_glatos_to_att.r +++ b/tests/testthat/test-convert_glatos_to_att.r @@ -1,5 +1,3 @@ -context("Check convert_glatos_to_att") - # check against internal data object 'walleye_att' in R/sysdata.r # Actual result @@ -17,12 +15,19 @@ rec_file <- system.file("extdata", "sample_receivers.csv", ) recd <- read_glatos_receivers(rec_file) # load receiver data -watt <- convert_glatos_to_att(wald, recd) - +test_that("matches internal data: walleye_att", { + expect_no_error( + watt <- convert_glatos_to_att(wald, recd) + ) -# Test using testthat library -test_that("walleye_att gives expected result", { # Check if expected and actual results are the same - expect_equal(watt, walleye_att) + expect_identical(watt, walleye_att) +}) + +test_that("matches type/class of internal data: walleye_att", { + watt <- convert_glatos_to_att(wald, recd) + + expect_s3_class(watt, "ATT") + expect_type(watt, "list") }) diff --git a/tests/testthat/test-convert_otn_erddap_to_att.r b/tests/testthat/test-convert_otn_erddap_to_att.r index 614e221b..5656c6bd 100644 --- a/tests/testthat/test-convert_otn_erddap_to_att.r +++ b/tests/testthat/test-convert_otn_erddap_to_att.r @@ -1,5 +1,3 @@ -context("Check convert_otn_erddap_to_att") - # check against internal data object 'blue_shark_att' in R/sysdata.r # Actual result @@ -35,16 +33,79 @@ animals <- animals[-1, ] tags <- tags[-1, ] stations <- stations[-1, ] -# create ATT object -bs_att <- convert_otn_erddap_to_att( - blue_shark_detections, - tags, stations, animals -) + # Test using testthat library -test_that("blue_shark_erddap_att gives expected result", { +test_that("matches internal data: blue_shark_erddap_att", { + # create ATT object + expect_no_error( + bs_att <- convert_otn_erddap_to_att( + blue_shark_detections, + tags, stations, animals + ) + ) + + expect_message( + convert_otn_erddap_to_att( + blue_shark_detections, + tags, stations, animals + ) + ) + + expect_output( + convert_otn_erddap_to_att( + blue_shark_detections, + tags, stations, animals + ) + ) + # Check if expected and actual results are the same - expect_equal(bs_att, blue_shark_erddap_att) + expect_identical(bs_att, blue_shark_erddap_att) +}) + + +test_that("matches type/class of internal data: blue_shark_erddap_att", { + bs_att <- convert_otn_erddap_to_att( + blue_shark_detections, + tags, stations, animals + ) + + expect_s3_class(bs_att, "ATT") + expect_type(bs_att, "list") +}) + + + +# Test non-exported concat_list_strings function +test_that("internal function concat_list_strings works", { + expect_no_error( + concat_list_strings( + blue_shark_detections$transmitter_codespace, + blue_shark_detections$transmitter_id + ) + ) +}) + +test_that("internal function concat_list_strings errors with unequal length", { + expect_error( + concat_list_strings( + blue_shark_detections$transmitter_codespace[1:10], + blue_shark_detections$transmitter_id + ), + "Lists are not the same size." + ) +}) + + + +# Test non-exported extract_station function +test_that("internal function extract_station works", { + expect_no_error( + station_extracted <- extract_station(stations$receiver_reference_id[1]) + ) + + expect_length(station_extracted, 1) + expect_type(station_extracted, "character") }) diff --git a/tests/testthat/test-convert_otn_to_att.r b/tests/testthat/test-convert_otn_to_att.r index fd241301..b538a2b3 100644 --- a/tests/testthat/test-convert_otn_to_att.r +++ b/tests/testthat/test-convert_otn_to_att.r @@ -1,5 +1,3 @@ -context("Check convert_otn_to_att") - dets_path <- system.file("extdata", "blue_shark_detections.csv", package = "glatos" ) @@ -14,9 +12,32 @@ dets <- read_otn_detections(dets_path) tags <- prepare_tag_sheet(tag_path, 5, 2) deploy <- prepare_deploy_sheet(deploy_path, header_line = 1) -bs_att <- convert_otn_to_att(dets, tags, deploymentSheet = deploy) -test_that("blue_shark_att gives expected result", { +test_that("matches internal data: blue_shark_att", { + expect_no_error( + bs_att <- convert_otn_to_att(dets, tags, deploymentSheet = deploy) + ) + # Check if expected and actual results are the same - expect_equal(bs_att, blue_shark_att) + expect_identical(bs_att, blue_shark_att) +}) + +test_that("matches type/class of internal data: blue_shark_att", { + bs_att <- convert_otn_to_att(dets, tags, deploymentSheet = deploy) + + expect_s3_class(bs_att, "ATT") + expect_type(bs_att, "list") +}) + + + +##### TBD: TEST NON-EXPORTED FUNCTIONS #### +# Test non-exported query_worms_common function +test_that("internal function query_worms_common", { + skip("Test needs to be created.") +}) + +# Test non-exported query_worms_common function +test_that("internal function query_worms_common", { + skip("Test needs to be created.") }) diff --git a/tests/testthat/test-crw_in_polygon.r b/tests/testthat/test-crw_in_polygon.r index 902101e6..38d1a5b4 100644 --- a/tests/testthat/test-crw_in_polygon.r +++ b/tests/testthat/test-crw_in_polygon.r @@ -1,78 +1,151 @@ -context("Check crw_in_polygon") - -# non-spatial input -mypolygon <- data.frame(x = c(-50, -50, 50, 50), y = c(-50, 50, 50, -50)) -set.seed(30) -path_dfin_spout <- crw_in_polygon(mypolygon, - theta = c(0, 20), stepLen = 10, - initPos = c(0, 0), initHeading = 0, nsteps = 5, - sp_out = TRUE, show_progress = FALSE -) -set.seed(30) -path_dfin_dfout <- crw_in_polygon(mypolygon, - theta = c(0, 20), stepLen = 10, - initPos = c(0, 0), initHeading = 0, nsteps = 5, - sp_out = FALSE, show_progress = FALSE -) - - -# spatial input -data(greatLakesPoly) -set.seed(30) -path_spin_spout <- crw_in_polygon(greatLakesPoly, - theta = c(0, 25), stepLen = 10000, - initPos = c(-87.49017, 48.42314), initHeading = 0, nsteps = 5, sp_out = TRUE, - cartesianCRS = 3175, show_progress = FALSE -) -set.seed(30) -path_spin_dfout <- crw_in_polygon(greatLakesPoly, - theta = c(0, 25), stepLen = 10000, - initPos = c(-87.49017, 48.42314), initHeading = 0, nsteps = 5, sp_out = FALSE, - cartesianCRS = 3175, show_progress = FALSE -) - -path_spin_spout_shouldBe <- - readRDS("../../inst/testdata/test-crw_in_polygon-path_spin_spout.rds") - - -path_spin_dfout_shouldBe <- - structure(list(x = c( - -87.49017, -87.5682764367357, -87.6624051520051, - -87.7763030863065, -87.8344478577291, -87.9595460531474 - ), y = c( - 48.42314, - 48.4965252233601, 48.5611619523508, 48.609942977839, 48.6911737155544, - 48.7263225805848 - )), class = "data.frame", row.names = c(1L:6L)) - -path_dfin_spout_shouldBe <- - readRDS("../../inst/testdata/test-crw_in_polygon-path_dfin_spout.rds") - -path_dfin_dfout_shouldBe <- - structure(list(x = c( - 0, -4.34765355285354, -9.75360353139628, - -16.5935673247779, -19.6317805370012, -16.4086037689043 - ), y = c( - 0, - 9.00543772308487, 17.4182674984633, 24.7131215275189, 34.24041182839, - 43.7067274538907 - )), class = "data.frame", row.names = c(1L:6L)) +# Testing output matches desired format for each input +test_that("data.frame input, sf output gives expected result", { + # non-spatial input + mypolygon <- data.frame(x = c(-50, -50, 50, 50), y = c(-50, 50, 50, -50)) + set.seed(30) -# Testing output matches desired format for each input -test_that("data.frame input, spatial output gives expected result", { - # Check if expected and actual results are the same - expect_equal(path_dfin_spout, path_dfin_spout_shouldBe) + expect_s3_class( + dfin_sfout <- crw_in_polygon( + mypolygon, + theta = c(0, 20), stepLen = 10, + initPos = c(0, 0), initHeading = 0, nsteps = 5, + sp_out = TRUE, + show_progress = FALSE + ), + "sf" + ) + + expect_equal(dim(dfin_sfout), c(6, 1)) + + expect_snapshot( + dfin_sfout + ) }) + test_that("data.frame input, data.frame output gives expected result", { - # Check if expected and actual results are the same - expect_equal(path_dfin_dfout, path_dfin_dfout_shouldBe) + # non-spatial input + mypolygon <- data.frame(x = c(-50, -50, 50, 50), y = c(-50, 50, 50, -50)) + + set.seed(30) + + expect_s3_class( + dfin_dfout <- crw_in_polygon( + mypolygon, + theta = c(0, 20), stepLen = 10, + initPos = c(0, 0), initHeading = 0, nsteps = 5, + sp_out = FALSE, + show_progress = FALSE + ), + "data.frame" + ) + + expect_equal(dim(dfin_dfout), c(6, 2)) + + expect_snapshot( + dfin_dfout + ) +}) + + +test_that("SpatialPolygonsDataFrame input, data.frame output gives expected result", { + set.seed(30) + + expect_s3_class( + spin_dfout <- crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = FALSE, + cartesianCRS = 3175, show_progress = FALSE + ), + "data.frame" + ) + + expect_equal(dim(spin_dfout), c(6, 2)) + + expect_snapshot( + spin_dfout + ) +}) + + +test_that("SpatialPolygonsDataFrame input, sf output gives expected result", { + set.seed(30) + + expect_s3_class( + spin_sfout <- crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ), + "sf" + ) + + expect_equal(dim(spin_sfout), c(6, 1)) + + expect_snapshot( + spin_sfout + ) +}) + + +test_that("sf input, data.frame output gives expected result", { + set.seed(30) + + expect_s3_class( + sfin_dfout <- crw_in_polygon( + great_lakes_polygon, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = FALSE, + cartesianCRS = 3175, show_progress = FALSE + ), + "data.frame" + ) + + expect_equal(dim(sfin_dfout), c(6, 2)) + + expect_snapshot( + sfin_dfout + ) }) -test_that("spatial input, data.frame output gives expected result", { - # Check if expected and actual results are the same - expect_equal(path_spin_dfout, path_spin_dfout_shouldBe) + + +test_that("sf input, sf output gives expected result", { + set.seed(30) + + expect_s3_class( + sfin_sfout <- crw_in_polygon( + great_lakes_polygon, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ), + "sf" + ) + + expect_equal(dim(sfin_sfout), c(6, 1)) + + expect_snapshot( + sfin_sfout + ) }) -test_that("spatial input, spatial output gives expected result", { - # Check if expected and actual results are the same - expect_equal(path_spin_spout, path_spin_spout_shouldBe) + + +##### TBD: TEST NON-EXPORTED FUNCTIONS #### +# Test non-exported query_worms_common function +test_that("internal function check_in_polygon", { + skip("Test needs to be created.") +}) + +test_that("internal function check_cross_boundary", { + skip("Test needs to be created.") }) diff --git a/tests/testthat/test-detect_transmissions.r b/tests/testthat/test-detect_transmissions.r index 93d7d08a..16e93ab0 100644 --- a/tests/testthat/test-detect_transmissions.r +++ b/tests/testthat/test-detect_transmissions.r @@ -1,16 +1,10 @@ -context("Check detect_transmissions") - -# Get path to testdir -# when called from devtools::test, working dir test -# so need to handle that case vs package root -if (grepl("^glatos$", basename(getwd()))) testdata_dir <- normalizePath("./inst/testdata") -if (grepl("^testthat$", basename(getwd()))) testdata_dir <- normalizePath("../../inst/testdata") - # spatial transmission output -tr_sf <- readRDS(file.path( - testdata_dir, - "test-transmit_along_path-tr_dfin_spout.rds" -)) +tr_sf <- readRDS( + test_path( + "testdata", + "transmit_along_path-tr_dfin_spout.rds" + ) +) # non spatial transmission output tr_df <- data.frame( @@ -32,76 +26,103 @@ recs_df$rec_id <- 1:nrow(recs_df) recs_sf <- sf::st_as_sf(recs_df, coords = c("x", "y"), crs = 4326) -# Spatial input - -# spatial detection output - 50% constant detection prob -set.seed(33) -dtc_spin_spout <- detect_transmissions( - trnsLoc = tr_sf, - recLoc = recs_sf, - detRngFun = function(x) 0.5, - show_progress = FALSE -) - -# non-spatial detection output - 50% constant detection prob -set.seed(33) -dtc_spin_dfout <- detect_transmissions( - trnsLoc = tr_sf, - recLoc = recs_sf, - detRngFun = function(x) 0.5, - sp_out = FALSE, - show_progress = FALSE -) +# Testing output matches desired format for each input -# Non-spatial input +test_that("data.frame input, spatial output gives expected result", { + # spatial detection output - 50% constant detection prob -# spatial detection output - 50% constant detection prob -set.seed(33) -dtc_dfin_spout <- detect_transmissions( - trnsLoc = tr_df, - recLoc = recs_df, - detRngFun = function(x) 0.5, - inputCRS = sf::st_crs(tr_sf), - show_progress = FALSE -) + set.seed(33) -# non-spatial detection output - 50% constant detection prob -set.seed(33) -dtc_dfin_dfout <- detect_transmissions( - trnsLoc = tr_df, - recLoc = recs_df, - detRngFun = function(x) 0.5, - inputCRS = 4326, - sp_out = FALSE, - show_progress = FALSE -) + expect_s3_class( + dfin_spout <- detect_transmissions( + trnsLoc = tr_df, + recLoc = recs_df, + detRngFun = function(x) 0.5, + inputCRS = sf::st_crs(tr_sf), + show_progress = FALSE + ), + "sf" + ) -# Expected values -dtc_dfout_shouldBe <- readRDS(file.path( - testdata_dir, - "test-detect_transmissions-dtc_dfout.rds" -)) -dtc_spout_shouldBe <- readRDS(file.path( - testdata_dir, - "test-detect_transmissions-dtc_spout.rds" -)) -attr(dtc_dfout_shouldBe, "row.names") <- as.integer(row.names(dtc_dfout_shouldBe)) -attr(dtc_spout_shouldBe, "row.names") <- as.integer(row.names(dtc_spout_shouldBe)) + expect_equal(dim(dfin_spout), c(8, 5)) -# Testing output matches desired format for each input -test_that("data.frame input, spatial output gives expected result", { # Check if expected and actual results are the same - expect_equal(dtc_dfin_spout, dtc_spout_shouldBe) + expect_snapshot( + dfin_spout + ) }) + + test_that("data.frame input, data.frame output gives expected result", { + # non-spatial detection output - 50% constant detection prob + + set.seed(33) + + expect_s3_class( + dfin_dfout <- detect_transmissions( + trnsLoc = tr_df, + recLoc = recs_df, + detRngFun = function(x) 0.5, + inputCRS = 4326, + sp_out = FALSE, + show_progress = FALSE + ), + "data.frame" + ) + + expect_equal(dim(dfin_dfout), c(8, 7)) + # Check if expected and actual results are the same - expect_equal(dtc_dfin_dfout, dtc_dfout_shouldBe) + expect_snapshot( + dfin_dfout + ) }) + test_that("spatial input, data.frame output gives expected result", { + # non-spatial detection output - 50% constant detection prob + + set.seed(33) + + expect_s3_class( + spin_dfout <- detect_transmissions( + trnsLoc = tr_sf, + recLoc = recs_sf, + detRngFun = function(x) 0.5, + sp_out = FALSE, + show_progress = FALSE + ), + "data.frame" + ) + + expect_equal(dim(spin_dfout), c(8, 7)) + # Check if expected and actual results are the same - expect_equal(dtc_spin_dfout, dtc_dfout_shouldBe) + expect_snapshot( + spin_dfout + ) }) + + + test_that("spatial input, spatial output gives expected result", { + # spatial detection output - 50% constant detection prob + + set.seed(33) + + expect_s3_class( + spin_spout <- detect_transmissions( + trnsLoc = tr_sf, + recLoc = recs_sf, + detRngFun = function(x) 0.5, + show_progress = FALSE + ), + "sf" + ) + + expect_equal(dim(spin_spout), c(8, 5)) + # Check if expected and actual results are the same - expect_equal(dtc_spin_spout, dtc_spout_shouldBe) + expect_snapshot( + spin_spout + ) }) diff --git a/tests/testthat/test-false_detections.r b/tests/testthat/test-false_detections.r index 313ea1a3..f497816a 100644 --- a/tests/testthat/test-false_detections.r +++ b/tests/testthat/test-false_detections.r @@ -1,163 +1,102 @@ -context("Check false_detections") - -# Sample data for min_lag -det_df_exp <- structure(list( - animal_id = c( - "153", "153", "153", "153", "153", - "153", "153", "153", "153", "153" - ), detection_timestamp_utc = structure(c( - 1337741659, - 1337743033, 1337743278, 1337743396, 1337743572, 1337744344, 1337744491, - 1337744491, 1337744686, 1337745421 - ), class = c("POSIXct", "POSIXt"), tzone = "UTC"), glatos_array = c( - "SBI", "SBI", "SBI", "SBI", - "SBI", "SBI", "SBI", "SBI", "SBI", "SBI" - ), station_no = c( - "1", - "1", "3", "1", "1", "1", "1", "2", "1", "1" - ), transmitter_codespace = c( - "A69-9001", - "A69-9001", "A69-9001", "A69-9001", "A69-9001", "A69-9001", "A69-9001", - "A69-9001", "A69-9001", "A69-9001" - ), transmitter_id = c( - "32054", - "32054", "32054", "32054", "32054", "32054", "32054", "32054", - "32054", "32054" - ), sensor_value = c( - NA_real_, NA_real_, NA_real_, - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_ - ), sensor_unit = c( - NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_ - ), deploy_lat = c( - 44.17873, 44.17873, - 44.17255, 44.17873, 44.17873, 44.17873, 44.17873, 44.17714, 44.17873, - 44.17873 - ), deploy_long = c( - -83.54767, -83.54767, -83.5309, -83.54767, - -83.54767, -83.54767, -83.54767, -83.54169, -83.54767, -83.54767 - ), receiver_sn = c( - "109991", "109991", "109999", "109991", "109991", - "109991", "109991", "109956", "109991", "109991" - ), tag_type = c( - NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_ - ), - tag_model = c( - NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_ - ), tag_serial_number = c( - NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_ - ), common_name_e = c( - "walleye", "walleye", "walleye", - "walleye", "walleye", "walleye", "walleye", "walleye", "walleye", - "walleye" - ), capture_location = c( - "Tittabawassee River", "Tittabawassee River", - "Tittabawassee River", "Tittabawassee River", "Tittabawassee River", - "Tittabawassee River", "Tittabawassee River", "Tittabawassee River", - "Tittabawassee River", "Tittabawassee River" - ), length = c( - 0.565, - 0.565, 0.565, 0.565, 0.565, 0.565, 0.565, 0.565, 0.565, 0.565 - ), weight = c( - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_ - ), sex = c( - "F", - "F", "F", "F", "F", "F", "F", "F", "F", "F" - ), release_group = c( - NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_, NA_character_, NA_character_, NA_character_, - NA_character_ - ), release_location = c( - "Tittabawassee", "Tittabawassee", - "Tittabawassee", "Tittabawassee", "Tittabawassee", "Tittabawassee", - "Tittabawassee", "Tittabawassee", "Tittabawassee", "Tittabawassee" - ), release_latitude = c( - NA_real_, NA_real_, NA_real_, NA_real_, - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_ - ), release_longitude = c( - NA_real_, NA_real_, NA_real_, NA_real_, - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_ - ), utc_release_date_time = structure(c( - 1332273600, 1332273600, - 1332273600, 1332273600, 1332273600, 1332273600, 1332273600, - 1332273600, 1332273600, 1332273600 - ), class = c( - "POSIXct", - "POSIXt" - ), tzone = "UTC"), glatos_project_transmitter = c( - "HECWL", - "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", - "HECWL", "HECWL" - ), glatos_project_receiver = c( - "HECWL", "HECWL", - "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", "HECWL", - "HECWL" - ), glatos_tag_recovered = c( - "NO", "NO", "NO", "NO", - "NO", "NO", "NO", "NO", "NO", "NO" - ), glatos_caught_date = structure(c( - NA_real_, - NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, - NA_real_, NA_real_, NA_real_ - ), class = "Date"), station = c( - "SBI-001", - "SBI-001", "SBI-003", "SBI-001", "SBI-001", "SBI-001", "SBI-001", - "SBI-002", "SBI-001", "SBI-001" - ), min_lag = c( - 1374, 363, - 4180, 176, 176, 147, 147, 4478, 195, 735 - ), passed_filter = c( - 1, - 1, 0, 1, 1, 1, 1, 0, 1, 1 - ) -), row.names = 129:138, class = c( - "glatos_detections", - "data.frame" -)) - - -# strip last col to create input - -# data.frame -det_df_in <- det_df_exp[, 1:(ncol(det_df_exp) - 1)] +# Testing column that data.frame input returns expected +test_that("data.frame input gives expected result", { + df_in <- walleye_detections[129:138, ] + expect_message( + df_result <- false_detections( + df_in, + 3600 + ), + "The filter identified 2 \\(20\\%\\) of 10 detections as potentially false\\." + ) -# data.table -det_dt_in <- data.table::as.data.table(det_df_in) + expect_s3_class(df_result, "glatos_detections") + expect_s3_class(df_result, "data.frame") -# tibble -det_tbl_in <- tibble::as_tibble(det_df_in) + expect_equal(dim(df_result), c(10, 31)) -# results -det_df_out <- false_detections(det_df_in, 3600) -det_dt_out <- false_detections(det_dt_in, 3600) -det_tbl_out <- false_detections(det_tbl_in, 3600) + expect_type(df_result$passed_filter, "double") + expect_equal( + df_result$passed_filter, + c(1, 1, 0, 1, 1, 1, 1, 0, 1, 1) + ) + expect_equal( + df_result[, 1:(ncol(df_result) - 1)], + df_in + ) -# Testing column that data.frame input returns expected -test_that("data.frame input gives expected result", { # Check if expected and actual results are the same - expect_equal(det_df_out, det_df_exp) + expect_snapshot( + df_result + ) }) # Testing column that data.frame input returns expected test_that("data.table input gives expected result", { + dt_in <- data.table::as.data.table(walleye_detections[129:138, ]) + + expect_message( + dt_result <- false_detections( + dt_in, + 3600 + ), + "The filter identified 2 \\(20\\%\\) of 10 detections as potentially false\\." + ) + + expect_s3_class(dt_result, "data.table") + expect_s3_class(dt_result, "data.frame") + + expect_equal(dim(dt_result), c(10, 31)) + + expect_type(dt_result$passed_filter, "double") + expect_equal( + dt_result$passed_filter, + c(1, 1, 0, 1, 1, 1, 1, 0, 1, 1) + ) + + expect_equal( + dt_result[, 1:(ncol(dt_result) - 1)], + dt_in + ) + # Check if expected and actual results are the same - expect_equal(det_dt_out, data.table::as.data.table(det_df_exp)) + expect_snapshot( + dt_result + ) }) # Testing column that tibble input returns expected test_that("tibble input gives expected result", { + tbl_in <- tibble::as_tibble(walleye_detections[129:138, ]) + + expect_message( + tbl_result <- false_detections( + tbl_in, + 3600 + ), + "The filter identified 2 \\(20\\%\\) of 10 detections as potentially false\\." + ) + + expect_s3_class(tbl_result, "tbl_df") + expect_s3_class(tbl_result, "tbl") + expect_s3_class(tbl_result, "data.frame") + + expect_equal(dim(tbl_result), c(10, 31)) + + expect_type(tbl_result$passed_filter, "double") + expect_equal( + tbl_result$passed_filter, + c(1, 1, 0, 1, 1, 1, 1, 0, 1, 1) + ) + + expect_equal( + tbl_result[, 1:(ncol(tbl_result) - 1)], + tbl_in + ) + # Check if expected and actual results are the same - expect_equal(det_tbl_out, tibble::as_tibble(det_df_exp)) + expect_snapshot( + tbl_result + ) }) diff --git a/tests/testthat/test-make_frames.r b/tests/testthat/test-make_frames.r index 0cff7fbc..dda74c3f 100644 --- a/tests/testthat/test-make_frames.r +++ b/tests/testthat/test-make_frames.r @@ -1,42 +1,170 @@ -context("Check make_frames") - # make example records -pos1 <- structure(list( - animal_id = c("153", "153", "153", "153"), - bin_timestamp = structure(c( - 1335704727, - 1335704727, 1335791127, 1335877527 - ), class = c("POSIXct", "POSIXt"), tzone = "UTC"), latitude = c( - 43.60963, 43.61235, 43.6157011174478, - 43.6404351467905 - ), longitude = c( - -83.88658, -83.8608, -83.858826537583, - -83.8442607462938 - ), record_type = c( - "detection", "detection", - "interpolated", "interpolated" - ) -), row.names = 4:7, class = "data.frame") - -# make preview image -temp_dir <- tempdir() -make_frames(pos1, out_dir = temp_dir, preview = TRUE) - -# Actual file sizes -img_file <- file.path(temp_dir, "1.png") -img_size <- file.info(img_file)$size - -# Expected file sizes -size_should_be <- 30919 - -# Clean up -unlink(list.files(temp_dir, - full.names = TRUE, recursive = TRUE, - include.dirs = TRUE -), recursive = TRUE) - -# Testing file size results -test_that("making preview image expected result", { - # Check if expected and actual file sizes - expect_equal(img_size, size_should_be) +pos <- interpolate_path( + walleye_detections[walleye_detections$animal_id == 153, ][ + 1:125, + ], + start_time = as.POSIXct("2012-04-29 13:05:27") +)[1:4, ] + + +test_that("Expected result when background lims and map not supplied", { + # Check output with default background_ylim, background_xlim, and bg_map + temp_dir <- tempdir() + + expect_message( + make_frames(pos, out_dir = temp_dir, preview = TRUE), + "Preview frames written to" + ) + + # Check that file exists + expect_true( + file.exists( + file.path(temp_dir, "1.png") + ) + ) + + # Check file size greater than 30000 bytes + expect_gt( + file.size( + file.path(temp_dir, "1.png") + ), + 30000 + ) + + # Clean up + unlink( + list.files( + temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE + ) +}) + +test_that("Expected result when map but not background lims supplied", { + temp_dir <- tempdir() + + expect_message( + make_frames( + pos, + out_dir = temp_dir, + preview = TRUE, + bg_map = great_lakes_polygon + ), + "Preview frames written to" + ) + + # Check that file exists + expect_true( + file.exists( + file.path(temp_dir, "1.png") + ) + ) + + # Check if file size greater than 20000 bytes + expect_gt( + file.size( + file.path(temp_dir, "1.png") + ), + 20000 + ) + + # Clean up + unlink( + list.files( + temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE + ) +}) + +test_that("Expected result when map and background lims supplied", { + temp_dir <- tempdir() + + expect_message( + make_frames(pos, + out_dir = temp_dir, + background_ylim = c(42, 47), + background_xlim = c(-90, -78), + preview = TRUE, + bg_map = great_lakes_polygon + ), + "Preview frames written to" + ) + + # Check that file exists + expect_true( + file.exists( + file.path(temp_dir, "1.png") + ) + ) + + # Check if file size greater than 30000 bytes + expect_gt( + file.size( + file.path(temp_dir, "1.png") + ), + 30000 + ) + + # Clean up + unlink( + list.files( + temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE + ) +}) + +test_that("Expected result when map is spatVector, bg lims not supplied", { + sv_poly <- terra::vect(great_lakes_polygon) + + temp_dir <- tempdir() + expect_message( + expect_message( + make_frames(pos, + out_dir = temp_dir, + preview = TRUE, + bg_map = sv_poly + ), + "Converted terra object to sf" + ), + "Preview frames written to" + ) + + # Check that file exists + expect_true( + file.exists( + file.path(temp_dir, "1.png") + ) + ) + + + # Check if file size greater than 20000 bytes + expect_gt( + file.size( + file.path(temp_dir, "1.png") + ), + 20000 + ) + + + # Clean up + unlink( + list.files( + temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE + ) }) diff --git a/tests/testthat/test-make_transition.r b/tests/testthat/test-make_transition.r index 60cff309..10165d2d 100644 --- a/tests/testthat/test-make_transition.r +++ b/tests/testthat/test-make_transition.r @@ -1,83 +1,125 @@ -context("Check make_transition") +### make_transition3 tests TBD #### -# example 1 water polygon (Higgins Lake) -data(higgins_lake_polygon) -poly1 <- higgins_lake_polygon -trl1 <- make_transition(poly1, res = c(0.01, 0.01)) -# raster::plot(trl1$rast) -# raster::plot(raster::raster(trl1$transition)) -# higgins_lake_transition <- trl1 -# saveRDS(higgins_lake_transition, file = "./inst/testdata/higgins_lake_transition.rds") +### make_transition2 tests TBD #### -# example 2 land polygon (Flynn Island, Higgins Lake) -data(flynn_island_polygon) -poly2 <- flynn_island_polygon -trl2 <- make_transition(poly2, - res = c(0.001, 0.001), - all_touched = FALSE, - invert = TRUE -) -# raster::plot(trl2$rast) -# raster::plot(raster::raster(trl2$transition)) - -# flynn_island_transition <- trl2 -# saveRDS(flynn_island_transition, file = "./inst/testdata/flynn_island_transition.rds") - - - -# Expected results -# when called from devtools::test, working dir test -# so need to handle that case vs package root -if (grepl("^glatos$", basename(getwd()))) testdata_dir <- normalizePath("./inst/testdata") -if (grepl("^testthat$", basename(getwd()))) testdata_dir <- normalizePath("../../inst/testdata") +### make_transition +# Testing water polygon transition matrix +test_that("make_transition: Transition matrix for Higgins Lake water polygon as expected", { + expect_warning( + water <- make_transition( + higgins_lake_polygon, + res = c(0.01, 0.01) + )$transition, + "This function is deprecated and will be removed in the next version" + ) -trl1_trns_shouldBe <- readRDS(file.path( - testdata_dir, - "higgins_lake_transition.rds" -)) -trl2_trns_shouldBe <- readRDS(file.path( - testdata_dir, - "flynn_island_transition.rds" -)) + expect_s4_class( + water, + "TransitionLayer" + ) + expect_s3_class(water, NA) -# raster::plot(trl2$rast) + expect_equal(dim(water), c(10, 12, 1)) -# Drop names from rasters (to omit from comparisons) -trl1$rast@file@name <- NA_character_ -trl2$rast@file@name <- NA_character_ -trl1_trns_shouldBe$rast@file@name <- NA_character_ -trl2_trns_shouldBe$rast@file@name <- NA_character_ + expect_s4_class( + water@transitionMatrix, + "dsCMatrix" + ) + expect_length(water@transitionMatrix, 14400) -# Testing water polygon transition matrix -test_that("Transition matrix for water polygon as expected", { - # Check if expected and actual equal - expect_equal(trl1$transition, trl1_trns_shouldBe$transition) + expect_snapshot( + water + ) }) # Testing water polygon raster -test_that("Raster values for water polygon as expected", { - # Check if expected and actual equal - expect_equal(trl1$rast, trl1_trns_shouldBe$rast) +test_that("make_transition: Raster values for Higgins Lake water polygon as expected", { + expect_warning( + water <- make_transition( + higgins_lake_polygon, + res = c(0.01, 0.01) + )$rast, + "This function is deprecated and will be removed in the next version" + ) + + expect_s4_class( + water, + "RasterLayer" + ) + expect_s3_class(water, NA) + + expect_equal(dim(water), c(10, 12, 1)) + + expect_snapshot( + water + ) }) + # Testing land polygon transition matrix -test_that("Transition matrix for land polygon as expected", { - # Check if expected and actual equal - expect_equal(trl2$transition, trl2_trns_shouldBe$transition) +test_that("make_transition: Transition matrix for Flynn Island land polygon as expected", { + expect_warning( + land <- make_transition( + flynn_island_polygon, + res = c(0.001, 0.001), + all_touched = FALSE, + invert = TRUE + )$transition, + "This function is deprecated and will be removed in the next version" + ) + + expect_s4_class( + land, + "TransitionLayer" + ) + expect_s3_class(land, NA) + + expect_equal(dim(land), c(7, 9, 1)) + + + expect_s4_class( + land@transitionMatrix, + "dsCMatrix" + ) + expect_length(land@transitionMatrix, 3969) + + + expect_snapshot( + land + ) }) # Testing land polygon raster -test_that("Raster values for land polygon as expected", { - # Check if expected and actual equal - expect_equal(trl2$rast, trl2_trns_shouldBe$rast) +test_that("make_transition: Raster values for Flynn Island polygon as expected", { + expect_warning( + land <- make_transition( + flynn_island_polygon, + res = c(0.001, 0.001), + all_touched = FALSE, + invert = TRUE + )$rast, + "This function is deprecated and will be removed in the next version" + ) + + expect_s4_class( + land, + "RasterLayer" + ) + expect_s3_class(land, NA) + + expect_equal(dim(land), c(7, 9, 1)) + + expect_snapshot( + land + ) }) diff --git a/tests/testthat/test-make_video.r b/tests/testthat/test-make_video.r index ea1a6cc1..e667ecc8 100644 --- a/tests/testthat/test-make_video.r +++ b/tests/testthat/test-make_video.r @@ -1,57 +1,90 @@ -context("Check make_video") - # load example frames frames <- system.file("extdata", "frames", package = "glatos") -# make video animation +# Create temporary directory temp_dir <- tempdir() -temp_file_1 <- tempfile(fileext = ".mp4") -make_video( - input_dir = frames, - input_ext = ".png", - output = temp_file_1 -) -# call from input path and name containing spaces and parentheses -temp_dir_2 <- file.path(temp_dir, "path with ( spaces)", "frames") -dir.create(temp_dir_2, recursive = TRUE) -file.copy( - list.files(frames, full.names = TRUE), - file.path(temp_dir_2, list.files(frames)) -) -temp_file_2 <- tempfile( - pattern = "fname with ( special)", - tmpdir = temp_dir_2, - fileext = ".mp4" -) -make_video( - input_dir = frames, - input_ext = ".png", - output = temp_file_2 -) +test_that("makes videos with expected size and returns file name", { + temp_file_1 <- tempfile(fileext = ".mp4") -# Actual file sizes -vid_size <- file.info(c(temp_file_1, temp_file_2))$size -# round to nearest MB -vid_size <- round(vid_size * 0.001) + # make video animation + output <- make_video( + input_dir = frames, + input_ext = ".png", + output = temp_file_1 + ) -# Expected file sizes -size_should_be <- round(c(72024, 72024) * 0.001) + # Check if expected and actual file sizes + expect_equal( + file.size(temp_file_1), + 72024, + tolerance = 0.005 + ) -# Clean up -unlink(list.files(temp_dir, - full.names = TRUE, recursive = TRUE, - include.dirs = TRUE -), recursive = TRUE) + # Returns file name + expect_equal( + basename(output), + basename(temp_file_1) + ) -# Testing file size results -test_that("making video expected result", { - # Check if expected and actual file sizes - expect_equal(vid_size[1], size_should_be[1]) + # Returns directory + expect_equal( + dirname(output), + dirname(temp_file_1) + ) }) + test_that("input/output with space/parenth gives expected result", { + temp_dir_2 <- file.path(temp_dir, "path with ( spaces)", "frames") + dir.create(temp_dir_2, recursive = TRUE) + file.copy( + list.files(frames, full.names = TRUE), + file.path(temp_dir_2, list.files(frames)) + ) + + + temp_file_2 <- tempfile( + pattern = "fname with ( special)", + tmpdir = temp_dir_2, + fileext = ".mp4" + ) + + + output <- make_video( + input_dir = frames, + input_ext = ".png", + output = temp_file_2 + ) + # Check if expected and actual file sizes - expect_equal(vid_size[2], size_should_be[2]) + expect_equal( + file.size(temp_file_2), + 72024, + tolerance = 0.005 + ) + + # Returns file name + expect_equal( + basename(output), + basename(temp_file_2) + ) + + # Returns directory + expect_equal( + dirname(output), + dirname(temp_file_2) + ) }) + +# Clean up +unlink( + list.files( + temp_dir, + full.names = TRUE, + recursive = TRUE, + include.dirs = TRUE + ), + recursive = TRUE +) diff --git a/tests/testthat/test-min_lag.r b/tests/testthat/test-min_lag.r index 5a31d65b..19ebb07e 100644 --- a/tests/testthat/test-min_lag.r +++ b/tests/testthat/test-min_lag.r @@ -1,6 +1,3 @@ -context("Check min_lag") - -# Sample data for min_lag time <- c( "2010/10/11 08:14:22", "2010/10/11 08:15:22", "2010/10/11 09:00:00", "2010/10/11 10:23:55", "2010/10/11 11:23:55", "2010/10/11 11:24:55", @@ -12,19 +9,61 @@ time <- as.POSIXct(time, tz = "UTC") trans1 <- c(121, 151, 161, 151, 151, 161, 121, 151, 161, 121) trans2 <- c(121, 151, 161, 151, 151, 161, 121, 151, 161, 121) rec <- c(4, 2, 3, 2, 2, 2, 4, 2, 2, 4) + sampleMinLag <- data.frame( detection_timestamp_utc = time, transmitter_codespace = trans1, transmitter_id = trans2, receiver_sn = rec ) -minLagData <- min_lag(sampleMinLag) -# Expected results -minLagShouldBe <- c(11434, 7713, NA, 3600, 1729, 2029, 2089, 1729, 2029, 2089) # Testing column that results from getMinLag using testthat library test_that("min_lag column gives expected result", { + minLagData <- min_lag(sampleMinLag) + + # Expected results # Check if expected and actual results are the same + minLagShouldBe <- c(11434, 7713, NA, 3600, 1729, 2029, 2089, 1729, 2029, 2089) expect_equal(minLagData$min_lag, minLagShouldBe) + + # Check that original data is untouched + expect_equal( + minLagData[, 1:(ncol(minLagData) - 1)], + sampleMinLag + ) +}) + + +# Test that min_lag returns input S3 class +test_that("data.frame returns correct classes and types", { + minLag_df <- min_lag(sampleMinLag) + # Expected classes + expect_s3_class(minLag_df, "data.frame") + expect_type(minLag_df$min_lag, "double") +}) + + +test_that("data.table returns correct classes and types", { + minLag_dt <- min_lag( + data.table::as.data.table(sampleMinLag) + ) + + # Expected classes + expect_s3_class(minLag_dt, "data.table") + expect_s3_class(minLag_dt, "data.frame") + expect_type(minLag_dt$min_lag, "double") +}) + + +test_that("tibble returns correct classes and types", { + minLag_tbl <- min_lag( + tibble::as_tibble(sampleMinLag) + ) + + # Expected classes + expect_s3_class(minLag_tbl, "tbl_df") + expect_s3_class(minLag_tbl, "tbl") + expect_s3_class(minLag_tbl, "data.frame") + expect_type(minLag_tbl$min_lag, "double") }) diff --git a/tests/testthat/test-position_heat_map.r b/tests/testthat/test-position_heat_map.r index e0e15de0..57eee9b1 100644 --- a/tests/testthat/test-position_heat_map.r +++ b/tests/testthat/test-position_heat_map.r @@ -1,193 +1,318 @@ -context("Check position_heat_map") - -# example file from VEMCO VPS -data(lamprey_tracks) -phm_full_input <- position_heat_map(lamprey_tracks, - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100 -) - - -phm_reduced_input <- position_heat_map( - lamprey_tracks[, c( - "DETECTEDID", - "DATETIME", - "LAT", - "LON" - )], - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100 -) - -# Test data.table input -phm_dt_input <- position_heat_map(data.table::setDT(lamprey_tracks), - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100 -) - -temp_dir <- tempdir() - -# Test kmz out -phm_kmz_out <- suppressMessages(position_heat_map(lamprey_tracks, - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100, - output = "kmz", - folder = temp_dir -)) - -phm_kmz_out_nameShouldBe <- normalizePath( - file.path( - temp_dir, - "fish_absolute.kmz" - ), - mustWork = FALSE -) - -phm_kmz_out_named <- suppressMessages(position_heat_map(lamprey_tracks, - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100, - output = "kmz", - folder = temp_dir, - out_file = "mymap" -)) - -phm_kmz_out_named_nameShouldBe <- normalizePath( - file.path( - temp_dir, - "mymap.kmz" - ), - mustWork = FALSE -) - - -# Test png out -phm_png_out <- suppressMessages(position_heat_map(lamprey_tracks, - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100, - output = "png", - folder = temp_dir -)) - -phm_png_out_nameShouldBe <- normalizePath( - file.path( - temp_dir, - "fish_absolute.png" - ), - mustWork = FALSE -) - -phm_png_out_named <- suppressMessages(position_heat_map(lamprey_tracks, - x_limits = c(-84.14, -84.12), - y_limits = c(46.45, 46.47), - resolution = 100, - output = "png", - folder = temp_dir, - out_file = "mymap" -)) - -phm_png_out_named_nameShouldBe <- normalizePath( - file.path( - temp_dir, - "mymap.png" - ), - mustWork = FALSE -) - - - -# Expected results -phm_shouldBe <- - structure(c( - 43L, 20L, 23L, 19L, 21L, 19L, 25L, - 17L, 21L, 19L, 12L, 16L, 13L, 8L, 8L, 9L, 3L, 2L, 3L, 2L, 1L, - 4L, 2L, 35L, 19L, 20L, 18L, 22L, 20L, 21L, 14L, 15L, 18L, 14L, - 22L, 11L, 5L, 9L, 4L, 4L, 4L, 2L, 1L, 2L, 2L, 3L, 30L, 16L, 12L, - 11L, 15L, 14L, 12L, 16L, 10L, 13L, 16L, 13L, 14L, 10L, 8L, 4L, - NA, 2L, 4L, 4L, 5L, 4L, 3L, 22L, 13L, 9L, 10L, 11L, 10L, 14L, - 18L, 16L, 19L, 11L, 13L, 11L, 9L, 9L, 6L, 4L, 5L, 4L, 3L, 5L, - 4L, 1L, 23L, 5L, 7L, 9L, 10L, 10L, 12L, 14L, 17L, 12L, 9L, 7L, - 5L, 5L, 5L, 4L, 7L, 4L, 2L, 2L, 4L, 3L, 3L, 20L, 4L, 3L, 5L, - 8L, 10L, 13L, 16L, 12L, 15L, 13L, 11L, 7L, 6L, 4L, 5L, 3L, 2L, - 1L, 1L, 4L, 4L, NA, 19L, 2L, 7L, 7L, 12L, 14L, 11L, 11L, 11L, - 9L, 9L, 8L, 7L, 5L, 8L, 6L, 5L, 3L, 3L, 4L, 3L, 3L, 5L, 15L, - 3L, 8L, 9L, 10L, 11L, 11L, 11L, 13L, 13L, 15L, 12L, 9L, 5L, 5L, - 9L, 3L, 5L, 6L, 4L, 4L, 4L, 4L, 18L, 7L, 7L, 7L, 7L, 12L, 6L, - 12L, 10L, 11L, 15L, 17L, 11L, 9L, 11L, 3L, 7L, 7L, 5L, 5L, 7L, - 1L, 2L, 17L, 4L, 7L, 9L, 8L, 6L, 9L, 10L, 9L, 12L, 11L, 7L, 7L, - 8L, 10L, 10L, 8L, 5L, 1L, 5L, 5L, 6L, 2L, 16L, 7L, 2L, 5L, 8L, - 8L, 6L, 7L, 9L, 8L, 10L, 6L, 7L, 9L, 7L, 8L, 4L, 6L, 8L, 8L, - 7L, 3L, 3L, 17L, 6L, 4L, 8L, 7L, 8L, 6L, 9L, 10L, 9L, 13L, 8L, - 10L, 10L, 12L, 9L, 11L, 9L, 13L, 8L, 2L, 3L, 4L, 17L, 2L, 5L, - 9L, 10L, 6L, 9L, 9L, 12L, 8L, 9L, 7L, 11L, 5L, 6L, 11L, 8L, 10L, - 7L, 2L, 4L, 5L, 4L, 18L, 3L, 7L, 5L, 5L, 7L, 8L, 3L, 7L, 9L, - 8L, 12L, 12L, 15L, 12L, 12L, 8L, 7L, 5L, 5L, 6L, 2L, 1L, 12L, - 8L, 7L, 5L, 9L, 5L, 10L, 9L, 4L, 6L, 12L, 14L, 9L, 14L, 15L, - 7L, 5L, 4L, 5L, 5L, 3L, 6L, 4L, 12L, 7L, 7L, 7L, 10L, 5L, 9L, - 11L, 14L, 15L, 16L, 11L, 14L, 15L, 6L, 4L, 6L, 5L, 5L, 2L, 3L, - 6L, 6L, 26L, 12L, 15L, 20L, 28L, 31L, 36L, 37L, 46L, 49L, 54L, - 57L, 60L, 63L, 58L, 49L, 47L, 48L, 39L, 33L, 25L, 21L, 19L - ), .Dim = c( - 23L, - 17L - ), .Dimnames = structure(list(c( - "5150222", "5150122", "5150022", - "5149922", "5149822", "5149722", "5149622", "5149522", "5149422", - "5149322", "5149222", "5149122", "5149022", "5148922", "5148822", - "5148722", "5148622", "5148522", "5148422", "5148322", "5148222", - "5148122", "5148022" - ), c( - "719569", "719669", "719769", "719869", - "719969", "720069", "720169", "720269", "720369", "720469", "720569", - "720669", "720769", "720869", "720969", "721069", "721169" - )), .Names = c( - "", - "" - ))) - - # Testing output gives expected values test_that("full vps data set gives expected result", { + phm_shouldBe <- phm_values_known() + + # Data returned invisibly + expect_invisible( + phm_full_input <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100 + ) + ) + + # Check if expected and actual results are the same expect_equal(phm_full_input$values, phm_shouldBe) + + + # Check classes and names + expect_named( + phm_full_input, + c("values", "utm_zone", "bbox_UTM", "bbox_LL", "function_call") + ) + expect_type(phm_full_input, "list") + expect_type(phm_full_input$utm_zone, "character") + expect_s3_class(phm_full_input$bbox_UTM, "data.frame") + expect_s3_class(phm_full_input$bbox_LL, "data.frame") + expect_type(phm_full_input$function_call, "language") }) + + test_that("data frame with min required columns gives expected result", { + phm_shouldBe <- phm_values_known() + + expect_invisible( + phm_reduced_input <- position_heat_map( + lamprey_tracks[, c( + "DETECTEDID", + "DATETIME", + "LAT", + "LON" + )], + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100 + ) + ) + # Check if expected and actual results are the same expect_equal(phm_reduced_input$values, phm_shouldBe) -}) -test_that("data.table input gives expected result", { - # Check if expected and actual results are the same - expect_equal(phm_dt_input$values, phm_shouldBe) + # Check classes and names + expect_named( + phm_reduced_input, + c("values", "utm_zone", "bbox_UTM", "bbox_LL", "function_call") + ) + expect_type(phm_reduced_input, "list") + expect_type(phm_reduced_input$utm_zone, "character") + expect_s3_class(phm_reduced_input$bbox_UTM, "data.frame") + expect_s3_class(phm_reduced_input$bbox_LL, "data.frame") + expect_type(phm_reduced_input$function_call, "language") }) + + test_that("data.table input gives expected result", { + phm_shouldBe <- phm_values_known() + + expect_invisible( + phm_dt_input <- position_heat_map( + data.table::as.data.table(lamprey_tracks), + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100 + ) + ) + # Check if expected and actual results are the same expect_equal(phm_dt_input$values, phm_shouldBe) + + # Check classes and names + expect_named( + phm_dt_input, + c("values", "utm_zone", "bbox_UTM", "bbox_LL", "function_call") + ) + expect_type(phm_dt_input, "list") + expect_type(phm_dt_input$utm_zone, "character") + expect_s3_class(phm_dt_input$bbox_UTM, "data.frame") + expect_s3_class(phm_dt_input$bbox_LL, "data.frame") + expect_type(phm_dt_input$function_call, "language") }) + + test_that("png output default name gives expected result", { + phm_shouldBe <- phm_values_known() + temp_dir <- tempdir() + + # Test png out + expect_message( + phm_png_out <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "png", + folder = temp_dir + ), + "Output file is located in" + ) + + expect_invisible( + phm_png_out <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "png", + folder = temp_dir + ) + ) + # Check if png file produced - expect_true(file.exists(phm_png_out_nameShouldBe)) + expect_true( + file.exists( + file.path( + temp_dir, + "fish_absolute.png" + ) + ) + ) + + expect_equal(phm_png_out$values, phm_shouldBe) + + # Clean up + unlink( + file.path( + temp_dir, + "fish_absolute.png" + ) + ) }) + + + test_that("png output custom name gives expected result", { + phm_shouldBe <- phm_values_known() + temp_dir <- tempdir() + + expect_message( + phm_png_out_named <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "png", + folder = temp_dir, + out_file = "mymap" + ), + "Output file is located in" + ) + + expect_invisible( + phm_png_out_named <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "png", + folder = temp_dir, + out_file = "mymap" + ) + ) + # Check if png file produced - expect_true(file.exists(phm_png_out_named_nameShouldBe)) + expect_true( + file.exists( + file.path( + temp_dir, + "mymap.png" + ) + ) + ) + + expect_equal(phm_png_out_named$values, phm_shouldBe) + + # Clean up + unlink( + file.path( + temp_dir, + "mymap.png" + ) + ) }) + + + test_that("kmz output default name gives expected result", { - # Check if png file produced - expect_true(file.exists(phm_kmz_out_nameShouldBe)) + phm_shouldBe <- phm_values_known() + temp_dir <- tempdir() + + expect_message( + phm_kmz_out <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "kmz", + folder = temp_dir + ), + "Output file is located in" + ) + + expect_invisible( + phm_kmz_out <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "kmz", + folder = temp_dir + ) + ) + + # Check if kmz file produced + expect_true( + file.exists( + file.path( + temp_dir, + "fish_absolute.kmz" + ) + ) + ) + + + expect_equal(phm_kmz_out$values, phm_shouldBe) + + # Clean up + unlink( + file.path( + temp_dir, + "fish_absolute.kmz" + ) + ) }) + + + + test_that("kmz output custom name gives expected result", { - # Check if png file produced - expect_true(file.exists(phm_kmz_out_named_nameShouldBe)) + phm_shouldBe <- phm_values_known() + temp_dir <- tempdir() + + expect_message( + phm_kmz_out_named <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "kmz", + folder = temp_dir, + out_file = "mymap" + ), + "Output file is located in" + ) + + expect_invisible( + phm_kmz_out_named <- position_heat_map( + lamprey_tracks, + x_limits = c(-84.14, -84.12), + y_limits = c(46.45, 46.47), + resolution = 100, + output = "kmz", + folder = temp_dir, + out_file = "mymap" + ) + ) + + # Check if kmz file produced + expect_true( + file.exists( + file.path( + temp_dir, + "mymap.kmz" + ) + ) + ) + + expect_equal(phm_kmz_out_named$values, phm_shouldBe) + + # Clean up + unlink( + file.path( + temp_dir, + "mymap.kmz" + ) + ) +}) + + + + + +##### TBD: TEST NON-EXPORTED FUNCTIONS #### +# Test non-exported query_worms_common function +test_that("internal function lonlat_to_utm", { + skip("Test needs to be created.") +}) + +# Test non-exported query_worms_common function +test_that("internal function utm_to_lonlat", { + skip("Test needs to be created.") }) diff --git a/tests/testthat/test-read_glatos_detections.r b/tests/testthat/test-read_glatos_detections.r index e6e88c81..1d7ed46e 100644 --- a/tests/testthat/test-read_glatos_detections.r +++ b/tests/testthat/test-read_glatos_detections.r @@ -1,84 +1,100 @@ -context("Check read_glatos_detections") - # check against internal data object 'receivers_2011' in R/sysdata.r -# Actual result -# get path to example detection file -wd_file <- system.file("extdata", - "walleye_detections.csv", - package = "glatos" -) - -wd <- read_glatos_detections(wd_file) -# Test using testthat library test_that("walleye_detections gives expected result", { + # get path to example detection file + wd_file <- system.file( + "extdata", + "walleye_detections.csv", + package = "glatos" + ) + + wd <- read_glatos_detections(wd_file) + + # Check if expected and actual results are the same expect_equal(wd, walleye_detections) }) -# get path to example detection file -ld_file <- system.file("extdata", - "lamprey_detections.csv", - package = "glatos" -) -ld <- read_glatos_detections(ld_file) test_that("lamprey_detections gives expected result", { + ld_file <- system.file( + "extdata", + "lamprey_detections.csv", + package = "glatos" + ) + + ld <- read_glatos_detections(ld_file) + # Check if expected and actual results are the same expect_equal(ld, lamprey_detections) }) -# test for mixed up column order -lamprey_detections2 <- ld[, c(2, 1, 3:27, 29, 28, 30)] -# write data frame with mixed up columns to temp file -temp_file <- tempfile() -write.csv(lamprey_detections2, temp_file, row.names = FALSE) - -ld2 <- read_glatos_detections(temp_file) test_that("lamprey_detections with mixed columns gives expected result", { - # Check if expected and actual results are the same - expect_equal(ld2, lamprey_detections2) -}) + ld_file <- system.file( + "extdata", + "lamprey_detections.csv", + package = "glatos" + ) + ld <- read_glatos_detections(ld_file) -# test for some missing animal_id but not all + ld_mixed_col <- ld[, c(2, 1, 3:27, 29, 28, 30)] -# write data frame with some missing animal_id -temp_file3 <- tempfile() -lamprey_detections3 <- ld -# make two animal_id missing -lamprey_detections3$animal_id[lamprey_detections3$animal_id %in% - c("A69-1601-1363", "A69-9002-7189")] <- NA -write.csv(lamprey_detections3, temp_file3, row.names = FALSE) + # write data frame with mixed up columns to temp file + temp_file <- tempfile() + write.csv(ld_mixed_col, temp_file, row.names = FALSE) -ld3 <- suppressWarnings(read_glatos_detections(temp_file3)) - -test_that("lamprey_detections with some missing anima_id expected result", { # Check if expected and actual results are the same - expect_equal(ld3, ld) + expect_equal( + read_glatos_detections(temp_file), + ld_mixed_col + ) + + # Clean up + unlink( + temp_file + ) }) -# test that warning is correct when animal_id is missing -ld3_w <- tryCatch(read_glatos_detections(temp_file3), - warning = function(w) { - return(w$message) - } -) -w_should_be <- paste( - "Some or all values of required column 'animal_id' were", - "missing so they were created from 'transmitter_codespace' and", - "'transmitter_id'.)" -) -test_that("lamprey_detections with some missing anima_id expected result", { +# test for some missing animal_id but not all +test_that("lamprey_detections with some missing animal_id expected result", { + # write data frame with some missing animal_id + temp_file <- tempfile() + ld_file <- system.file( + "extdata", + "lamprey_detections.csv", + package = "glatos" + ) + + ld_missing <- read_glatos_detections(ld_file) + + # make two animal_id missing + ld_missing$animal_id[ld_missing$animal_id %in% + c("A69-1601-1363", "A69-9002-7189")] <- NA + write.csv(ld_missing, temp_file, row.names = FALSE) + + expect_warning( + ld_missing_read_glatos <- read_glatos_detections(temp_file), + "Some or all values of required column 'animal_id' were missing so they were created from 'transmitter_codespace' and 'transmitter_id'\\." + ) + # Check if expected and actual results are the same - expect_equal(ld3_w, w_should_be) + expect_equal( + ld_missing_read_glatos, + read_glatos_detections(ld_file) + ) + + # Clean up + unlink( + temp_file + ) }) diff --git a/tests/testthat/test-read_glatos_receivers.r b/tests/testthat/test-read_glatos_receivers.r index 0bd88545..64daf030 100644 --- a/tests/testthat/test-read_glatos_receivers.r +++ b/tests/testthat/test-read_glatos_receivers.r @@ -1,48 +1,59 @@ -context("Check read_glatos_receivers") - # check against internal data object 'sample_receivers' in R/sysdata.r # Actual result -# get path to example receiver location file -rec_file <- system.file("extdata", - "sample_receivers.csv", - package = "glatos" -) -rec <- read_glatos_receivers(rec_file) - -# Test using testthat library test_that("read_glatos_receivers gives expected result", { + rec_file <- system.file( + "extdata", + "sample_receivers.csv", + package = "glatos" + ) + rec <- read_glatos_receivers(rec_file) + # Check if expected and actual results are the same expect_equal(rec, sample_receivers) }) + + + # test for mixed up column order -sample_receivers_muco <- rec[, c(1:8, 10, 9, 11:23)] +test_that("read_glatos_receivers with mixed columns gives expected result", { + rec_file <- system.file( + "extdata", + "sample_receivers.csv", + package = "glatos" + ) + rec <- read_glatos_receivers(rec_file) -# write data frame with mixed up columns to temp file -temp_file <- tempfile() -write.csv(sample_receivers_muco, temp_file, row.names = FALSE) + sample_receivers_muco <- rec[, c(1:8, 10, 9, 11:23)] -recx_muco <- read_glatos_receivers(temp_file) + # write data frame with mixed up columns to temp file + temp_file <- tempfile() + write.csv(sample_receivers_muco, temp_file, row.names = FALSE) + recx_muco <- read_glatos_receivers(temp_file) -test_that("read_glatos_receivers with mixed columns gives expected result", { # Check if expected and actual results are the same expect_equal(recx_muco, sample_receivers_muco) + + # Clean up + unlink( + temp_file + ) }) # test for GLATOS receiver_locations file mod. Jan. 2023 (add code_map cols) - -# get path to example receiver location file -rec2_file <- system.file("extdata", - "sample_receivers2.csv", - package = "glatos" -) -rec2 <- read_glatos_receivers(rec2_file) - # Test using testthat library test_that("read_glatos_receivers2 gives expected result", { + # get path to example receiver location file + rec2_file <- system.file( + "extdata", + "sample_receivers2.csv", + package = "glatos" + ) + rec2 <- read_glatos_receivers(rec2_file) + # Check if expected and actual results are the same expect_equal(rec2, sample_receivers2) }) diff --git a/tests/testthat/test-read_glatos_workbook.r b/tests/testthat/test-read_glatos_workbook.r index 8d0e06a0..7e8e20e9 100644 --- a/tests/testthat/test-read_glatos_workbook.r +++ b/tests/testthat/test-read_glatos_workbook.r @@ -1,25 +1,40 @@ -context("Check read_glatos_workbook") +test_that("metadata element gives expected result", { + wb_file <- system.file("extdata", + "walleye_workbook.xlsm", + package = "glatos" + ) + wb <- read_glatos_workbook(wb_file) -# Actual result -# get path to example receiver location file -wb_file <- system.file("extdata", - "walleye_workbook.xlsm", - package = "glatos" -) -wb <- read_glatos_workbook(wb_file) + expect_type(wb[["metadata"]], "list") -# Test using testthat library -test_that("metadata element gives expected result", { # Check if expected and actual results are the same expect_equal(wb[["metadata"]][1:5], walleye_workbook[["metadata"]][1:5]) }) test_that("receivers element gives expected result", { + wb_file <- system.file("extdata", + "walleye_workbook.xlsm", + package = "glatos" + ) + wb <- read_glatos_workbook(wb_file) + + expect_s3_class(wb[["receivers"]], "glatos_receivers") + expect_s3_class(wb[["receivers"]], "data.frame") + # Check if expected and actual results are the same - expect_equal(wb["receivers"], walleye_workbook["receivers"]) + expect_equal(wb[["receivers"]], walleye_workbook[["receivers"]]) }) test_that("animals gives expected result", { + wb_file <- system.file("extdata", + "walleye_workbook.xlsm", + package = "glatos" + ) + wb <- read_glatos_workbook(wb_file) + + expect_s3_class(wb[["animals"]], "glatos_animals") + expect_s3_class(wb[["animals"]], "data.frame") + # Check if expected and actual results are the same - expect_equal(wb["animals"], walleye_workbook["animals"]) + expect_equal(wb[["animals"]], walleye_workbook[["animals"]]) }) diff --git a/tests/testthat/test-read_otn_deployments.r b/tests/testthat/test-read_otn_deployments.r index 25850d00..5732fed5 100644 --- a/tests/testthat/test-read_otn_deployments.r +++ b/tests/testthat/test-read_otn_deployments.r @@ -1,16 +1,14 @@ -context("Check read_otn_deployments") +test_that("hfx_deployments gives expected result", { + skip("Skipping until issue #202 is resolved.") -# Actual result -# get path to example deployment file -dep_file <- system.file("extdata", - "hfx_deployments.csv", - package = "glatos" -) + dep_file <- system.file("extdata", + "hfx_deployments.csv", + package = "glatos" + ) + + deps <- read_otn_deployments(dep_file) -deps <- read_otn_deployments(dep_file) -# Test using testthat library -test_that("hfx_deployments gives expected result", { # Check if expected and actual results are the same expect_equal(deps, hfx_deployments) }) diff --git a/tests/testthat/test-read_otn_detections.r b/tests/testthat/test-read_otn_detections.r index e379ba0d..48396354 100644 --- a/tests/testthat/test-read_otn_detections.r +++ b/tests/testthat/test-read_otn_detections.r @@ -1,16 +1,16 @@ -context("Check read_otn_detections") - -# Actual result -# get path to example detection file -bsd_file <- system.file("extdata", - "blue_shark_detections.csv", - package = "glatos" -) +test_that("blue_shark_detections gives expected result", { + # get path to example detection file + bsd_file <- system.file( + "extdata", + "blue_shark_detections.csv", + package = "glatos" + ) -bsd <- read_otn_detections(bsd_file) + bsd <- read_otn_detections(bsd_file) -# Test using testthat library -test_that("blue_shark_detections gives expected result", { # Check if expected and actual results are the same expect_equal(bsd, blue_shark_detections) + + expect_s3_class(bsd, "glatos_detections") + expect_s3_class(bsd, "data.frame") }) diff --git a/tests/testthat/test-read_vemco_tag_specs.r b/tests/testthat/test-read_vemco_tag_specs.r index c2fce240..ef9b344d 100644 --- a/tests/testthat/test-read_vemco_tag_specs.r +++ b/tests/testthat/test-read_vemco_tag_specs.r @@ -1,21 +1,45 @@ -context("Check read_vemco_tag_specs") +test_that("returns a list", { + # get path to example tag spec file + tag_file <- system.file( + "extdata", + "lamprey_tag_specs.xls", + package = "glatos" + ) -# Actual result -# get path to example tag spec file -tag_file <- system.file("extdata", - "lamprey_tag_specs.xls", - package = "glatos" -) -tag_specs <- read_vemco_tag_specs(tag_file, file_format = "vemco_xls") + tag_specs <- read_vemco_tag_specs(tag_file, file_format = "vemco_xls") + + expect_type(tag_specs, "list") + expect_named(tag_specs, c("specs", "schedule")) +}) -# Test using testthat library test_that("'specs' element gives expected result", { + # get path to example tag spec file + tag_file <- system.file( + "extdata", + "lamprey_tag_specs.xls", + package = "glatos" + ) + tag_specs <- read_vemco_tag_specs(tag_file, file_format = "vemco_xls") + # Check if expected and actual results are the same - expect_equal(tag_specs["specs"], lamprey_tag_specs["specs"]) + expect_equal(tag_specs[["specs"]], lamprey_tag_specs[["specs"]]) + expect_s3_class(tag_specs[["specs"]], "data.frame") }) + + + test_that("'schedule' element gives expected result", { + # get path to example tag spec file + tag_file <- system.file( + "extdata", + "lamprey_tag_specs.xls", + package = "glatos" + ) + tag_specs <- read_vemco_tag_specs(tag_file, file_format = "vemco_xls") + # Check if expected and actual results are the same - expect_equal(tag_specs["schedule"], lamprey_tag_specs["schedule"]) + expect_equal(tag_specs[["schedule"]], lamprey_tag_specs[["schedule"]]) + expect_s3_class(tag_specs[["schedule"]], "data.frame") }) diff --git a/tests/testthat/test-receiver_efficiency.R b/tests/testthat/test-receiver_efficiency.R index 8da2124c..c3687ea5 100644 --- a/tests/testthat/test-receiver_efficiency.R +++ b/tests/testthat/test-receiver_efficiency.R @@ -1,370 +1,61 @@ -context("Check receiver_efficiency") +test_that("REI gives expected results for the halifax line", { + skip("Skipping until issue #202 is resolved.") + + det_file <- system.file( + "extdata", + "hfx_detections.csv", + package = "glatos" + ) + + dep_file <- system.file( + "extdata", + "hfx_deployments.csv", + package = "glatos" + ) -# Actual results -# get path to example detection and deployment files + hfx_detections <- read_otn_detections(det_file) + hfx_deployments <- read_otn_deployments(dep_file) -# otn example -det_file <- system.file("extdata", "hfx_detections.csv", - package = "glatos" -) + hfx_rei <- REI(hfx_detections, hfx_deployments) -dep_file <- system.file("extdata", "hfx_deployments.csv", - package = "glatos" -) -hfx_detections <- glatos::read_otn_detections(det_file) -hfx_deployments <- glatos::read_otn_deployments(dep_file) -hfx_rei <- glatos::REI(hfx_detections, hfx_deployments) + hfx_efficiency_index <- hfx_receiver_efficiency_index() + # Check if expected and actual results are the same + expect_equal(hfx_rei, hfx_efficiency_index) +}) -# glatos example -det_file <- system.file("extdata", "walleye_detections.csv", - package = "glatos" -) -dep_file <- system.file("extdata", "sample_receivers.csv", - package = "glatos" -) -glatos_dets <- glatos::read_glatos_detections(det_file) -glatos_deps <- glatos::read_glatos_receivers(dep_file) +test_that("REI gives expected results for the GLATOS samples", { + det_file <- system.file( + "extdata", + "walleye_detections.csv", + package = "glatos" + ) + dep_file <- system.file( + "extdata", + "sample_receivers.csv", + package = "glatos" + ) -glatos_rei <- glatos::REI(glatos_dets, glatos_deps) + glatos_dets <- read_glatos_detections(det_file) + glatos_deps <- read_glatos_receivers(dep_file) -# Define expected results -hfx_receiver_efficiency_index <- - structure( - list(station = c( - "HFX001", "HFX002", "HFX003", "HFX004", - "HFX005", "HFX006", "HFX007", "HFX008", "HFX009", "HFX010", "HFX011", - "HFX012", "HFX013", "HFX014", "HFX015", "HFX016", "HFX017", "HFX018", - "HFX019", "HFX020", "HFX021", "HFX022", "HFX023", "HFX024", "HFX025", - "HFX026", "HFX027", "HFX028", "HFX029", "HFX030", "HFX031", "HFX032", - "HFX033", "HFX034", "HFX035", "HFX036", "HFX037", "HFX038", "HFX039", - "HFX040", "HFX041", "HFX042", "HFX043", "HFX044", "HFX045", "HFX046", - "HFX047", "HFX048", "HFX049", "HFX050", "HFX051", "HFX052", "HFX053", - "HFX054", "HFX055", "HFX056", "HFX057", "HFX058", "HFX059", "HFX060", - "HFX061", "HFX062", "HFX063", "HFX064", "HFX065", "HFX066", "HFX067", - "HFX068", "HFX069", "HFX070", "HFX071", "HFX072", "HFX073", "HFX074", - "HFX075", "HFX076", "HFX077", "HFX078", "HFX079", "HFX080", "HFX081", - "HFX082", "HFX083", "HFX084", "HFX085", "HFX086", "HFX087", "HFX088", - "HFX089", "HFX090", "HFX091", "HFX092", "HFX093", "HFX094", "HFX095", - "HFX096", "HFX097", "HFX098", "HFX099", "HFX100", "HFX101", "HFX102", - "HFX103", "HFX104", "HFX105", "HFX106", "HFX107", "HFX108", "HFX109", - "HFX110", "HFX111", "HFX112", "HFX113", "HFX114", "HFX115", "HFX116", - "HFX117", "HFX118", "HFX119", "HFX120", "HFX121", "HFX122", "HFX123", - "HFX124", "HFX125", "HFX126", "HFX127", "HFX128", "HFX129", "HFX130", - "HFX131", "HFX132", "HFX133", "HFX134", "HFX135", "HFX136", "HFX137", - "HFX138", "HFX139", "HFX140", "HFX141", "HFX142", "HFX143", "HFX144", - "HFX145", "HFX146", "HFX147", "HFX148", "HFX149", "HFX150", "HFX151", - "HFX152", "HFX153", "HFX154", "HFX155", "HFX156", "HFX157", "HFX158", - "HFX159", "HFX160", "HFX161", "HFX162", "HFX163", "HFX164", "HFX165", - "HFX166", "HFX167", "HFX168", "HFX169", "HFX170", "HFX171", "HFX172", - "HFX173", "HFX174", "HFX175", "HFX176", "HFX177", "HFX178", "HFX179", - "HFX180", "HFX181", "HFX182", "HFX183", "HFX184", "HFX185", "HFX186", - "HFX187", "HFX188", "HFX189", "HFX190", "HFX191", "HFX192", "HFX193", - "HFX194", "HFX195", "HFX196", "HFX197", "HFX198", "HFX199", "HFX200", - "HFX201", "HFX202", "HFX203", "HFX204", "HFX205", "HFX206", "HFX207", - "HFX208", "HFX209", "HFX210", "HFX211", "HFX212", "HFX213", "HFX214", - "HFX215", "HFX216", "HFX217", "HFX218", "HFX219", "HFX220", "HFX221", - "HFX222", "HFX223", "HFX224", "HFX225", "HFX226", "HFX227", "HFX228", - "HFX229", "HFX230", "HFX231", "HFX232", "HFX233", "HFX234", "HFX235", - "HFX236", "HFX237", "HFX238", "HFX239", "HFX240", "HFX241", "HFX242", - "HFX243", "HFX244", "HFX245", "HFX246", "HFX247", "HFX248", "HFX249", - "HFX250", "HFX251", "HFX252", "HFX253", "HFX254", "HFX255", "HFX256" - ), latitude = c( - 44.4784398019802, 44.4723024482759, 44.4666508064516, - 44.4610676153846, 44.4551916666667, 44.4495551342282, 44.4435718960674, - 44.4376724347826, 44.4322934263959, 44.4263002160494, 44.4201856701031, - 44.4146651076321, 44.4087329514563, 44.403021013986, 44.3970783737024, - 44.3914915625, 44.3855497835498, 44.3798768561485, 44.3741773574045, - 44.3684355159648, 44.362973256262, 44.3571419512195, 44.3512523391089, - 44.3451172286374, 44.3393246019629, 44.3340587029624, 44.3277182426128, - 44.3226188888889, 44.3165625172414, 44.3105936758893, 44.3047808, - 44.2990175064488, 44.2931161571125, 44.2873048487141, 44.2816719847328, - 44.2195895147679, 44.2846399468085, 43.6516402863962, 44.2586467034068, - 44.252981980116, 44.2472888926175, 44.242369331307, 44.2362211627907, - 44.230495298913, 44.2206545991561, 44.21905, 44.2132852822581, - 44.2071202259887, 44.2020485818182, 44.1964227734375, 44.1907233548387, - 44.1850885384615, 44.1794826277372, 44.17387, 44.1681454153846, - 44.1626348537005, 44.15686, 44.1513683488372, 44.1135019434629, - 44.1398208445946, 44.1342792727273, 44.1288728384279, 44.1229017255717, - 44.1173704, 44.1116368674699, 44.1058232432432, 44.1000438741722, - 44.0945382736156, 44.0881734986945, 44.0832373353752, 44.0776513176265, - 44.0720459965035, 44.06625, 44.05994, 44.05354, 44.04911, 44.0384475431034, - 44.134063537415, 44.0279, 44.02162, 44.01518, 44.00873, 44.0027, - 43.99641, 43.98999, 43.98365, 43.97717, 43.97074, 43.96465, 43.95812, - 43.95173, 43.94532, 43.93904, 43.93265, 43.92633, 43.91994, 43.9134, - 43.90728, 43.90088, 43.89448, 43.88814, 43.88175, 43.87541, 43.86916, - 43.86264, 43.85627, 43.85201, 43.84738, 43.84366, 43.83852, 43.83428, - 43.83007, 43.82618, 43.82182, 43.81778, 43.8131980645161, 43.80840968, - 43.804304333996, 43.7998687804878, 43.7932530808081, 43.7865957142857, - 43.7798796629213, 43.7733213095238, 43.7667, 43.76021, 43.752952, - 43.74669703125, 43.73983, 43.7332184210526, 43.7267892307692, - 43.7199793103448, 43.713423125, 43.70638, 43.6998570588235, 43.6926779710145, - 43.685098974359, 43.6776485714286, 43.6704656521739, 43.6630838461538, - 43.65541, 43.64797, 43.640729, 43.63336, 43.627094, 43.6207466666667, - 43.614184, 43.6076310169492, 43.60166, 43.5954530357143, 43.5890148387097, - 43.5825766129032, 43.5761444067797, 43.5696846341463, 43.5634651724138, - 43.5571024, 43.5506, 43.5444, 43.5381164646465, 43.531735, 43.52528, - 43.51892, 43.5126674358974, 43.506225, 43.4998591891892, 43.4926146666667, - 43.48532, 43.47827, 43.47112, 43.46386, 43.45657, 43.4495, 43.4421, - 43.43491, 43.42778, 43.42051, 43.41323, 43.40624, 43.39898, 43.3919, - 43.3839113559322, 43.37737, 43.36992, 43.3631, 43.35567, 43.34852, - 43.34131, 43.33252, 43.32693, 43.31976, 43.31267, 43.30535, 43.29809, - 43.29098, 43.28379, 43.27641, 43.26901, 43.26221, 43.25488, 43.24799, - 43.24071, 43.23345, 43.22632, 43.21909, 43.21196, 43.20489, 43.1974648648649, - 43.19034, 43.18252, 43.17557, 43.1687, 43.16141, 43.15449, 43.14712, - 43.13988, 43.13266, 43.12533, 43.11846, 43.11101, 43.10386, 43.09654, - 43.08928, 43.08235, 43.07501, 43.06784, 43.06054, 43.05329, 43.04632, - 43.0391, 43.03187, 43.02455, 43.01746, 43.01016, 43.00303, 42.9958, - 42.98856, 42.98146, 42.97416, 42.96708, 42.95967, 42.95246, 42.94533, - 42.93799, 42.93086, 42.92372, 42.916286744186, 42.90925, 42.90203, - 42.89487, 42.88764, 42.88042, 42.87317, 42.86598, 42.8588, 42.85166, - 42.84442, 42.83737 - ), longitude = c( - -63.5333763366337, -63.5269339655172, - -63.5200411693548, -63.5140228461538, -63.5077485087719, -63.5009823825503, - -63.4941791432584, -63.4880379130435, -63.4813606218274, -63.4751074382716, - -63.4685693519882, -63.4621277886497, -63.4558474174757, -63.4487153146853, - -63.4426002076125, -63.4360236979167, -63.4298772438672, -63.4230945475638, - -63.4168982940869, -63.4101426654327, -63.4023615992293, -63.3974944850948, - -63.3909311262376, -63.3842537759815, -63.377850348964, -63.3713183827062, - -63.3647795489891, -63.3597477777778, -63.3519217931035, -63.3453266007905, - -63.3386898434783, -63.3323952450559, -63.3259785138004, -63.3197691906203, - -63.3130440330789, -63.9073214345992, -63.3202238297872, -64.9284846300716, - -63.2876916533066, -63.2810401077051, -63.2749722818792, -63.2681703951368, - -63.2620515742397, -63.2564305434783, -63.2499893670886, -63.2434346047431, - -63.2371794354839, -63.2312440112994, -63.2246610545455, -63.2189780078125, - -63.2126161935484, -63.2062673461538, -63.2000200729927, -63.1937021282401, - -63.1875617846154, -63.1811118072289, -63.1749595793499, -63.1685094883721, - -63.2591738162544, -63.1561848141892, -63.1495723636364, -63.1436744323144, - -63.1375132016632, -63.1309038909091, -63.1247902409639, -63.1182235735736, - -63.112007615894, -63.1054898045603, -63.1005381462141, -63.0933156814701, - -63.0868376178011, -63.0806824125874, -63.07414, -63.0792, -63.08357, - -63.08809, -63.0969261206897, -62.9843613605442, -63.10217, -63.10683, - -63.11176, -63.11657, -63.1213, -63.12604, -63.13182, -63.1366, - -63.14147, -63.14619, -63.15083, -63.15571, -63.16059, -63.16522, - -63.16999, -63.17481, -63.17962, -63.18439, -63.1888349367089, - -63.19393, -63.19874, -63.20349, -63.20832, -63.21309, -63.21791, - -63.22261, -63.22745, -63.23223, -63.23979, -63.2469, -63.25558, - -63.2625, -63.27016, -63.27802, -63.28576, -63.29423, -63.30154, - -63.3093506451613, -63.31715816, -63.3255161232604, -63.3331092195122, - -63.3373797979798, -63.34226, -63.3464540449438, -63.3506098809524, - -63.35541, -63.36019, -63.364389, -63.3691428125, -63.3727, -63.3775568421053, - -63.3824750769231, -63.3866017241379, -63.391106875, -63.39574, - -63.4000829411765, -63.3999888405797, -63.4000625641026, -63.3999214285714, - -63.399828115942, -63.3997935897436, -63.39962, -63.39958, -63.3996306666667, - -63.39955, -63.404484, -63.4092066666667, -63.414138, -63.4190913559322, - -63.42339, -63.42824375, -63.4330585483871, -63.4379172580645, - -63.4428172881356, -63.4475014634146, -63.4522996551724, -63.4571352, - -63.46193, -63.4665314285714, -63.4712249494949, -63.4762175, - -63.481, -63.48577, -63.4904820512821, -63.495327631579, -63.500117027027, - -63.500012, -63.49993, -63.49999, -63.50007, -63.49996, -63.50004, - -63.50019, -63.50004, -63.49997, -63.50003, -63.50009, -63.50002, - -63.50004, -63.49997, -63.49997, -63.4988177966102, -63.50005, - -63.50012, -63.50003, -63.50009, -63.50005, -63.49999, -63.49986, - -63.50003, -63.49999, -63.50004, -63.5, -63.50006, -63.50002, - -63.50001, -63.49989, -63.4998, -63.5, -63.49993, -63.49988, - -63.5, -63.50009, -63.5001, -63.5001, -63.5, -63.50003, -63.4998275675676, - -63.49998, -63.49755, -63.4989, -63.50024, -63.49966, -63.49789, - -63.50007, -63.49985, -63.49995, -63.49983, -63.50012, -63.4999, - -63.49987, -63.50001, -63.5, -63.50011, -63.50005, -63.50017, - -63.49996, -63.49983, -63.50005, -63.50001, -63.50005, -63.50002, - -63.50025, -63.49989, -63.5001, -63.5, -63.49994, -63.50004, - -63.49993, -63.50002, -63.49997, -63.49992, -63.49998, -63.49992, - -63.49999, -63.50004, -63.4993546511628, -63.49999, -63.49995, - -63.50002, -63.50002, -63.49993, -63.50004, -63.49995, -63.49997, - -63.49995, -63.50003, -63.49981 - ), rei = c( - 0.00580962595813294, - 0.00367974146481378, 0.00539465267540915, 0.00237666516469075, - 0.000616975249894385, 0.00605000338855328, 0.0102685716970085, - 0.00940763294356754, 0.0154615103597092, 0.0045924944994297, - 0.00987950455711003, 0.00710948303275562, 0.0108631411736046, - 0.0133844375869352, 0.0103145677269121, 0.0151580743135218, 0.0109762569773178, - 0.0175116715379229, 0.0193365593241384, 0.0222672565967032, 0.0221161897269833, - 0.0178835807361363, 0.0180370531995448, 0.0172777683805761, 0.0144151936180136, - 0.0153620948583662, 0.00844098548747172, 0.00581493964041172, - 0.0124007237265634, 0.021779150551173, 0.0103719793984492, 0.0246520082878421, - 0.0251013938555892, 0.0309982419752233, 0.0369323090167397, 0.00347540124281167, - 0.00602265863414448, 0.018715344304749, 0.0207190190354482, 0.0255471611243613, - 0.0195522377469652, 0.00413253545156261, 0.0212486376004305, - 0.00599967097300492, 0.0047843815878331, 0.0232577804139694, - 0.0196386309600345, 0.00400984628733441, 0.00561428454528765, - 0.00692997841256096, 0.00824428466321907, 0.0175639108042493, - 0.0132983896089316, 0.0147232170670315, 0.013172933103187, 0.0177431343838845, - 0.010036520459571, 0.00815467287340147, 0.00676259482025538, - 0.00746018150231508, 0.00165326390894481, 0.0149114018256484, - 0.0127129259154567, 0.00885364483397874, 0.0109147159997835, - 0.00581317114355189, 0.00234539325462903, 0.00736448661001295, - 0.00300540487039514, 0.00309126598444988, 0.00545517526667626, - 0.00590693196844789, 0.00343520698422078, 0.00403825740602252, - 0.00389323458211689, 0.00479835115118015, 0.00177387997563415, - 0.00466563653309299, 0.000875488631092519, 0.00131323294663878, - 0.00172403915045911, 0.00202035837944427, 0.00272748381224977, - 0.00214663077815954, 0.00243284821524748, 0.00266081996345123, - 0.000814877879709191, 0.000925997590578626, 0.00170720283063041, - 0.00121221502766657, 0.00176781358201374, 0.00243116458326461, - 0.00194627857219799, 0.000673452793148092, 0.00105058635731102, - 0.000963037494201771, 0.000353976052508596, 0.0013095991499966, - 0.00096215447754852, 0.00096215447754852, 0.000668162831630916, - 0.000601346548467825, 0.000280628389284985, 0.00024053861938713, - 0.000668162831630916, 0.0013095991499966, 0.000808477026273409, - 0.000180403964540347, 5.34530265304733e-05, 0.000467713982141642, - 0.000668162831630917, 0.000534530265304733, 0.000751683185584781, - 0.000601346548467825, 0.000601346548467825, 0.00132942570800301, - 0.00132942570800301, 0.00147259463040333, 0.00261794600960592, - 0.00472457443921068, 0.00157485814640356, 0.00159531084960361, - 0.00112489867600254, 0.000102263516000231, 3.06790548000694e-05, - 0.000284757807643562, 0.000681756773334875, 0.000165760915675258, - 0.00088405821693471, 0.000696195845836084, 0.00016122805496926, - 0.000138134096396048, 0.000270742828936255, 0.000663043662701033, - 0.000994565494051549, 0.00088333893879963, 8.8405821693471e-05, - 0.000276268192792097, 0.000117874428924628, 0.000165760915675258, - 6.63043662701033e-05, 0.000206280250618099, 0.000138134096396048, - 1.47343036155785e-05, 1.22867720705463e-05, 2.76452371587292e-05, - 0.000214700436513799, 0.00043003702246912, 0.00101365869582007, - 0.000622017836071406, 0.00128725051071688, 0.00043003702246912, - 0.000232685362859043, 0.000735571720409645, 0.000552904743174583, - 0.000122867720705463, 0.000552904743174583, 0.00110580948634917, - 0.000387033320222208, 0.000115188488161372, 0.000184301581058194, - 0.000184301581058194, 0.000393176706257481, 0.000258022213481472, - 0.000301025915728384, 0.000301025915728384, 0.000234092734005368, - 0.000156061822670245, 0.000156061822670245, 5.09589625045699e-05, - 0.000171986498452923, 0.000119435068370086, 7.96233789133905e-05, - 7.64384437568548e-05, 6.36987031307124e-05, 0.00010191792500914, - 7.64384437568548e-05, 0.000445890921914987, 0.000445890921914987, - 0.000313988238250925, 0.000458630662541129, 0.00031212364534049, - 0.000119435068370086, 7.64384437568548e-05, 0.000390154556675613, - 0.000229315331270565, 0.000200766563804027, 0.000267688751738703, - 5.09883336645149e-05, 0.000267688751738703, 0.000267688751738703, - 0.000458895002980634, 9.56031256209654e-05, 7.64825004967723e-05, - 7.64825004967723e-05, 2.86809376862896e-05, 6.37354170806436e-06, - 5.73618753725793e-05, 0.000229447501490317, 0.000717023442157241, - 0.000750323083318946, 0.000675290774987051, 0.000210090463329305, - 0.000150064616663789, 0.000240103386662063, 0.000675290774987051, - 0.00032013784888275, 8.00344622206876e-05, 5.78621242857122e-05, - 1.66738462959766e-06, 1.50064616663789e-05, 0.000129731839180628, - 0.000175075386107754, 0.000210090463329305, 0.000194489105639301, - 0.000138920789742358, 4.93940585750605e-05, 0.000345758410025423, - 0.000345758410025423, 0.000444546527175544, 0.000222273263587772, - 0.000302538608772245, 0.000302538608772245, 0.000138920789742358, - 0.000115767324785298, 0.000296364351450363, 0.000162074254699417, - 0.00100331681480592, 0.00075435065735447, 0.000432198012531779, - 0.000491159035814985, 0.000284170585007241, 0.000105248364817497, - 1.75413941362495e-06, 1.75413941362495e-06, 0.000221021566116743, - 0.000157872547226245, 5.61324612359983e-05, 0.000171905662535245, - 0.000171905662535245, 3.1574509445249e-05, 0.000368369276861239, - 0.000589390842977982, 0.000463092805196986, 0.000197576234300242, - 0.000561324612359983, 0.00171028592828432, 0.000877069706812474, - 0.00125420968074184, 0.00171905662535245, 0.00137524530028196, - 0.00100336774459347, 0.000993907960703525, 0.00136822874262746, - 0.00136822874262746, 0.00147347710744496 - )), - class = "data.frame", - row.names = c( - NA, - -256L - ) - ) + glatos_rei <- REI(glatos_dets, glatos_deps) -glatos_receiver_efficiency_index <- - structure( - list(station = c( - "DRF-004", "DRL-004", "DRL-010", "DRL-011", - "DRU-001", "DRU-002", "DRU-004", "DRU-005", "DRU-006", "DRU-007", - "DRU-008", "FMP-001", "FMP-002", "FMP-003", "MAU-001", "MAU-002", - "MAU-003", "MAU-011", "MAU-012", "OSC-001", "OSC-002", "OSC-003", - "PRS-001", "PRS-002", "PRS-003", "RAR-001", "RAR-002", "RAR-003", - "RAR-004", "RAR-005", "SBI-001", "SBI-002", "SBI-003", "SBI-007", - "SBI-008", "SBI-009", "SBI-010", "SBI-011", "SBI-012", "SBI-013", - "SBI-014", "SBI-015", "SBI-016", "SBI-017", "SBI-018", "SBI-019", - "SBI-020", "SBO-001", "SBO-002", "SBO-003", "SBO-004", "SBO-005", - "SBO-006", "SBO-007", "SBO-008", "SBO-009", "SBO-010", "SBO-012", - "SCL-001", "SCL-002", "SCL-004", "SCL-005", "SCM-001", "SCM-002", - "SCM-003", "SGR-001", "SHR-001", "STG-006", "THB-003", "THB-004", - "THB-005", "THB-006", "THB-007", "THB-008", "THB-009", "THB-010", - "THB-011", "THB-014", "THB-015", "THB-016", "TSR-001", "TTB-001" - ), latitude = c( - 42.24937, 42.12746, 42.0769, 42.09637, 42.35693, - 42.35278, 42.35469, 42.35085, 42.34447, 42.33541, 42.33204, 45.48983, - 45.49914, 45.50756, 41.57098, 41.57417, 41.57612, 41.63532, 41.6443, - 44.45198, 44.45157, 44.45144, 45.33385, 45.33986, 45.34603, 41.63719, - 41.63648, 41.64165, 41.63846, 41.63288, 44.17873, 44.1771329411765, - 44.17255, 44.15439, 44.14975, 44.14524, 44.14066, 44.13613, 44.13149, - 44.12695, 44.12241, 44.11781, 44.11329, 44.10875, 44.10408, 44.09961, - 44.09214, 44.2464643333333, 44.2417948571429, 44.2370746835443, - 44.2323153731343, 44.22771, 44.2229290625, 44.21828, 44.21342, - 44.2088, 44.2041, 44.19472, 42.61334, 42.61462, 42.55267, 42.54992, - 42.77913, 42.76994, 42.6352, 43.61235, 43.37698, 44.71315, 44.90447, - 44.91327, 44.92215, 44.9308, 44.93957, 44.94818, 44.95714, 44.96585, - 44.97452, 45.00077, 45.0095, 45.01824, 41.62433, 43.387016744186 - ), longitude = c( - -83.11824, -83.11873, -83.12096, -83.11681, - -82.93016, -82.92844, -82.94291, -82.93774, -82.93849, -83.00901, - -83.00352, -83.91048, -83.9059, -83.90137, -83.61776, -83.60687, - -83.61071, -83.53083, -83.53426, -83.31861, -83.30572, -83.29315, - -83.45837, -83.44852, -83.43862, -82.97453, -82.96842, -82.97328, - -82.98027, -82.97516, -83.5477078947368, -83.5417041176471, -83.5309, - -83.48782, -83.47694, -83.46626, -83.45551, -83.44487, -83.43403, - -83.42327, -83.41245, -83.40174, -83.39079, -83.38007, -83.36923, - -83.35869, -83.35204, -83.445841, -83.4350991428571, -83.4244859493671, - -83.4138805970149, -83.4031, -83.3923328125, -83.38175, -83.37122, - -83.36047, -83.34985, -83.32868, -82.52119, -82.52926, -82.58909, - -82.58493, -82.47231, -82.47034, -82.49834, -83.8609006451613, - -83.99115, -83.2011, -83.31385, -83.31073, -83.30769, -83.30461, - -83.30165, -83.29828, -83.29516, -83.29228, -83.28925, -83.27969, - -83.27665, -83.27346, -83.01284, -83.9873130232558 - ), rei = c( - 0.00123899096401187, - 0.00156294731698745, 0.00141378636972309, 0.00116287547816814, - 0.00168674512427359, 0.001577419051404, 0.00154873870501484, - 0.00347676035819657, 0.00329200497684313, 0.00181235380374077, - 0.00120609739859563, 0.0335136900101571, 0.00645919459911402, - 0.00903773249610781, 0.042590314387908, 0.00900588145647395, - 0.0278709623806351, 0.127770943163724, 0.0448319098820085, 0.00146863153061752, - 0.00146863153061752, 0.00104676655945703, 0.00740701119789705, - 0.0126977334821092, 0.0105814445684244, 0.106732354128733, 0.0903119919550821, - 0.0985221730419077, 0.0985221730419077, 0.106732354128733, 0.00205564111676178, - 0.00217020710256856, 0.00102627263585321, 0.000953069972316823, - 0.000939924179595212, 0.00187984835919042, 0.00187725903638162, - 0.00187725903638162, 0.00187725903638162, 0.00187725903638162, - 0.000938629518190811, 0.00187725903638162, 0.00100360092813922, - 0.00100508116549635, 0.000938629518190811, 0.000945138738150525, - 0.00100508116549635, 0.00216103075118349, 0.00373906738110578, - 0.00285920991695047, 0.00285920991695047, 0.00190613994463365, - 0.00285920991695047, 0.000953069972316823, 0.000953069972316823, - 0.000957085716582203, 0.000957085716582203, 0.000957085716582203, - 0.00176998709144553, 0.00176998709144553, 0.00176998709144553, - 0.0033568720699829, 0.00117897064049572, 0.00117897064049572, - 0.0016224881671584, 0.00410509054341282, 0.00327617802983908, - 0.00109733499228104, 0.0011008805011414, 0.00104196487799163, - 0.00104196487799163, 0.00208392975598327, 0.00104196487799163, - 0.000994810263075224, 0.000994810263075224, 0.000994810263075224, - 0.0011008805011414, 0.000994810263075224, 0.00198962052615045, - 0.00194977118800151, 0.0574712676077795, 0.00411335028293679 - )), - class = "data.frame", row.names = c( - NA, - -82L - ) - ) + glatos_efficiency_index <- glatos_receiver_efficiency_index() -# Test using testthat library -test_that("REI gives expected results for the halifax line", { # Check if expected and actual results are the same - expect_equal(hfx_rei, hfx_receiver_efficiency_index) -}) + expect_equal(glatos_rei, glatos_efficiency_index) -# Test using testthat library -test_that("REI gives expected results for the GLATOS samples", { - # Check if expected and actual results are the same - expect_equal(glatos_rei, glatos_receiver_efficiency_index) + expect_s3_class(glatos_rei, "data.frame") + expect_identical(dim(glatos_rei), c(82L, 4L)) + expect_named(glatos_rei, c("station", "latitude", "longitude", "rei")) }) diff --git a/tests/testthat/test-residence_index.r b/tests/testthat/test-residence_index.r index 43e84bdc..c9bd8771 100644 --- a/tests/testthat/test-residence_index.r +++ b/tests/testthat/test-residence_index.r @@ -1,280 +1,5 @@ -context("Check residence_index") - -# Actual result -# get path to example detection file -bsd_file <- system.file("extdata", - "blue_shark_detections.csv", - package = "glatos" -) - -data <- read_otn_detections(bsd_file) - -cdata <- glatos::detection_events(data, location_col = "station") -rik_data <- glatos::residence_index(cdata, - calculation_method = "kessel", - group_col = NULL -) -rit_data <- glatos::residence_index(cdata, - calculation_method = "timedelta", - group_col = NULL -) -riawo_data <- glatos::residence_index(cdata, - calculation_method = "aggregate_with_overlap", - group_col = NULL -) -riano_data <- glatos::residence_index(cdata, - calculation_method = "aggregate_no_overlap", - group_col = NULL -) - # define expected objects -blueshark_ri_kessel_data <- - structure(list( - days_detected = c( - 9, 9, 7, 8, 9, 3, 2, 10, 10, - 9, 7, 4, 2, 1, 2, 1, 2, 2, 2, 2, 10, 5, 3, 2, 3, 3, 3, 2, 2, - 4, 2, 2, 2, 2, 2, 1, 2, 2, 1, 1 - ), residency_index = c( - 0.818181818181818, - 0.818181818181818, 0.636363636363636, 0.727272727272727, 0.818181818181818, - 0.272727272727273, 0.181818181818182, 0.909090909090909, 0.909090909090909, - 0.818181818181818, 0.636363636363636, 0.363636363636364, 0.181818181818182, - 0.0909090909090909, 0.181818181818182, 0.0909090909090909, 0.181818181818182, - 0.181818181818182, 0.181818181818182, 0.181818181818182, 0.909090909090909, - 0.454545454545455, 0.272727272727273, 0.181818181818182, 0.272727272727273, - 0.272727272727273, 0.272727272727273, 0.181818181818182, 0.181818181818182, - 0.363636363636364, 0.181818181818182, 0.181818181818182, 0.181818181818182, - 0.181818181818182, 0.181818181818182, 0.0909090909090909, 0.181818181818182, - 0.181818181818182, 0.0909090909090909, 0.0909090909090909 - ), - location = c( - "HFX034", - "HFX035", "HFX047", "HFX046", "HFX043", "HFX053", "HFX054", "HFX041", - "HFX040", "HFX038(lost/found)", "HFX033", "HFX052", "HFX051", - "HFX062", "HFX063", "HFX060", "HFX059(lost/found)", "HFX057", - "HFX058", "HFX056", "HFX039", "HFX048", "HFX049", "HFX055", "HFX032", - "HFX031", "HFX030", "HFX029", "HFX028", "HFX024", "HFX023", "HFX050", - "HFX027", "HFX025", "HFX026", "HFX021", "HFX017", "HFX016", "HFX013", - "HFX014" - ), mean_latitude = c( - 44.28729, 44.28173, 44.2133, 44.21905, - 44.23626, 44.17948, 44.17387, 44.24714, 44.25293, 43.4, 44.29311, - 44.18508, 44.19071, 44.12893, 44.12289, 44.13981, 44.1, 44.15686, - 44.15139, 44.16265, 44.25865, 44.20696, 44.20203, 44.16814, 44.29906, - 44.30479, 44.3106, 44.31668, 44.32302, 44.34509, 44.35121, 44.19641, - 44.32771, 44.33924, 44.33408, 44.36267, 44.3855, 44.39144, 44.40863, - 44.403 - ), mean_longitude = c( - -63.31992, -63.3131, -63.23715, -63.24336, - -63.26195, -63.20007, -63.19376, -63.27502, -63.28102, -65.6, - -63.32598, -63.20632, -63.21268, -63.14374, -63.13765, -63.15623, - -63.3, -63.17499, -63.16853, -63.18116, -63.28784, -63.23135, - -63.2246, -63.18762, -63.33237, -63.33867, -63.34534, -63.35154, - -63.36093, -63.38422, -63.39103, -63.21911, -63.36478, -63.37781, - -63.3713, -63.40261, -63.42997, -63.43603, -63.45589, -63.44875 - ) - ), class = "data.frame", row.names = c(NA, -40L)) - -blueshark_ri_td_data <- - structure(list(days_detected = c( - 0, 0.0119907407407407, 0.229189814814815, - 0.236770833333333, 0, 0.0171296296296296, 5.30424768518519, 4.31056712962963, - 4.33679398148148, 0.132662037037037, 0.374652777777778, 0.417314814814815, - 1.61196759259259, 2.45387731481481, 2.45918981481482, 7.69414351851852, - 9.8066087962963, 9.83518518518519, 10.2265046296296, 9.73806712962963, - 9.64605324074074, 10.383599537037, 10.0781134259259, 8.96850694444444, - 8.33770833333333, 7.58980324074074, 7.56431712962963, 2.16046296296296, - 0.714791666666667, 7.77197916666667, 7.0502662037037, 7.26163194444444, - 7.20189814814815, 7.28798611111111, 7.31960648148148, 7.31309027777778, - 7.33803240740741, 0.0037037037037037, 0.029212962962963, 1.98929398148148 - ), total_days = c( - 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556, 10.6743055555556, 10.6743055555556, 10.6743055555556, - 10.6743055555556 - ), residency_index = c( - 0, 0.0011233274781515, - 0.0214711686509227, 0.0221813805217618, 0, 0.00160475354021642, - 0.496917355192679, 0.40382646975907, 0.406283477544293, 0.0124281655932167, - 0.0350985622275714, 0.0390952659770564, 0.151013813891961, 0.229886366100666, - 0.230384056556719, 0.72080974996205, 0.91871164313751, 0.921388762388047, - 0.958048706438531, 0.912290460390779, 0.903670331576779, 0.972765814412422, - 0.94414698674994, 0.840195823303624, 0.781100774185154, 0.711034849174853, - 0.708647236137315, 0.202398455966864, 0.0669637629301932, 0.728101619933641, - 0.660489449829766, 0.680290807364518, 0.674694771539479, 0.682759742371999, - 0.685722030663804, 0.685111573742762, 0.687448225012469, 0.000346973738425173, - 0.00273675536182855, 0.186362847786958 - ), location = c( - "HFX013", - "HFX014", "HFX016", "HFX017", "HFX021", "HFX023", "HFX024", "HFX025", - "HFX026", "HFX027", "HFX028", "HFX029", "HFX030", "HFX031", "HFX032", - "HFX033", "HFX034", "HFX035", "HFX038(lost/found)", "HFX039", - "HFX040", "HFX041", "HFX043", "HFX046", "HFX047", "HFX048", "HFX049", - "HFX050", "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", "HFX056", - "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", "HFX062", - "HFX063" - ), mean_latitude = c( - 44.40863, 44.403, 44.39144, 44.3855, - 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, 44.32771, 44.32302, - 44.31668, 44.3106, 44.30479, 44.29906, 44.29311, 44.28729, 44.28173, - 43.4, 44.25865, 44.25293, 44.24714, 44.23626, 44.21905, 44.2133, - 44.20696, 44.20203, 44.19641, 44.19071, 44.18508, 44.17948, 44.17387, - 44.16814, 44.16265, 44.15686, 44.15139, 44.1, 44.13981, 44.12893, - 44.12289 - ), mean_longitude = c( - -63.45589, -63.44875, -63.43603, - -63.42997, -63.40261, -63.39103, -63.38422, -63.37781, -63.3713, - -63.36478, -63.36093, -63.35154, -63.34534, -63.33867, -63.33237, - -63.32598, -63.31992, -63.3131, -65.6, -63.28784, -63.28102, - -63.27502, -63.26195, -63.24336, -63.23715, -63.23135, -63.2246, - -63.21911, -63.21268, -63.20632, -63.20007, -63.19376, -63.18762, - -63.18116, -63.17499, -63.16853, -63.3, -63.15623, -63.14374, - -63.13765 - )), class = "data.frame", row.names = c(NA, -40L)) - -blueshark_ri_awo_data <- - structure(list( - days_detected = c( - 1.15740740740741e-05, 0.0119907407407407, - 0.0194560185185185, 0.0268055555555556, 1.15740740740741e-05, - 0.00408564814814815, 0.0284259259259259, 0.0267708333333333, - 0.0147222222222222, 0.00701388888888889, 0.0450115740740741, - 0.0911342592592593, 0.0759027777777778, 0.0404050925925926, 0.0612847222222222, - 0.0534259259259259, 0.159791666666667, 0.209270833333333, 0.408425925925926, - 0.191180555555556, 0.209421296296296, 0.389039351851852, 0.572581018518519, - 0.262407407407407, 1.3865625, 0.0394097222222222, 0.0647106481481481, - 0.0103472222222222, 0.0173263888888889, 0.039837962962963, 0.0577199074074074, - 0.0722106481481481, 0.019212962962963, 2.31481481481481e-05, - 0.0226157407407407, 0.00652777777777778, 0.00385416666666667, - 0.0037037037037037, 0.0180555555555556, 0.0218865740740741 - ), - total_days = c( - 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852, 4.69258101851852, 4.69258101851852, 4.69258101851852, - 4.69258101851852 - ), residency_index = c( - 2.46646227915913e-06, - 0.00255525492120886, 0.0041461230912665, 0.00571232663853255, - 2.46646227915913e-06, 0.000870661184543174, 0.00605763135761483, - 0.00570492725169508, 0.00313734001909042, 0.00149467614117043, - 0.00959207180364987, 0.019420923986099, 0.0161750596267256, - 0.00861041981654453, 0.0130599177681476, 0.0113851898805986, - 0.034051978226071, 0.0445961044694763, 0.0870365209069675, - 0.0407410239271506, 0.0446281684791054, 0.082905196589376, - 0.122018355412281, 0.0559196327930959, 0.295479714580985, - 0.00839830406053685, 0.0137899906027787, 0.00220501727756827, - 0.00369229403190122, 0.00848956316486574, 0.0123002473861666, - 0.0153882581596738, 0.00409432738340416, 4.93292455831827e-06, - 0.00481946729347695, 0.00139108472544575, 0.000821331938959991, - 0.000789267929330923, 0.00384768115548825, 0.00466408016988992 - ), location = c( - "HFX013", "HFX014", "HFX016", "HFX017", "HFX021", - "HFX023", "HFX024", "HFX025", "HFX026", "HFX027", "HFX028", - "HFX029", "HFX030", "HFX031", "HFX032", "HFX033", "HFX034", - "HFX035", "HFX038(lost/found)", "HFX039", "HFX040", "HFX041", - "HFX043", "HFX046", "HFX047", "HFX048", "HFX049", "HFX050", - "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", "HFX056", - "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", "HFX062", - "HFX063" - ), mean_latitude = c( - 44.40863, 44.403, 44.39144, - 44.3855, 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, - 44.32771, 44.32302, 44.31668, 44.3106, 44.30479, 44.29906, - 44.29311, 44.28729, 44.28173, 43.4, 44.25865, 44.25293, 44.24714, - 44.23626, 44.21905, 44.2133, 44.20696, 44.20203, 44.19641, - 44.19071, 44.18508, 44.17948, 44.17387, 44.16814, 44.16265, - 44.15686, 44.15139, 44.1, 44.13981, 44.12893, 44.12289 - ), - mean_longitude = c( - -63.45589, -63.44875, -63.43603, -63.42997, - -63.40261, -63.39103, -63.38422, -63.37781, -63.3713, -63.36478, - -63.36093, -63.35154, -63.34534, -63.33867, -63.33237, -63.32598, - -63.31992, -63.3131, -65.6, -63.28784, -63.28102, -63.27502, - -63.26195, -63.24336, -63.23715, -63.23135, -63.2246, -63.21911, - -63.21268, -63.20632, -63.20007, -63.19376, -63.18762, -63.18116, - -63.17499, -63.16853, -63.3, -63.15623, -63.14374, -63.13765 - ) - ), class = "data.frame", row.names = c(NA, -40L)) - -blueshark_ri_ano_data <- - structure(list(days_detected = c( - 0, 0.0119907407407407, 0.0194328703703704, - 0.0267708333333333, 0, 0.00405092592592593, 0.0283449074074074, - 0.0266782407407407, 0.0146759259259259, 0.00700231481481481, - 0.0447916666666667, 0.0909027777777778, 0.0752199074074074, 0.0400578703703704, - 0.0607291666666667, 0.0529050925925926, 0.159155092592593, 0.208831018518519, - 0.406840277777778, 0.180983796296296, 0.20625, 0.388391203703704, - 0.565081018518519, 0.262349537037037, 1.3865162037037, 0.0392013888888889, - 0.0642708333333333, 0.0100115740740741, 0.0171990740740741, 0.0394097222222222, - 0.0570949074074074, 0.0702546296296296, 0.0190046296296296, 0, - 0.0225347222222222, 0.00640046296296296, 0.00375, 0.0037037037037037, - 0.0180324074074074, 0.0218518518518519 - ), total_days = c( - 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, 4.046875, - 4.046875, 4.046875, 4.046875, 4.046875 - ), residency_index = c( - 0, - 0.00296296296296296, 0.0048019448019448, 0.00661518661518662, - 0, 0.001001001001001, 0.007004147004147, 0.00659230659230659, - 0.00362648362648363, 0.00173030173030173, 0.0110682110682111, - 0.0224624624624625, 0.0185871585871586, 0.0098984698984699, 0.015006435006435, - 0.0130730730730731, 0.0393278993278993, 0.0516030316030316, 0.100531960531961, - 0.0447218647218647, 0.050965250965251, 0.095973115973116, 0.13963391963392, - 0.0648276848276848, 0.342614042614043, 0.00968682968682969, 0.0158815958815959, - 0.00247390247390247, 0.00424996424996425, 0.00973830973830974, - 0.0141083941083941, 0.0173602173602174, 0.0046961246961247, 0, - 0.00556842556842557, 0.00158158158158158, 0.000926640926640927, - 0.000915200915200915, 0.00445588445588446, 0.0053996853996854 - ), location = c( - "HFX013", "HFX014", "HFX016", "HFX017", "HFX021", - "HFX023", "HFX024", "HFX025", "HFX026", "HFX027", "HFX028", "HFX029", - "HFX030", "HFX031", "HFX032", "HFX033", "HFX034", "HFX035", "HFX038(lost/found)", - "HFX039", "HFX040", "HFX041", "HFX043", "HFX046", "HFX047", "HFX048", - "HFX049", "HFX050", "HFX051", "HFX052", "HFX053", "HFX054", "HFX055", - "HFX056", "HFX057", "HFX058", "HFX059(lost/found)", "HFX060", - "HFX062", "HFX063" - ), mean_latitude = c( - 44.40863, 44.403, 44.39144, - 44.3855, 44.36267, 44.35121, 44.34509, 44.33924, 44.33408, 44.32771, - 44.32302, 44.31668, 44.3106, 44.30479, 44.29906, 44.29311, 44.28729, - 44.28173, 43.4, 44.25865, 44.25293, 44.24714, 44.23626, 44.21905, - 44.2133, 44.20696, 44.20203, 44.19641, 44.19071, 44.18508, 44.17948, - 44.17387, 44.16814, 44.16265, 44.15686, 44.15139, 44.1, 44.13981, - 44.12893, 44.12289 - ), mean_longitude = c( - -63.45589, -63.44875, - -63.43603, -63.42997, -63.40261, -63.39103, -63.38422, -63.37781, - -63.3713, -63.36478, -63.36093, -63.35154, -63.34534, -63.33867, - -63.33237, -63.32598, -63.31992, -63.3131, -65.6, -63.28784, - -63.28102, -63.27502, -63.26195, -63.24336, -63.23715, -63.23135, - -63.2246, -63.21911, -63.21268, -63.20632, -63.20007, -63.19376, - -63.18762, -63.18116, -63.17499, -63.16853, -63.3, -63.15623, - -63.14374, -63.13765 - )), class = "data.frame", row.names = c( - NA, - -40L - )) # note that these are just checking RI values after sort for now since # structure of object returned by residence_index recently changed @@ -282,37 +7,100 @@ blueshark_ri_ano_data <- # Test using testthat library test_that("RI for Kessel method gives exepected result on blue sharks", { + bsd_file <- system.file( + "extdata", + "blue_shark_detections.csv", + package = "glatos" + ) + + data <- read_otn_detections(bsd_file) + cdata <- detection_events(data, location_col = "station") + + rik_data <- residence_index( + cdata, + calculation_method = "kessel", + group_col = NULL + ) + # Check if expected and actual results are the same expect_equal( sort(rik_data$residency_index), - sort(blueshark_ri_kessel_data$residency_index) + sort(blueshark_ri_kessel_data()$residency_index) ) }) # Test using testthat library test_that("RI for timedelta method gives exepected result on blue sharks", { + bsd_file <- system.file( + "extdata", + "blue_shark_detections.csv", + package = "glatos" + ) + + data <- read_otn_detections(bsd_file) + cdata <- detection_events(data, location_col = "station") + + rit_data <- residence_index( + cdata, + calculation_method = "timedelta", + group_col = NULL + ) + # Check if expected and actual results are the same expect_equal( sort(rit_data$residency_index), - sort(blueshark_ri_td_data$residency_index) + sort(blueshark_ri_td_data()$residency_index) ) }) # Test using testthat library test_that("RI for Aggregate With Overlap method gives exepected result on blue sharks", { + bsd_file <- system.file( + "extdata", + "blue_shark_detections.csv", + package = "glatos" + ) + + data <- read_otn_detections(bsd_file) + + cdata <- detection_events(data, location_col = "station") + + riawo_data <- residence_index( + cdata, + calculation_method = "aggregate_with_overlap", + group_col = NULL + ) + # Check if expected and actual results are the same expect_equal( sort(riawo_data$residency_index), - sort(blueshark_ri_awo_data$residency_index) + sort(blueshark_ri_awo_data()$residency_index) ) }) # Test using testthat library test_that("RI for Aggregate No Overlap method gives exepected result on blue sharks", { + bsd_file <- system.file( + "extdata", + "blue_shark_detections.csv", + package = "glatos" + ) + + data <- read_otn_detections(bsd_file) + + cdata <- detection_events(data, location_col = "station") + + + riano_data <- residence_index( + cdata, + calculation_method = "aggregate_no_overlap", + group_col = NULL + ) + # Check if expected and actual results are the same expect_equal( sort(riano_data$residency_index), - sort(blueshark_ri_ano_data$residency_index) + sort(blueshark_ri_ano_data()$residency_index) ) }) diff --git a/tests/testthat/test-transmit_along_path.r b/tests/testthat/test-transmit_along_path.r index 3a4d749c..22ce62ac 100644 --- a/tests/testthat/test-transmit_along_path.r +++ b/tests/testthat/test-transmit_along_path.r @@ -1,80 +1,161 @@ -context("Check transmit_along_path") +# Testing output matches desired format for each input +test_that("data.frame input, spatial output gives expected result", { + path_sp <- { + set.seed(30) + crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ) + } -# Spatial input -path_sf <- readRDS("../../inst/testdata/test-crw_in_polygon-path_spin_spout.RDS") + path_df <- as.data.frame(sf::st_coordinates(path_sp)) -# spatial output -set.seed(30) -tr_spin_spout <- transmit_along_path(path_sf, - vel = 5.0, - delayRng = c(600, 1800), - burstDur = 5.0 -) -# non-spatial output -set.seed(30) -tr_spin_dfout <- transmit_along_path(path_sf, - vel = 5.0, - delayRng = c(600, 1800), - burstDur = 5.0, - sp_out = FALSE -) + tr_dfin_spout <- { + set.seed(30) + transmit_along_path( + path_df, + vel = 5.0, + delayRng = c(600, 1800), + burstDur = 5.0, + colNames = list(x = "X", y = "Y"), + pathCRS = sf::st_crs(path_sp) + ) + } -# Non-spatial input -path_df <- as.data.frame(sf::st_coordinates(path_sf)) + expect_s3_class(tr_dfin_spout, c("sf", "data.frame"), exact = T) + expect_equal( + sf::st_crs(tr_dfin_spout)$proj4string, + "+proj=longlat +datum=WGS84 +no_defs" + ) -# spatial output -set.seed(30) -tr_dfin_spout <- transmit_along_path(path_df, - vel = 5.0, - delayRng = c(600, 1800), - burstDur = 5.0, - colNames = list(x = "X", y = "Y"), - pathCRS = sf::st_crs(path_sf) -) + expect_snapshot( + tr_dfin_spout + ) +}) -# non-spatial output -set.seed(30) -tr_dfin_dfout <- transmit_along_path(path_df, - vel = 5.0, - delayRng = c(600, 1800), - burstDur = 5.0, - colNames = list(x = "X", y = "Y"), - pathCRS = 4326, - sp_out = FALSE -) -# Expected results -tr_spin_spout_shouldBe <- readRDS("../../inst/testdata/test-transmit_along_path-tr_spin_spout.rds") +test_that("data.frame input, data.frame output gives expected result", { + path_sp <- { + set.seed(30) -tr_dfin_spout_shouldBe <- readRDS("../../inst/testdata/test-transmit_along_path-tr_dfin_spout.rds") + crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ) + } -tr_dfout_shouldBe <- data.frame( - x = sf::st_coordinates(tr_spin_spout_shouldBe)[, "X"], - y = sf::st_coordinates(tr_spin_spout_shouldBe)[, "Y"], - time = tr_spin_spout_shouldBe$time, - row.names = NULL -) + path_df <- as.data.frame(sf::st_coordinates(path_sp)) + + tr_dfin_dfout <- { + set.seed(30) + + transmit_along_path( + path_df, + vel = 5.0, + delayRng = c(600, 1800), + burstDur = 5.0, + colNames = list(x = "X", y = "Y"), + pathCRS = 4326, + sp_out = FALSE + ) + } + + expect_s3_class(tr_dfin_dfout, "data.frame", exact = T) -# Testing output matches desired format for each input -test_that("data.frame input, spatial output gives expected result", { - # Check if expected and actual results are the same - expect_equal(tr_dfin_spout, tr_dfin_spout_shouldBe) -}) -test_that("data.frame input, data.frame output gives expected result", { # Check if expected and actual results are the same - expect_equal(tr_dfin_dfout, tr_dfout_shouldBe) + expect_snapshot( + tr_dfin_dfout + ) }) + + + + test_that("spatial input, data.frame output gives expected result", { + path_sp <- { + set.seed(30) + + crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ) + } + + tr_spin_dfout <- { + set.seed(30) + + transmit_along_path( + path_sp, + vel = 5.0, + delayRng = c(600, 1800), + burstDur = 5.0, + sp_out = FALSE + ) + } # Check if expected and actual results are the same - expect_equal(tr_spin_dfout, tr_dfout_shouldBe) + expect_s3_class(tr_spin_dfout, "data.frame", exact = T) + + expect_snapshot( + tr_spin_dfout + ) }) + + + + test_that("spatial input, spatial output gives expected result", { + path_sp <- { + set.seed(30) + + crw_in_polygon( + greatLakesPoly, + theta = c(0, 25), stepLen = 10000, + initPos = c(-87.49017, 48.42314), initHeading = 0, + nsteps = 5, + sp_out = TRUE, + cartesianCRS = 3175, show_progress = FALSE + ) + } + + tr_spin_spout <- { + set.seed(30) + + transmit_along_path( + path_sp, + vel = 5.0, + delayRng = c(600, 1800), + burstDur = 5.0 + ) + } + + + expect_s3_class(tr_spin_spout, c("sf", "data.frame"), exact = T) + + expect_equal( + sf::st_crs(tr_spin_spout)$proj4string, + "+proj=longlat +datum=WGS84 +no_defs" + ) + # Check if expected and actual results are the same - expect_equal(tr_spin_spout, tr_spin_spout_shouldBe) + expect_snapshot( + tr_spin_spout + ) }) diff --git a/tests/testthat/test-vrl2csv.r b/tests/testthat/test-vrl2csv.r index 2ef83005..b7d0ef62 100644 --- a/tests/testthat/test-vrl2csv.r +++ b/tests/testthat/test-vrl2csv.r @@ -1,91 +1,221 @@ -context("Check vrl2csv") - +vrl_to_tempdir <- function(test_dir) { + ## Access internal VRL + myVRL <- system.file( + "extdata", + "detection_files_raw", + "VR2W_109924_20110718_1.vrl", + package = "glatos" + ) -## Access internal VRL -myVRL <- system.file("extdata", "detection_files_raw", - "VR2W_109924_20110718_1.vrl", - package = "glatos" -) + ## Create temp_dir + test_dir <- file.path(tempdir(), test_dir) + if (!dir.exists(test_dir)) dir.create(test_dir) -## Create temp_dir with spaces in the file path -test_dir <- file.path(tempdir(), "test") -if (!dir.exists(test_dir)) dir.create(test_dir) + ## Copy internal VRL to test_dir + good_vrl <- file.path(test_dir, basename(myVRL)) + copied <- file.copy(myVRL, good_vrl) -## Copy internal VRL to test_dir -good_vrl <- file.path(test_dir, basename(myVRL)) -file.copy(myVRL, good_vrl) + list( + test_dir = test_dir, + vrl = good_vrl + ) +} -## Run vrl2csv -good_csv <- vrl2csv(good_vrl, - outDir = test_dir, - vueExePath = "C:/Program Files (x86)/VEMCO/VUE" -) -## Get first 10 lines -csv_f10 <- readLines(good_csv, n = 10) +# Check csv from one VRL in dir with space in name +test_that("one vrl gives expected result", { + skip_on_ci() + skip_on_cran() + + vrl_loc <- vrl_to_tempdir("test") + + # Warns re: deprecation + expect_warning( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ), + "'vrl2csv' is deprecated\\." + ) -csv_f10_shouldBe <- - c( - "Date and Time (UTC),Receiver,Transmitter,Transmitter Name,Transmitter Serial,Sensor Value,Sensor Unit,Station Name,Latitude,Longitude,Transmitter Type,Sensor Precision", - "2011-04-11 20:17:49,VR2W-109924,A69-1303-63366,,,,,,+0,+0", - "2011-05-08 05:38:32,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0", - "2011-05-08 05:41:09,VR2W-109924,A69-9002-4043,,,7,ADC,,+0,+0", - "2011-05-08 05:43:14,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0", - "2011-05-08 05:44:15,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0", - "2011-05-08 05:45:59,VR2W-109924,A69-9002-4043,,,16,ADC,,+0,+0", - "2011-05-08 05:46:36,VR2W-109924,A69-9002-4043,,,5,ADC,,+0,+0", - "2011-05-08 05:48:07,VR2W-109924,A69-9002-4043,,,6,ADC,,+0,+0", - "2011-05-08 05:48:31,VR2W-109924,A69-9002-4043,,,4,ADC,,+0,+0" + # invisibly returns file path + expect_invisible( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ) + ) + expect_equal( + normalizePath(dirname(good_csv)), + normalizePath(vrl_loc$test_dir) + ) + expect_equal( + basename(good_csv), + gsub( + "\\.vrl", "\\.csv", + basename(vrl_loc$vrl) + ) ) -## Delete the CSV that was just made -file.remove(good_csv) + # Creates message + expect_message( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ), + "Converting 1 detection files\\.\\.\\." + ) + # Outputs progress bar + expect_output( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ), + "\\|======================================================================\\| 100%" + ) -# Check csv from one VRL in dir with space in name -test_that("one vrl in dir with space in name gives expected result", { # Check if expected and actual results are the same - expect_equal(csv_f10, csv_f10_shouldBe) -}) + expect_snapshot( + readLines(good_csv, n = 10) + ) + # Clean up + unlink( + vrl_loc$test_dir, + recursive = TRUE + ) +}) -## Make an extra VRL to show behavior if one of group of VRLs is not encoded -corrupt_vrl <- file.path(test_dir, "corrupt.vrl") -file.copy(myVRL, corrupt_vrl) -## Corrupt one of the VRLs -write(c("SOMEgibberish"), corrupt_vrl) -## Try to import -msg <- tryCatch( - vrl2csv(c(corrupt_vrl, good_vrl), - outDir = test_dir, - vueExePath = "C:/Program Files (x86)/VEMCO/VUE" - ), - warning = function(w) w$message -) +test_that("one vrl in dir with space in name gives expected result", { + skip_on_ci() + skip_on_cran() + + vrl_loc <- vrl_to_tempdir("test path with spaces") + + # Warns re: deprecation. Deprecation warnings are suppressed after this + expect_warning( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ), + "'vrl2csv' is deprecated\\." + ) -## Get first 10 lines -csv2_f10 <- readLines(good_csv, n = 10) + expect_invisible( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ) + ) + expect_equal( + normalizePath(dirname(good_csv)), + normalizePath(vrl_loc$test_dir) + ) + expect_equal( + basename(good_csv), + gsub( + "\\.vrl", "\\.csv", + basename(vrl_loc$vrl) + ) + ) + # Creates message + expect_message( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ), + "Converting 1 detection files\\.\\.\\." + ) -# Delete temp_dir -unlink(test_dir, recursive = TRUE) + # Outputs progress bar + expect_output( + suppressWarnings( + good_csv <- vrl2csv( + vrl_loc$vrl, + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ) + ), + "\\|======================================================================\\| 100%" + ) -# Check csv from batch with corrupted VRL in dir with space in name -test_that("one good vrl in dir with corrupt vrl gives expected result", { # Check if expected and actual results are the same - expect_equal(csv2_f10, csv_f10_shouldBe) + expect_snapshot( + readLines(good_csv, n = 10) + ) + + # Clean up + unlink( + vrl_loc$test_dir, + recursive = TRUE + ) }) -# Check warning msg when corrupted vrl -msg_shouldBe <- "corrupt.csv was not created." -test_that("warning with corrupt vrl gives expected result", { + +test_that("one good vrl in dir with corrupt vrl gives expected result", { + skip_on_ci() + skip_on_cran() + + ## Create corrupt VRL + vrl_loc <- vrl_to_tempdir("test") + + renamed <- file.rename( + vrl_loc$vrl, + file.path(vrl_loc$test_dir, "corrupt.vrl") + ) + + write( + c("SOMEgibberish"), + file.path(vrl_loc$test_dir, "corrupt.vrl") + ) + + vrl_loc <- vrl_to_tempdir("test") + + + expect_warning( + out_csv <- vrl2csv( + list.files(vrl_loc$test_dir, full.names = T), + outDir = vrl_loc$test_dir, + vueExePath = "C:/Program Files (x86)/VEMCO/VUE" + ), + "deprecated" + ) |> + expect_warning("corrupt\\.csv was not created") + # Check if expected and actual results are the same - expect_equal(msg, msg_shouldBe) + expect_snapshot( + readLines(out_csv, n = 10) + ) + + # Clean up + unlink( + vrl_loc$test_dir, + recursive = TRUE + ) }) diff --git a/tests/testthat/testdata/transmit_along_path-tr_dfin_spout.rds b/tests/testthat/testdata/transmit_along_path-tr_dfin_spout.rds new file mode 100644 index 00000000..ddb9ab96 Binary files /dev/null and b/tests/testthat/testdata/transmit_along_path-tr_dfin_spout.rds differ