Skip to content

Commit

Permalink
add tests for constructors; version up dev 0.8.0.9009
Browse files Browse the repository at this point in the history
  • Loading branch information
@chrisholbrook
chrisholbrook committed Aug 30, 2024
1 parent 01a4d65 commit 11f551d
Show file tree
Hide file tree
Showing 5 changed files with 528 additions and 2 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@ 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.9008
Date: 2024-08-28
Version: 0.8.0.9009
Date: 2024-08-29
Depends: R (>= 3.5.0)
Imports:
av,
Expand Down
49 changes: 49 additions & 0 deletions tests/testthat/helper-make-test-data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -671,3 +671,52 @@ blueshark_ri_ano_data <- function() {
-40L
))
}

# test-class-glatos_animals.R

ga_df_shouldbe <-
structure(list(
animal_id = c("120", "107", "109"),
tag_id_code = c("32024", "32012", "32014"),
tag_code_space = c("A69-9001", "A69-9001", "A69-9001"),
utc_release_date_time =
structure(c(1301270400, 1301270460, 1301270700),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
release_latitude = c(41.56093, 41.56093, 41.56093),
release_longitude = c(-83.645, -83.645, -83.645)),
class = c("glatos_animals", "data.frame"),
row.names = c(NA, -3L))


# test-class-glatos_detections.R

gd_df_shouldbe <-
structure(list(animal_id = c("153", "153", "153", "153"),
detection_timestamp_utc = structure(
c(1335664117, 1335664375, 1335664512, 1335664602),
class = c("POSIXct", "POSIXt"),
tzone = "UTC"),
deploy_lat = c(43.39165, 43.39165, 43.39165, 43.39165),
deploy_long = c(-83.99264, -83.99264, -83.99264, -83.99264)),
class = c("glatos_detections", "data.frame"),
row.names = c(NA, -4L))

# test-class-glatos_receivers.R

gr_df_shouldbe <-
structure(list(station = c("WHT-009", "FDT-001", "FDT-004", "FDT-003"),
deploy_lat = c(43.7, 45.9, 45.9, 45.9),
deploy_long = c(-82.5, -83.5, -83.5, -83.5),
deploy_date_time = structure(
c(1285178700, 1289574420, 1289576160, 1289577360),
class = c("POSIXct", "POSIXt"),
tzone = "UTC"),
recover_date_time = structure(
c(1345049520, 1337088300, 1337091300, 1337092800),
class = c("POSIXct", "POSIXt"),
tzone = "UTC"),
ins_serial_no = c("109450", "442", "441", "444")),
class = c("glatos_receivers", "data.frame"),
row.names = c(NA, -4L))


174 changes: 174 additions & 0 deletions tests/testthat/test-glatos_animals.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,174 @@
# R/class-glatos_animals.R


test_that("glatos_animals works as expected", {

# data.frame input

x <- data.frame(
animal_id = c("120", "107", "109"),
tag_id_code = c("32024", "32012", "32014"),
tag_code_space = c("A69-9001", "A69-9001", "A69-9001"),
utc_release_date_time = as.POSIXct(
c(
"2011-03-28 00:00:00",
"2011-03-28 00:01:00",
"2011-03-28 00:05:00"
),
tz = "UTC"
),
release_latitude = c(41.56093, 41.56093, 41.56093),
release_longitude = c(-83.645, -83.645, -83.645)
)

expect_equal(
ga_df <- glatos_animals(
animal_id = x$animal_id,
tag_id_code = x$tag_id_code,
tag_code_space = x$tag_code_space,
utc_release_date_time = x$utc_release_date_time,
release_latitude = x$release_latitude,
release_longitude = x$release_longitude
),
ga_df_shouldbe
)

expect_equal(
as_glatos_animals(x),
ga_df_shouldbe
)

expect_true(
validate_glatos_animals(x)
)

expect_true(
is_glatos_animals(ga_df)
)

expect_false(
is_glatos_animals(x)
)

# sf input

x_sf <- sf::st_as_sf(x,
coords = c("release_longitude", "release_latitude"),
remove = FALSE
)

expect_s3_class(
ga_sf <- as_glatos_animals(x_sf),
c("glatos_animals", "sf", "data.frame")
)

expect_equal(
sf::st_drop_geometry(ga_sf),
ga_df_shouldbe
)


# tibble input

x_tbl <- dplyr::as_tibble(x)

expect_s3_class(
ga_tbl <- as_glatos_animals(x_tbl),
c("tbl_df", "tbl", "data.frame")
)

expect_equal(
as.data.frame(ga_tbl),
as.data.frame(ga_df_shouldbe)
)

})



test_that("validate_glatos_animals catches bad inputs", {

# req_cols <- list(
# animal_id = "character",
# tag_id_code = "character",
# tag_code_space = "character",
# utc_release_date_time = "POSIXct"
# )

x <- data.frame(
animal_id = c("120", "107", "109"),
tag_id_code = c("32024", "32012", "32014"),
tag_code_space = c("A69-9001", "A69-9001", "A69-9001"),
utc_release_date_time = as.POSIXct(
c(
"2011-03-28 00:00:00",
"2011-03-28 00:01:00",
"2011-03-28 00:05:00"
),
tz = "UTC"
),
release_latitude = c(41.56093, 41.56093, 41.56093),
release_longitude = c(-83.645, -83.645, -83.645)
)

# data.frame input; missing column name
expect_error(
as_glatos_animals(dplyr::rename(x,
fish_name = animal_id,
release_timestamp = utc_release_date_time
)
),
regexp = "Required column(s) missing from input x",
fixed = TRUE
)

# # glatos_check_col_names
# expect_error(
# glatos_check_col_names(
# dplyr::rename(x,
# fish_name = animal_id,
# release_timestamp = utc_release_date_time
# ),
# req_cols
# ),
# regexp = "Required column(s) missing from input x",
# fixed = TRUE
# )


# data.frame input; wrong column class
expect_error(
as_glatos_animals(
plyr::mutate(x,
animal_id = as.integer(animal_id),
utc_release_date_time = as.character(utc_release_date_time)
)
),
regexp = "The following column(s) have wrong class",
fixed = TRUE
)

# # glatos_check_col_names
# expect_error(
# glatos_check_col_classes(
# plyr::mutate(x,
# animal_id = as.integer(animal_id),
# utc_release_date_time = as.character(utc_release_date_time)
# ),
# req_cols
# ),
# regexp = "The following column(s) have wrong class",
# fixed = TRUE
# )


# non-data.frame input
expect_error(
as_glatos_animals(
unclass(x)
),
regex = "Input x must inherit from data.frame",
fixed = TRUE
)

})
135 changes: 135 additions & 0 deletions tests/testthat/test-glatos_detections.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,135 @@
# R/class-glatos_detections.r

test_that("glatos_detections works as expected", {

# data.frame input

x <- data.frame(
animal_id = c("153", "153", "153", "153"),
detection_timestamp_utc = as.POSIXct(
c(
"2012-04-29 01:48:37",
"2012-04-29 01:52:55",
"2012-04-29 01:55:12",
"2012-04-29 01:56:42"
),
tz = "UTC"
),
deploy_lat = c(43.39165, 43.39165, 43.39165, 43.39165),
deploy_long = c(-83.99264, -83.99264, -83.99264, -83.99264)
)

expect_equal(
gd_df <- glatos_detections(
animal_id = x$animal_id,
detection_timestamp_utc =
x$detection_timestamp_utc,
deploy_lat = x$deploy_lat,
deploy_long = x$deploy_long
),
gd_df_shouldbe
)

expect_equal(
as_glatos_detections(x),
gd_df_shouldbe
)

expect_true(
validate_glatos_detections(x)
)

expect_true(
is_glatos_detections(gd_df)
)

expect_false(
is_glatos_detections(x)
)

# sf input

x_sf <- sf::st_as_sf(x,
coords = c("deploy_long", "deploy_lat"),
remove = FALSE
)

expect_s3_class(
gd_sf <- as_glatos_detections(x_sf),
c("glatos_detections", "sf", "data.frame")
)

expect_equal(
sf::st_drop_geometry(gd_sf),
gd_df_shouldbe
)


# tibble input

x_tbl <- dplyr::as_tibble(x)

expect_s3_class(
gd_tbl <- as_glatos_detections(x_tbl),
c("tbl_df", "tbl", "data.frame")
)

expect_equal(
as.data.frame(gd_tbl),
as.data.frame(gd_df_shouldbe)
)

})



test_that("validate_glatos_detections catches bad inputs", {

x <- data.frame(
animal_id = c("153", "153", "153", "153"),
detection_timestamp_utc = as.POSIXct(
c(
"2012-04-29 01:48:37",
"2012-04-29 01:52:55",
"2012-04-29 01:55:12",
"2012-04-29 01:56:42"
),
tz = "UTC"
),
deploy_lat = c(43.39165, 43.39165, 43.39165, 43.39165),
deploy_long = c(-83.99264, -83.99264, -83.99264, -83.99264)
)

# data.frame input; missing column name
expect_error(
as_glatos_detections(dplyr::rename(x,
fish_name = animal_id
)
),
regexp = "Required column(s) missing from input x",
fixed = TRUE
)


# data.frame input; wrong column class
expect_error(
as_glatos_detections(
plyr::mutate(x,
animal_id = as.integer(animal_id)
)
),
regexp = "The following column(s) have wrong class",
fixed = TRUE
)


# non-data.frame input
expect_error(
as_glatos_detections(
unclass(x)
),
regex = "Input x must inherit from data.frame",
fixed = TRUE
)

})
Loading

0 comments on commit 11f551d

Please sign in to comment.