Skip to content

Commit

Permalink
fix dplyr namespace
Browse files Browse the repository at this point in the history
  • Loading branch information
@chrisholbrook
chrisholbrook committed Aug 30, 2024
2 parents a859b88 + 52e15ba commit c6a10d1
Show file tree
Hide file tree
Showing 8 changed files with 246 additions and 256 deletions.
56 changes: 27 additions & 29 deletions R/sim-crw_in_polygon.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -177,17 +177,16 @@
#'
#' @export

crw_in_polygon <- function(polyg,
theta = c(0, 10),
crw_in_polygon <- function(polyg,
theta = c(0, 10),
stepLen = 100,
initPos = c(NA, NA),
initHeading = NA,
initPos = c(NA, NA),
initHeading = NA,
nsteps = 30,
inputCRS = NA,
cartesianCRS = NA,
inputCRS = NA,
cartesianCRS = NA,
sp_out = TRUE,
show_progress = TRUE) {

# Check input class
if (!inherits(polyg, c(
"data.frame", "sf", "sfc", "SpatialPolygonsDataFrame",
Expand Down Expand Up @@ -429,44 +428,43 @@ crw_in_polygon <- function(polyg,
#' @description Internal function used in [crw_in_polygon()] to determine if
#' (and identify which) line segments cross polygon boundaries (e.g., steps
#' onto land or over a peninsula).
#'
#' @returns A logical vector with an element for each 'step' in `path` that
#'
#' @returns A logical vector with an element for each 'step' in `path` that
#' indicates if that step crosses `boundary` (TRUE) or not (FALSE).
#'
#' @examples
#'
#'
#' # Example 1
#'
#'
#' # make path
#' path <- matrix(c(0:6, rep(3, 7)), ncol = 2)
#'
#'
#' # make polygon
#' poly <- matrix(c(0,0, 6,0, 3,6, 0,0), ncol = 2, byrow = TRUE)
#'
#' poly <- matrix(c(0, 0, 6, 0, 3, 6, 0, 0), ncol = 2, byrow = TRUE)
#'
#' plot(poly, type = "l")
#' lines(path, type = "o", col = "red")
#'
#'
#' poly <- sf::st_linestring(poly)
#'
#'
#' crosses_boundary(path, poly)
#'
#' #Example 2
#'
#'
#' # Example 2
#'
#' # make path
#' path <- matrix(c(0,1,5,6, rep(3, 4)), ncol = 2)
#'
#' path <- matrix(c(0, 1, 5, 6, rep(3, 4)), ncol = 2)
#'
#' # make polygon
#' poly <- matrix(c(0,0, 6,0, 3,6, 0,0), ncol = 2, byrow = TRUE)
#'
#' poly <- matrix(c(0, 0, 6, 0, 3, 6, 0, 0), ncol = 2, byrow = TRUE)
#'
#' plot(poly, type = "l")
#' lines(path, type = "o", col = "red")
#'
#'
#' poly <- sf::st_linestring(poly)
#'
#'
#' crosses_boundary(path, poly)
#'
#'
crosses_boundary <- function(path, boundary) {

# Make line segment objects of sequential point-pairs in path
segs_mat <- cbind(
utils::head(path, -1),
Expand All @@ -478,8 +476,8 @@ crosses_boundary <- function(path, boundary) {
apply(segs_mat, 1,
function(x) {
any(sf::st_intersects(boundary,
sf::st_linestring(rbind(x[1:2], x[3:4])),
sparse = FALSE
sf::st_linestring(rbind(x[1:2], x[3:4])),
sparse = FALSE
))
},
simplify = TRUE
Expand Down
2 changes: 1 addition & 1 deletion R/vis-make_transition.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@
#'
#' @details Note that this function underwent breaking changes between 0.7.3 and
#' 0.8.0 (uses `jasterize` instead of `gdalUtilities::gdal_rasterize` see
#' NEWS).
#' NEWS).
#'
#' @return A list with two elements:
#' \describe{
Expand Down
91 changes: 52 additions & 39 deletions tests/testthat/helper-make-test-data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -674,49 +674,62 @@ blueshark_ri_ano_data <- function() {

# 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))
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))
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))


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)
)
26 changes: 14 additions & 12 deletions tests/testthat/test-crw_in_polygon.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,24 +143,26 @@ test_that("sf input, sf output gives expected result", {
##### TEST NON-EXPORTED FUNCTIONS ####

test_that("internal function crosses_boundary gives expected result", {

# crosses one boundary (inside poly to outside poly)
expect_type(
x <- crosses_boundary(
matrix(c(0:6, rep(3, 7)), ncol = 2),
sf::st_linestring(matrix(c(0,0, 6,0, 3,6, 0,0), ncol = 2, byrow = TRUE))),
"logical")

sf::st_linestring(matrix(c(0, 0, 6, 0, 3, 6, 0, 0), ncol = 2, byrow = TRUE))
),
"logical"
)

expect_equal(x, c(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE))


# crosses two boundaries (skips 'peninsula'; inside poly to inside poly)
expect_type(
x2 <- crosses_boundary(
matrix(c(0,1,5,6, rep(3, 4)), ncol = 2),
sf::st_linestring(matrix(c(0,0, 6,0, 3,6, 0,0), ncol = 2, byrow = TRUE))),
"logical")

expect_equal(x2, c(FALSE, TRUE, FALSE))

matrix(c(0, 1, 5, 6, rep(3, 4)), ncol = 2),
sf::st_linestring(matrix(c(0, 0, 6, 0, 3, 6, 0, 0), ncol = 2, byrow = TRUE))
),
"logical"
)

expect_equal(x2, c(FALSE, TRUE, FALSE))
})
Loading

0 comments on commit c6a10d1

Please sign in to comment.