From 194d51b8d6b596eaecd5ebdc939037448f39a8ad Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 17 Mar 2024 11:45:55 -0700 Subject: [PATCH] Avoid using equality checks / %in% on class() --- R/otp-connect.R | 12 ++++++------ R/otp-plan.R | 6 +++--- R/otp-setup.R | 2 +- R/otp-surface.R | 2 +- R/utility-functions.R | 6 ++++++ tests/testthat/test_01_internal_funcs.R | 12 ++++++------ tests/testthat/test_02_without_OTP.R | 4 ++-- 7 files changed, 25 insertions(+), 19 deletions(-) diff --git a/R/otp-connect.R b/R/otp-connect.R index 21a5c9f..0c59d6e 100644 --- a/R/otp-connect.R +++ b/R/otp-connect.R @@ -106,8 +106,8 @@ otp_connect <- function(hostname = "localhost", #' @noRd #' make_url <- function(x, type = "routers") { - if(!"otpconnect" %in% class(x)){ - stop("Object is not of class otpconnect, class is ", class(x)) + if (!is_otpconnect(x)) { + stop("Object is not of class otpconnect, class is ", toString(class(x))) } if(type == "routers"){ @@ -167,8 +167,8 @@ make_url <- function(x, type = "routers") { #' @noRd #' check_router <- function(x) { - if(!"otpconnect" %in% class(x)){ - stop("Object is not of class otpconnect, class is ", class(x)) + if (!is_otpconnect(x)) { + stop("Object is not of class otpconnect, class is ", toString(class(x))) } check <- try(curl::curl_fetch_memory(make_url(x)), silent = TRUE) if (inherits(check, "try-error")) { @@ -184,8 +184,8 @@ check_router <- function(x) { #' @noRd #' check_routers <- function(otpcon) { - if(!"otpconnect" %in% class(otpcon)){ - stop("Object is not of class otpconnect, class is ", class(otpcon)) + if (!is_otpconnect(otpcon)) { + stop("Object is not of class otpconnect, class is ", toString(class(otpcon))) } if (is.null(otpcon$url)) { diff --git a/R/otp-plan.R b/R/otp-plan.R index d0f4748..c649b6c 100644 --- a/R/otp-plan.R +++ b/R/otp-plan.R @@ -424,12 +424,12 @@ otp_parse_missing <- function(x){ otp_clean_input <- function(imp, imp_name) { # For single point inputs - if (all(class(imp) == "numeric")) { + if (!is.matrix(imp) && is.double(imp)) { checkmate::assert_numeric(imp, len = 2) imp <- matrix(imp, nrow = 1, byrow = TRUE) } # For SF inputs - if ("sf" %in% class(imp)) { + if (inherits(imp, "sf")) { if (all(sf::st_geometry_type(imp) == "POINT")) { imp <- sf::st_coordinates(imp) imp[] <- imp[, c(1, 2)] @@ -440,7 +440,7 @@ otp_clean_input <- function(imp, imp_name) { # For matrix inputs # if (all(class(imp) == "matrix")) { # to pass CRAN checks - if ("matrix" %in% class(imp)) { + if (is.matrix(imp)) { checkmate::assert_matrix(imp, any.missing = FALSE, min.rows = 1, diff --git a/R/otp-setup.R b/R/otp-setup.R index cbd758f..bdded7e 100644 --- a/R/otp-setup.R +++ b/R/otp-setup.R @@ -345,7 +345,7 @@ otp_setup <- function(otp = NULL, check = TRUE ), silent = TRUE) - if ("otpconnect" %in% class(otpcon)) { + if (is_otpconnect(otpcon)) { message(paste0( Sys.time(), " OTP is ready to use Go to localhost:", diff --git a/R/otp-surface.R b/R/otp-surface.R index a8511b2..37fed22 100644 --- a/R/otp-surface.R +++ b/R/otp-surface.R @@ -266,7 +266,7 @@ otp_pointset <- function(points = NULL, name = NULL, dir = NULL) { - if(!"sf" %in% class(points)){ + if (!inherits(point, "sf")) { stop("points is not an sf object") } diff --git a/R/utility-functions.R b/R/utility-functions.R index 6a5d769..4118712 100644 --- a/R/utility-functions.R +++ b/R/utility-functions.R @@ -122,3 +122,9 @@ split_alternating <- function(x){ check.names = FALSE, check.rows = FALSE)) } + +#' Check for 'otpconnect' class +#' @param x An object. +#' @family internal +#' @noRd +is_otpconnect <- function(x) inherits(x, "otpconnect") diff --git a/tests/testthat/test_01_internal_funcs.R b/tests/testthat/test_01_internal_funcs.R index c4ab7df..722c693 100644 --- a/tests/testthat/test_01_internal_funcs.R +++ b/tests/testthat/test_01_internal_funcs.R @@ -52,7 +52,7 @@ test_that("test otp_json2sf", { r1 <- otp_json2sf(itineraries = r1, fp = "", tp = "", get_elevation = FALSE) - expect_true("data.frame" %in% class(r1)) + expect_s3_class(r1, "data.frame") expect_true(nrow(r1) == 1) @@ -63,7 +63,7 @@ test_that("test otp_json2sf", { r2 <- otp_json2sf(r2, fp = "", tp = "", get_geometry = FALSE) - expect_true("data.frame" %in% class(r2)) + expect_s3_class(r2, "data.frame") expect_true(nrow(r2) == 1) @@ -73,7 +73,7 @@ test_that("test otp_json2sf", { r4 <- otp_json2sf(itineraries = r4, fp = "", tp = "") - expect_true("data.frame" %in% class(r4)) + expect_s3_class(r4, "data.frame") expect_true(nrow(r4) == 9) }) @@ -88,10 +88,10 @@ test_that("get elevations", { get_geometry = TRUE, full_elevation = TRUE ) - expect_true("data.frame" %in% class(r3)) + expect_s3_class(r3, "data.frame") expect_true(nrow(r3) == 1) expect_true("leg_elevation" %in% names(r3)) - expect_true(class(r3$leg_elevation) == "list") + expect_true(is.list(r3$leg_elevation)) }) @@ -159,7 +159,7 @@ test_that("test polyline2linestring", { test_that("test otp_check_java", { suppressWarnings(r1 <- otp_check_java()) - expect_true(class(r1) == "logical") + expect_type(r1, "logical") }) diff --git a/tests/testthat/test_02_without_OTP.R b/tests/testthat/test_02_without_OTP.R index 30cf1e6..18d96af 100644 --- a/tests/testthat/test_02_without_OTP.R +++ b/tests/testthat/test_02_without_OTP.R @@ -287,10 +287,10 @@ context("test routing options") test_that("otp_routing_options creation", { skip_on_cran() routingOptions <- otp_routing_options() - expect_true(class(routingOptions) == "list") + expect_true(is.list(routingOptions)) routingOptions$walkSpeed <- 999 routingOptions <- otp_validate_routing_options(routingOptions) - expect_true(class(routingOptions) == "list") + expect_true(is.list(routingOptions)) expect_true(length(routingOptions) == 1) })