diff --git a/DESCRIPTION b/DESCRIPTION index df0eff0..80a3dde 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: shar Title: Species-Habitat Associations -Version: 2.2.1 +Version: 2.3 Authors@R: c(person("Maximilian H.K.", "Hesselbarth", email = "mhk.hesselbarth@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1125-9918")), person("Marco", "Sciaini", email = "marco.sciaini@posteo.net", @@ -45,7 +45,7 @@ Suggests: rmarkdown, spatstat (>= 2.0-0), testthat (>= 3.0.0) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.0 VignetteBuilder: knitr Encoding: UTF-8 LazyData: true diff --git a/NEWS.md b/NEWS.md index 1457305..d29af70 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ +# shar 2.3 +* Improvements + * Option to return fitted parameters during `fit_point_process` + * Using `NA` instead of "NA" +* Various + * Iterations and stopping criterion are vectors instead of list during `reconstruct_algorithm` + # shar 2.2.1 * Improvements * Simplify roxygen2 docs diff --git a/R/fit_point_process.R b/R/fit_point_process.R index b05d72f..a75a131 100644 --- a/R/fit_point_process.R +++ b/R/fit_point_process.R @@ -6,6 +6,7 @@ #' @param n_random Integer with number of randomizations. #' @param process Character specifying which point process model to use. #' Either \code{"poisson"} or \code{"cluster"}. +#' @param return_para Logical if fitted parameters should be returned. #' @param return_input Logical if the original input data is returned. #' @param simplify Logical if only pattern will be returned if \code{n_random = 1} #' and \code{return_input = FALSE}. @@ -32,11 +33,8 @@ #' ecology. Chapman and Hall/CRC Press, Boca Raton. ISBN 978-1-4200-8254-8 #' #' @export -fit_point_process <- function(pattern, - n_random = 1, process = "poisson", - return_input = TRUE, - simplify = FALSE, - verbose = TRUE){ +fit_point_process <- function(pattern, n_random = 1, process = "poisson", return_para = FALSE, + return_input = TRUE, simplify = FALSE, verbose = TRUE){ # check if n_random is >= 1 if (!n_random >= 1) { @@ -45,8 +43,6 @@ fit_point_process <- function(pattern, } - iterations_list <- as.list(rep(NA, times = n_random)) - # unmark pattern if (spatstat.geom::is.marked(pattern)) { @@ -72,6 +68,16 @@ fit_point_process <- function(pattern, }) + # calc parameters + if (return_para) { + + number_points <- pattern$n + lambda <- spatstat.geom::intensity(pattern) + + param_vec <- c(number_points = number_points,lambda = lambda) + + } + } else if (process == "cluster") { # fit cluster process @@ -81,6 +87,18 @@ fit_point_process <- function(pattern, correction = "best"), method = "mincon", improve.type = "none") + # calc parameters + if (return_para) { + + number_parents <- fitted_process$clustpar[["kappa"]] * spatstat.geom::area(pattern$window) + number_points <- fitted_process$mu + cluster_area <- fitted_process$clustpar[["scale"]] ^ 2 * pi + + param_vec <- c(number_parents = number_parents, number_points = number_points, + cluster_area = cluster_area) + + } + result <- lapply(seq_len(n_random), function(x) { # simulate clustered pattern @@ -130,13 +148,20 @@ fit_point_process <- function(pattern, } + # set param to NA + if (!return_para) param_vec <- NA + # set names names(result) <- paste0("randomized_", seq_len(n_random)) # combine to one list - result <- list(randomized = result, observed = pattern, - method = "fit_point_process()", energy_df = "NA", - stop_criterion = "NA", iterations = iterations_list) + result <- list(randomized = result, observed = pattern, method = "fit_point_process()", + energy_df = NA, stop_criterion = NA, iterations = NA, param = param_vec) + + # add param + if (return_para) { + result$param <- param_vec + } # set class of result class(result) <- "rd_pat" @@ -145,7 +170,7 @@ fit_point_process <- function(pattern, if (!return_input) { # set observed to NA - result$observed <- "NA" + result$observed <- NA # check if output should be simplified if (simplify) { diff --git a/R/list_to_randomized.R b/R/list_to_randomized.R index a056577..b4f0c5a 100644 --- a/R/list_to_randomized.R +++ b/R/list_to_randomized.R @@ -64,20 +64,15 @@ list_to_randomized <- function(list, observed = NULL) { # return observed if present or NA if not if (is.null(observed)) { - observed <- "NA" + observed <- NA } # set names names(list) <- paste0("randomized_", seq_along(list)) - # create empty iterations list - iterations_list <- as.list(rep(NA, times = length(list))) - # combine to one list - result <- list(randomized = list, observed = observed, - method = "list_to_randomized()", energy_df = "NA", - stop_criterion = "NA", iterations = iterations_list) + result <- list(randomized = list, observed = observed, method = "list_to_randomized()") class(result) <- result_class diff --git a/R/plot_energy.R b/R/plot_energy.R index 7da0aec..4906ec9 100644 --- a/R/plot_energy.R +++ b/R/plot_energy.R @@ -39,7 +39,7 @@ plot_energy <- function(pattern, } - if (all(pattern$energy_df == "NA")) { + if (!is.list(pattern$energy_df)) { stop("There is no 'energy_df' slot. Please use pattern reconstruction for valid input data.", call. = FALSE) diff --git a/R/print.rd_mar.R b/R/print.rd_mar.R index dec49fc..5712c1b 100644 --- a/R/print.rd_mar.R +++ b/R/print.rd_mar.R @@ -33,7 +33,7 @@ print.rd_mar <- function(x, digits = 4, ...) { number_patterns_obs <- 0 - includes_observed <- "NA" + includes_observed <- NA # observed pattern is present } else { @@ -53,7 +53,7 @@ print.rd_mar <- function(x, digits = 4, ...) { number_patterns <- length(x$randomized) + number_patterns_obs # calculate mean iterations - mean_iterations <- round(mean(unlist(x$iterations)), digits = digits) + mean_iterations <- round(mean(x$iterations), digits = digits) # count stop criterions stop_criterion <- tryCatch(expr = table(do.call(c, x$stop_criterion), useNA = "ifany"), @@ -75,7 +75,7 @@ print.rd_mar <- function(x, digits = 4, ...) { } else { - mean_energy <- "NA" + mean_energy <- NA } diff --git a/R/print.rd_pat.R b/R/print.rd_pat.R index 1e7c17f..fc3f58c 100644 --- a/R/print.rd_pat.R +++ b/R/print.rd_pat.R @@ -36,7 +36,7 @@ print.rd_pat <- function(x, number_patterns_obs <- 0 - includes_observed <- "NA" + includes_observed <- NA # observed pattern is present } else { @@ -55,7 +55,7 @@ print.rd_pat <- function(x, number_patterns <- length(x$randomized) + number_patterns_obs # calculate mean iterations - mean_iterations <- round(mean(unlist(x$iterations)), digits = digits) + mean_iterations <- round(mean(x$iterations), digits = digits) # count stop criterions stop_criterion <- tryCatch(expr = table(do.call(c, x$stop_criterion), useNA = "ifany"), @@ -77,7 +77,7 @@ print.rd_pat <- function(x, } else { - mean_energy <- "NA" + mean_energy <- NA } diff --git a/R/print.rd_ras.R b/R/print.rd_ras.R index b32938e..42d0866 100644 --- a/R/print.rd_ras.R +++ b/R/print.rd_ras.R @@ -37,7 +37,7 @@ print.rd_ras <- function(x, ...) { number_raster_obs <- 0 - includes_observed <- "NA" + includes_observed <- NA # observed pattern is present } else { diff --git a/R/randomize_raster.R b/R/randomize_raster.R index 78ed912..11ef54c 100644 --- a/R/randomize_raster.R +++ b/R/randomize_raster.R @@ -193,7 +193,7 @@ randomize_raster <- function(raster, if (!return_input) { # set observed to NA - randomization$observed <- "NA" + randomization$observed <- NA # check if output should be simplified if (simplify) { diff --git a/R/reconstruct_algorithm.R b/R/reconstruct_algorithm.R index 269886e..310467e 100644 --- a/R/reconstruct_algorithm.R +++ b/R/reconstruct_algorithm.R @@ -24,19 +24,9 @@ #' @return list #' #' @keywords internal -reconstruct_algorithm <- function(pattern, - method, - n_random, - e_threshold, - max_runs, - no_change, - annealing, - weights, - r_length, - r_max, - stoyan, - verbose, - plot){ +reconstruct_algorithm <- function(pattern, method, n_random, e_threshold, max_runs, + no_change, annealing, weights, r_length, r_max, + stoyan, verbose, plot){ # check if n_random is >= 1 if (n_random < 1) { @@ -90,14 +80,14 @@ reconstruct_algorithm <- function(pattern, # create empty lists for results energy_list <- vector("list", length = n_random) - iterations_list <- vector("list", length = n_random) - stop_criterion_list <- as.list(rep("max_runs", times = n_random)) + iterations_vec <- vector(mode = "numeric", length = n_random) + stop_criterion_vec <- rep("max_runs", times = n_random) result_list <- vector("list", length = n_random) # set names names(energy_list) <- names_randomization - names(iterations_list) <- names_randomization - names(stop_criterion_list) <- names_randomization + names(iterations_vec) <- names_randomization + names(stop_criterion_vec) <- names_randomization names(result_list) <- names_randomization # calculate summary functions @@ -286,8 +276,8 @@ reconstruct_algorithm <- function(pattern, if (energy <= e_threshold || energy_counter > no_change) { # set stop criterion due to energy - stop_criterion_list[[i]] <- ifelse(test = energy <= e_threshold, - yes = "e_threshold", no = "no_change") + stop_criterion_vec[i] <- ifelse(test = energy <= e_threshold, + yes = "e_threshold", no = "no_change") break @@ -302,7 +292,7 @@ reconstruct_algorithm <- function(pattern, } # remove NAs if stopped due to energy - if (stop_criterion_list[[i]] %in% c("e_threshold", "no_change")) { + if (stop_criterion_vec[i] %in% c("e_threshold", "no_change")) { energy_df <- energy_df[1:j, ] @@ -310,7 +300,7 @@ reconstruct_algorithm <- function(pattern, # save results in lists energy_list[[i]] <- energy_df - iterations_list[[i]] <- j + iterations_vec[i] <- j result_list[[i]] <- simulated } @@ -321,8 +311,8 @@ reconstruct_algorithm <- function(pattern, # combine to one list reconstruction <- list(randomized = result_list, observed = pattern, method = method, energy_df = energy_list, - stop_criterion = stop_criterion_list, - iterations = iterations_list) + stop_criterion = stop_criterion_vec, + iterations = iterations_vec, param = NA) return(reconstruction) } diff --git a/R/reconstruct_pattern.R b/R/reconstruct_pattern.R index 07bc738..a0802e2 100644 --- a/R/reconstruct_pattern.R +++ b/R/reconstruct_pattern.R @@ -81,20 +81,11 @@ #' ecology. Chapman and Hall/CRC Press, Boca Raton. ISBN 978-1-4200-8254-8 #' #' @export -reconstruct_pattern <- function(pattern, method = "homo", - n_random = 1, - e_threshold = 0.01, - max_runs, - no_change = Inf, - annealing = 0.01, - weights = c(1, 1), - r_length = 255, - r_max = NULL, - stoyan = 0.15, - return_input = TRUE, - simplify = FALSE, - verbose = TRUE, - plot = FALSE) { +reconstruct_pattern <- function(pattern, method = "homo", n_random = 1, e_threshold = 0.01, + max_runs = 10000, no_change = Inf, annealing = 0.01, + weights = c(1, 1), r_length = 255, r_max = NULL, + stoyan = 0.15, return_input = TRUE, simplify = FALSE, + verbose = TRUE, plot = FALSE) { # check if correct method is selected if (!method %in% c("homo", "hetero", "cluster")) stop("Method must be one of the following: 'homo', 'hetero', or 'cluster'.", @@ -113,7 +104,7 @@ reconstruct_pattern <- function(pattern, method = "homo", if (!return_input) { # set observed to NA - reconstruction$observed <- "NA" + reconstruction$observed <- NA # check if output should be simplified if (simplify) { diff --git a/R/reconstruct_pattern_marks.R b/R/reconstruct_pattern_marks.R index badaa4c..bc7e144 100644 --- a/R/reconstruct_pattern_marks.R +++ b/R/reconstruct_pattern_marks.R @@ -112,14 +112,14 @@ reconstruct_pattern_marks <- function(pattern, # create empty lists for results energy_list <- vector("list", length = n_random) - iterations_list <- vector("list", length = n_random) - stop_criterion_list <- as.list(rep("max_runs", times = n_random)) + iterations_vec <- vector("numeric", length = n_random) + stop_criterion_vec <- rep("max_runs", times = n_random) result_list <- vector("list", length = n_random) # set names names(energy_list) <- names_randomization - names(iterations_list) <- names_randomization - names(stop_criterion_list) <- names_randomization + names(iterations_vec) <- names_randomization + names(stop_criterion_vec) <- names_randomization names(result_list) <- names_randomization # calculate summary functions @@ -238,8 +238,8 @@ reconstruct_pattern_marks <- function(pattern, if (energy <= e_threshold || energy_counter > no_change) { # set stop criterion due to energy - stop_criterion_list[[i]] <- ifelse(test = energy <= e_threshold, - yes = "e_threshold", no = "no_change") + stop_criterion_vec[i] <- ifelse(test = energy <= e_threshold, + yes = "e_threshold", no = "no_change") break @@ -253,7 +253,7 @@ reconstruct_pattern_marks <- function(pattern, } # remove NAs if stopped due to energy - if (stop_criterion_list[[i]] %in% c("e_threshold", "no_change")) { + if (stop_criterion_vec[i] %in% c("e_threshold", "no_change")) { energy_df <- energy_df[1:j, ] @@ -261,7 +261,7 @@ reconstruct_pattern_marks <- function(pattern, # save results in lists energy_list[[i]] <- energy_df - iterations_list[[i]] <- j + iterations_vec[i] <- j result_list[[i]] <- simulated } @@ -275,9 +275,8 @@ reconstruct_pattern_marks <- function(pattern, # combine to one list reconstruction <- list(randomized = result_list, observed = marked_pattern, - method = "marks", - energy_df = energy_list, stop_criterion = stop_criterion_list, - iterations = iterations_list) + method = "marks", energy_df = energy_list, + stop_criterion = stop_criterion_vec, iterations = iterations_vec) # set class of returning object class(reconstruction) <- "rd_mar" @@ -286,7 +285,7 @@ reconstruct_pattern_marks <- function(pattern, if (!return_input) { # set observed to NA - reconstruction$observed <- "NA" + reconstruction$observed <- NA # check if output should be simplified if (simplify) { diff --git a/R/translate_raster.R b/R/translate_raster.R index 04e1f93..4bc7b19 100644 --- a/R/translate_raster.R +++ b/R/translate_raster.R @@ -159,7 +159,7 @@ translate_raster <- function(raster, steps_x = NULL, steps_y = NULL, if (!return_input) { # set observed to NA - randomization$observed <- "NA" + randomization$observed <- NA # check if output should be simplified if (simplify) { diff --git a/codemeta.json b/codemeta.json index 6984ef7..88e97c6 100644 --- a/codemeta.json +++ b/codemeta.json @@ -7,7 +7,7 @@ "codeRepository": "https://r-spatialecology.github.io/shar/", "issueTracker": "https://github.com/r-spatialecology/shar/issues/", "license": "https://spdx.org/licenses/GPL-3.0", - "version": "2.2.1", + "version": "2.3", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", @@ -257,7 +257,7 @@ }, "SystemRequirements": null }, - "fileSize": "1078.108KB", + "fileSize": "1074.155KB", "citation": [ { "@type": "ScholarlyArticle", diff --git a/cran-comments.md b/cran-comments.md index f485724..1097709 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,5 +1,8 @@ For details changes, please see NEWS.md +# shar 2.3 +Adding new arguments + # shar 2.2.1 Minor improvements diff --git a/man/fit_point_process.Rd b/man/fit_point_process.Rd index a58e893..c96a435 100644 --- a/man/fit_point_process.Rd +++ b/man/fit_point_process.Rd @@ -8,6 +8,7 @@ fit_point_process( pattern, n_random = 1, process = "poisson", + return_para = FALSE, return_input = TRUE, simplify = FALSE, verbose = TRUE @@ -21,6 +22,8 @@ fit_point_process( \item{process}{Character specifying which point process model to use. Either \code{"poisson"} or \code{"cluster"}.} +\item{return_para}{Logical if fitted parameters should be returned.} + \item{return_input}{Logical if the original input data is returned.} \item{simplify}{Logical if only pattern will be returned if \code{n_random = 1} diff --git a/man/reconstruct_pattern.Rd b/man/reconstruct_pattern.Rd index 8237f86..0882402 100644 --- a/man/reconstruct_pattern.Rd +++ b/man/reconstruct_pattern.Rd @@ -9,7 +9,7 @@ reconstruct_pattern( method = "homo", n_random = 1, e_threshold = 0.01, - max_runs, + max_runs = 10000, no_change = Inf, annealing = 0.01, weights = c(1, 1), diff --git a/man/shar.Rd b/man/shar.Rd index 668db0d..a04117f 100644 --- a/man/shar.Rd +++ b/man/shar.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/shar-package.R \docType{package} \name{shar} -\alias{shar} \alias{shar-package} +\alias{shar} \title{Package description} \description{ Analyse species-habitat associations in R. Therefore, information about the diff --git a/tests/testthat/test-calculate_energy.R b/tests/testthat/test-calculate_energy.R index 8bb4755..63d0ae9 100644 --- a/tests/testthat/test-calculate_energy.R +++ b/tests/testthat/test-calculate_energy.R @@ -1,4 +1,4 @@ -# testthat::context("test-calculate_energy") +# context("test-calculate_energy") pattern_random_a <- fit_point_process(pattern = species_a, n_random = 3, verbose = FALSE) @@ -12,55 +12,60 @@ marks_recon <- reconstruct_pattern_marks(pattern_random_a$randomized[[1]], marks n_random = 3, max_runs = 10, verbose = FALSE) marks_recon_na <- marks_recon -marks_recon_na$energy_df <- "NA" +marks_recon_na$energy_df <- NA ################################################################################ -testthat::test_that("calculate_energy returns energy for all randomizations", { +test_that("calculate_energy returns energy for all randomizations", { + + expect_length(calculate_energy(pattern_random_a, verbose = FALSE), n = 3) - testthat::expect_length(calculate_energy(pattern_random_a, verbose = FALSE), n = 3) }) -testthat::test_that("calculate_energy uses weights", { +test_that("calculate_energy uses weights", { unweighted <- calculate_energy(pattern_random_a, return_mean = TRUE, verbose = FALSE) weighted <- calculate_energy(pattern_random_a, weights = c(0, 1), return_mean = TRUE, verbose = FALSE) - testthat::expect_false(unweighted == weighted) + expect_false(unweighted == weighted) + }) -testthat::test_that("calculate_energy returns mean ", { +test_that("calculate_energy returns mean ", { mean_energy <- mean(calculate_energy(pattern_random_a, verbose = FALSE)) - testthat::expect_equal(calculate_energy(pattern_random_a, return_mean = TRUE, + expect_equal(calculate_energy(pattern_random_a, return_mean = TRUE, verbose = FALSE), expected = mean_energy) + }) -testthat::test_that("calculate_energy returns works for reconstructed marks", { +test_that("calculate_energy returns works for reconstructed marks", { - testthat::expect_length(calculate_energy(marks_recon, verbose = FALSE), n = 3) + expect_length(calculate_energy(marks_recon, verbose = FALSE), n = 3) mean_energy <- mean(calculate_energy(marks_recon, verbose = FALSE)) - testthat::expect_equal(calculate_energy(marks_recon, return_mean = TRUE, - verbose = FALSE), expected = mean_energy) + expect_equal(calculate_energy(marks_recon, return_mean = TRUE, + verbose = FALSE), expected = mean_energy) - testthat::expect_length(calculate_energy(marks_recon_na, verbose = FALSE), n = 3) + expect_length(calculate_energy(marks_recon_na, verbose = FALSE), n = 3) - }) +}) + +test_that("calculate_energy returns error if observed not included", { -testthat::test_that("calculate_energy returns error if observed not included", { + expect_error(calculate_energy(pattern_random_b, verbose = FALSE), + regexp = "Input must include 'observed' pattern.") - testthat::expect_error(calculate_energy(pattern_random_b, verbose = FALSE), - regexp = "Input must include 'observed' pattern.") }) -testthat::test_that("calculate_energy returns error if wrong class ", { +test_that("calculate_energy returns error if wrong class ", { + + expect_error(calculate_energy(list(species_a, species_b), verbose = FALSE), + regexp = "Class of 'pattern' must be 'rd_pat' or 'rd_mar'.") - testthat::expect_error(calculate_energy(list(species_a, species_b), verbose = FALSE), - regexp = "Class of 'pattern' must be 'rd_pat' or 'rd_mar'.") }) diff --git a/tests/testthat/test-classify_habitats.R b/tests/testthat/test-classify_habitats.R index 20014e3..4400065 100644 --- a/tests/testthat/test-classify_habitats.R +++ b/tests/testthat/test-classify_habitats.R @@ -1,4 +1,4 @@ -# testthat::context("test-classify_habitats") +# context("test-classify_habitats") landscape_classified <- classify_habitats(raster = terra::rast(landscape), n = 5, style = "fisher") @@ -8,21 +8,23 @@ landscape_classified_brks <- classify_habitats(raster = terra::rast(landscape), ################################################################################ -testthat::test_that("classify_habitats returns n classes", { +test_that("classify_habitats returns n classes", { present_classes <- length(unique(terra::values(landscape_classified))) - testthat::expect_equal(present_classes, expected = 5) + expect_equal(present_classes, expected = 5) + }) -testthat::test_that("classify_habitats useses breaks and returns them", { +test_that("classify_habitats useses breaks and returns them", { - testthat::expect_type(object = landscape_classified_brks, type = "list") + expect_type(object = landscape_classified_brks, type = "list") - testthat::expect_equal(object = landscape_classified_brks$breaks$brks, - expected = c(0, 0.25, 0.75, 1.0)) + expect_equal(object = landscape_classified_brks$breaks$brks, + expected = c(0, 0.25, 0.75, 1.0)) present_classes <- length(unique(terra::values(landscape_classified_brks$raster))) - testthat::expect_equal(present_classes, expected = 3) + expect_equal(present_classes, expected = 3) + }) diff --git a/tests/testthat/test-classint_to_vector.R b/tests/testthat/test-classint_to_vector.R index e1d7061..cc907c7 100644 --- a/tests/testthat/test-classint_to_vector.R +++ b/tests/testthat/test-classint_to_vector.R @@ -1,12 +1,13 @@ -# testthat::context("test-classint_to_vector") +# context("test-classint_to_vector") x <- classInt::classIntervals(var = stats::runif(n = 100), style = "fisher", n = 5) ################################################################################ -testthat::test_that("classint_to_vector returns n breaks", { +test_that("classint_to_vector returns n breaks", { present_classes <- classint_to_vector(x = x, digits = 3) - testthat::expect_length(present_classes, n = 5) + expect_length(present_classes, n = 5) + }) diff --git a/tests/testthat/test-create_neighbourhood.R b/tests/testthat/test-create_neighbourhood.R index d4c308d..310cc7a 100644 --- a/tests/testthat/test-create_neighbourhood.R +++ b/tests/testthat/test-create_neighbourhood.R @@ -1,4 +1,4 @@ -# testthat::context("test-create_neighbourhood") +# context("test-create_neighbourhood") mat <- matrix(1, nrow = 10, ncol = 10) @@ -10,22 +10,25 @@ neighbourhood_8 <- create_neighbourhood(cell_id, mat, directions = 8) ################################################################################ -testthat::test_that("create_neighbourhood returns right dimension for directions = 4", { +test_that("create_neighbourhood returns right dimension for directions = 4", { - testthat::expect_equal(nrow(neighbourhood_4), expected = 7) # only 7 because one cell_id is at boundary + expect_equal(nrow(neighbourhood_4), expected = 7) # only 7 because one cell_id is at boundary + + expect_equal(ncol(neighbourhood_4), expected = 2) - testthat::expect_equal(ncol(neighbourhood_4), expected = 2) }) -testthat::test_that("create_neighbourhood returns right dimension for directions = 8", { +test_that("create_neighbourhood returns right dimension for directions = 8", { + + expect_equal(nrow(neighbourhood_8), expected = 13) # only 7 because one cell_id is at boundary - testthat::expect_equal(nrow(neighbourhood_8), expected = 13) # only 7 because one cell_id is at boundary + expect_equal(ncol(neighbourhood_8), expected = 2) - testthat::expect_equal(ncol(neighbourhood_8), expected = 2) }) -testthat::test_that("create_neighbourhood returns error", { +test_that("create_neighbourhood returns error", { + + expect_error(create_neighbourhood(cell_id, mat, directions = 12), + regexp = "'directions must be 'directions = 4' or 'directions = 8'.") - testthat::expect_error(create_neighbourhood(cell_id, mat, directions = 12), - regexp = "'directions must be 'directions = 4' or 'directions = 8'.") }) diff --git a/tests/testthat/test-extract_points.R b/tests/testthat/test-extract_points.R index 02f3422..0429518 100644 --- a/tests/testthat/test-extract_points.R +++ b/tests/testthat/test-extract_points.R @@ -1,4 +1,4 @@ -# testthat::context("test-extract_points") +# context("test-extract_points") landscape_classified <- classify_habitats(terra::rast(landscape), n = 5, style = "fisher") @@ -6,15 +6,16 @@ points_df <- extract_points(raster = landscape_classified, pattern = species_b) ################################################################################ -testthat::test_that("extract_points returns one row for each habitat", { +test_that("extract_points returns one row for each habitat", { + + expect_equal(nrow(points_df), expected = 5) - testthat::expect_equal(nrow(points_df), - expected = 5) }) -testthat::test_that("extract_points counts all points present in the landscape", { +test_that("extract_points counts all points present in the landscape", { extracted_points <- sum(points_df$count) - testthat::expect_equal(extracted_points, expected = species_b$n) + expect_equal(extracted_points, expected = species_b$n) + }) diff --git a/tests/testthat/test-fit-point_process.R b/tests/testthat/test-fit-point_process.R index 15233e7..0636f35 100644 --- a/tests/testthat/test-fit-point_process.R +++ b/tests/testthat/test-fit-point_process.R @@ -1,4 +1,4 @@ -# testthat::context("test-fit_point_process") +# context("test-fit_point_process") # normal pattern_random <- fit_point_process(pattern = species_b, n_random = 3, @@ -17,74 +17,90 @@ pattern_random_simple <- fit_point_process(pattern = species_a, n_random = 1, return_input = FALSE, simplify = TRUE, verbose = FALSE) +# return parameters +pattern_random_para_a <- fit_point_process(pattern = species_b, n_random = 3, + process = "poisson", return_para = TRUE, + verbose = FALSE) + +# return parameters +pattern_random_para_b <- fit_point_process(pattern = species_b, n_random = 3, + process = "cluster", return_para = TRUE, + verbose = FALSE) + ################################################################################ -testthat::test_that("Output is a long as n_random for fit_point_process", { +test_that("Output is a long as n_random for fit_point_process", { + + expect_length(pattern_random$randomized, n = 3) - testthat::expect_length(pattern_random$randomized, - n = 3) + expect_length(pattern_random_cluster$randomized, n = 3) - testthat::expect_length(pattern_random_cluster$randomized, - n = 3) }) -testthat::test_that("Output includes randomizations and original pattern for fit_point_process", { +test_that("Output includes randomizations and original pattern for fit_point_process", { - testthat::expect_named(pattern_random$randomized, - expected = paste0("randomized_", 1:3)) + expect_named(pattern_random$randomized, expected = paste0("randomized_", 1:3)) - testthat::expect_equal(pattern_random$observed, - expected = spatstat.geom::unmark(species_b)) + expect_equal(pattern_random$observed, expected = spatstat.geom::unmark(species_b)) - testthat::expect_named(pattern_random_cluster$randomized, - expected = paste0("randomized_", 1:3)) + expect_named(pattern_random_cluster$randomized, expected = paste0("randomized_", 1:3)) + + expect_equal(pattern_random_cluster$observed, expected = spatstat.geom::unmark(species_b)) - testthat::expect_equal(pattern_random_cluster$observed, - expected = spatstat.geom::unmark(species_b)) }) -testthat::test_that("Fitted patterns have same number of points for cluster process", { +test_that("Fitted patterns have same number of points for cluster process", { + + expect_true(all(vapply(pattern_random$randomized, FUN.VALUE = logical(1), + function(x) x$n == species_b$n))) - testthat::expect_true(all(vapply(pattern_random$randomized, - FUN.VALUE = logical(1), - function(x) x$n == species_b$n))) + expect_true(all(vapply(pattern_random_cluster$randomized, FUN.VALUE = logical(1), + function(x) x$n == species_b$n))) - testthat::expect_true(all(vapply(pattern_random_cluster$randomized, - FUN.VALUE = logical(1), - function(x) x$n == species_b$n))) }) -testthat::test_that("Input pattern can not be returned for fit_point_process", { +test_that("Input pattern can not be returned for fit_point_process", { + + expect_true(object = is.na(pattern_random_ni$observed)) - testthat::expect_equal(object = pattern_random_ni$observed, - expected = "NA") }) -testthat::test_that("simplify works for fit_point_process", { +test_that("simplify works for fit_point_process", { + + expect_s3_class(pattern_random_simple, "ppp") - testthat::expect_s3_class(pattern_random_simple, "ppp") }) -testthat::test_that("fit_point_process returns errors", { +test_that("Parameters can be returned", { - testthat::expect_error(fit_point_process(pattern = species_b, n_random = -10, - verbose = FALSE), - regexp = "n_random must be >= 1.") + expect_named(object = pattern_random_para_a$para, expected = c("number_points", "lambda")) + + expect_named(object = pattern_random_para_b$para, + expected = c("number_parents", "number_points", "cluster_area")) + + expect_true(object = is.na(pattern_random$param)) + +}) + +test_that("fit_point_process returns errors", { + + expect_error(fit_point_process(pattern = species_b, n_random = -10, verbose = FALSE), + regexp = "n_random must be >= 1.") + + expect_error(fit_point_process(pattern = species_b, n_random = 19, process = "not_valid", + verbose = FALSE), + regexp = "Please select either 'poisson' or 'cluster'.") - testthat::expect_error(fit_point_process(pattern = species_b, - n_random = 19, process = "not_valid", - verbose = FALSE), - regexp = "Please select either 'poisson' or 'cluster'.") }) -testthat::test_that("fit_point_process returns warnings", { +test_that("fit_point_process returns warnings", { + + expect_warning(fit_point_process(pattern = species_a, n_random = 3, return_input = FALSE, + simplify = TRUE, verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") - testthat::expect_warning(fit_point_process(pattern = species_a, - n_random = 3, return_input = FALSE, - simplify = TRUE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") + expect_warning(fit_point_process(pattern = species_a, n_random = 1, simplify = TRUE, + verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") - testthat::expect_warning(fit_point_process(pattern = species_a, - n_random = 1, simplify = TRUE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") }) diff --git a/tests/testthat/test-list_to_randomized.R b/tests/testthat/test-list_to_randomized.R index 5f2cf5d..45f7f0b 100644 --- a/tests/testthat/test-list_to_randomized.R +++ b/tests/testthat/test-list_to_randomized.R @@ -1,4 +1,4 @@ -# testthat::context("test-list_to_randomized") +# context("test-list_to_randomized") pattern_random <- lapply(X = 1:3, function(i) { fit_point_process(pattern = species_b, n_random = 1, @@ -20,52 +20,50 @@ raster_conv <- list_to_randomized(list = raster_random, observed = landscape_cla ################################################################################ -testthat::test_that("Output has correct class", { +test_that("Output has correct class", { - testthat::expect_s3_class(object = pattern_conv, class = "rd_pat") + expect_s3_class(object = pattern_conv, class = "rd_pat") - testthat::expect_s3_class(object = raster_conv, class = "rd_ras") + expect_s3_class(object = raster_conv, class = "rd_ras") }) -testthat::test_that("Output has correct method", { +test_that("Output has correct method", { - testthat::expect_equal(object = pattern_conv$method, expected = "list_to_randomized()") + expect_equal(object = pattern_conv$method, expected = "list_to_randomized()") - testthat::expect_equal(object = raster_conv$method, expected = "list_to_randomized()") + expect_equal(object = raster_conv$method, expected = "list_to_randomized()") }) -testthat::test_that("Output is a long as input list", { +test_that("Output is a long as input list", { - testthat::expect_length(object = pattern_conv$randomized, n = 3) + expect_length(object = pattern_conv$randomized, n = 3) - testthat::expect_length(object = raster_conv$randomized, n = 3) + expect_length(object = raster_conv$randomized, n = 3) }) -testthat::test_that("Output includes randomizations and original objects", { +test_that("Output includes randomizations and original objects", { - testthat::expect_named(object = pattern_conv$randomized, - expected = paste0("randomized_", 1:3)) + expect_named(object = pattern_conv$randomized, expected = paste0("randomized_", 1:3)) - testthat::expect_equal(object = pattern_conv$observed, expected = species_b) + expect_equal(object = pattern_conv$observed, expected = species_b) - testthat::expect_named(object = raster_conv$randomized, - expected = paste0("randomized_", 1:3)) + expect_named(object = raster_conv$randomized, expected = paste0("randomized_", 1:3)) + + expect_equal(object = raster_conv$observed, expected = landscape_classified) - testthat::expect_equal(object = raster_conv$observed, - expected = landscape_classified) }) -testthat::test_that("list_to_randomized returns errors", { +test_that("list_to_randomized returns errors", { - testthat::expect_error(object = list_to_randomized(list = species_b), - regexp = "Please provide list of either 'ppp' or 'SpatRaster' objects.",) + expect_error(object = list_to_randomized(list = species_b), + regexp = "Please provide list of either 'ppp' or 'SpatRaster' objects.",) }) -testthat::test_that("list_to_randomized works with results_habitat_associations", { +test_that("list_to_randomized works with results_habitat_associations", { res_a <- results_habitat_association(pattern = pattern_conv, raster = landscape_classified, verbose = FALSE) @@ -73,8 +71,8 @@ testthat::test_that("list_to_randomized works with results_habitat_associations" res_b <- results_habitat_association(pattern = species_b, raster = raster_conv, verbose = FALSE) - testthat::expect_s3_class(object = res_a, class = "data.frame") + expect_s3_class(object = res_a, class = "data.frame") - testthat::expect_s3_class(object = res_b, class = "data.frame") + expect_s3_class(object = res_b, class = "data.frame") }) diff --git a/tests/testthat/test-pack-unpack.R b/tests/testthat/test-pack-unpack.R index e0ba766..dcc6c82 100644 --- a/tests/testthat/test-pack-unpack.R +++ b/tests/testthat/test-pack-unpack.R @@ -1,4 +1,4 @@ -# testthat::context("test-pack_randomized") +# context("test-pack_randomized") landscape_classified <- classify_habitats(terra::rast(landscape), n = 5, style = "fisher") landscape_classified[terra::values(landscape_classified) != 1] <- 2 @@ -12,25 +12,25 @@ x_ni <- pack_randomized(raster = landscape_random) ################################################################################ -testthat::test_that("pack_randomized wraps raster", { +test_that("pack_randomized wraps raster", { - testthat::expect_s4_class(object = x$observed, class = "PackedSpatRaster") - testthat::expect_true(all(sapply(x$randomized, inherits, what = "PackedSpatRaster"))) - testthat::expect_true(all(sapply(x_ni$randomized, inherits, what = "PackedSpatRaster"))) + expect_s4_class(object = x$observed, class = "PackedSpatRaster") + expect_true(all(sapply(x$randomized, inherits, what = "PackedSpatRaster"))) + expect_true(all(sapply(x_ni$randomized, inherits, what = "PackedSpatRaster"))) }) -# testthat::context("test-pack_randomized") +# context("test-pack_randomized") y <- unpack_randomized(raster = x) y_ni <- unpack_randomized(raster = x_ni) -testthat::test_that("unpack_randomized unwraps raster", { +test_that("unpack_randomized unwraps raster", { - testthat::expect_s4_class(object = y$observed, class = "SpatRaster") - testthat::expect_true(all(sapply(y$randomized, inherits, what = "SpatRaster"))) - testthat::expect_true(all(sapply(y_ni$randomized, inherits, what = "SpatRaster"))) + expect_s4_class(object = y$observed, class = "SpatRaster") + expect_true(all(sapply(y$randomized, inherits, what = "SpatRaster"))) + expect_true(all(sapply(y_ni$randomized, inherits, what = "SpatRaster"))) }) diff --git a/tests/testthat/test-plot_energy.R b/tests/testthat/test-plot_energy.R index e2aa5a7..65fd355 100644 --- a/tests/testthat/test-plot_energy.R +++ b/tests/testthat/test-plot_energy.R @@ -1,4 +1,4 @@ -# testthat::context("test-plot_energy") +# context("test-plot_energy") pattern_reconstruction <- reconstruct_pattern(pattern = species_a, n_random = 3, max_runs = 100, @@ -9,22 +9,25 @@ pattern_fitted <- fit_point_process(pattern = species_a, n_random = 3, ################################################################################ -testthat::test_that("plot_energy returns plot", { +test_that("plot_energy returns plot", { + + expect_null(plot_energy(pattern_reconstruction)) - testthat::expect_null(plot_energy(pattern_reconstruction)) }) -testthat::test_that("plot_energy uses colours", { +test_that("plot_energy uses colours", { - testthat::expect_null(plot_energy(pattern_reconstruction, + expect_null(plot_energy(pattern_reconstruction, col = c("blue", "green", "red"))) + }) -testthat::test_that("plot_energy returns error", { +test_that("plot_energy returns error", { + + expect_error(plot_energy(pattern = 1:10), + regexp = "Class of 'pattern' must be 'rd_pat' or 'rd_mar'.") - testthat::expect_error(plot_energy(pattern = 1:10), - regexp = "Class of 'pattern' must be 'rd_pat' or 'rd_mar'.") + expect_error(plot_energy(pattern_fitted), + regexp = "There is no 'energy_df' slot. Please use pattern reconstruction for valid input data.") - testthat::expect_error(plot_energy(pattern_fitted), - regexp = "There is no 'energy_df' slot. Please use pattern reconstruction for valid input data.") }) diff --git a/tests/testthat/test-plot_rd_multi.R b/tests/testthat/test-plot_rd_multi.R index e724155..5a36bc4 100644 --- a/tests/testthat/test-plot_rd_multi.R +++ b/tests/testthat/test-plot_rd_multi.R @@ -1,4 +1,4 @@ -# testthat::context("test-plot_rd_multi") +# context("test-plot_rd_multi") # create random data xr <- 500 @@ -26,9 +26,9 @@ multi_recon_simple <- reconstruct_pattern_multi(marked_pattern, n_repetitions = ################################################################################ -testthat::test_that("plot returns plot", { +test_that("plot returns plot", { - testthat::expect_null(plot(multi_recon, verbose = FALSE)) - testthat::expect_null(plot(multi_recon_simple, verbose = FALSE)) + expect_null(plot(multi_recon, verbose = FALSE)) + expect_null(plot(multi_recon_simple, verbose = FALSE)) }) diff --git a/tests/testthat/test-plot_rd_pat.R b/tests/testthat/test-plot_rd_pat.R index 5955c10..51901d6 100644 --- a/tests/testthat/test-plot_rd_pat.R +++ b/tests/testthat/test-plot_rd_pat.R @@ -1,4 +1,4 @@ -# testthat::context("test-plot_rd_pat") +# context("test-plot_rd_pat") pattern_random <- fit_point_process(species_a, n_random = 3, verbose = FALSE) @@ -16,27 +16,31 @@ marks_recon <- reconstruct_pattern_marks(pattern = pattern_random_marks, ################################################################################ -testthat::test_that("plot returns plot", { +test_that("plot returns plot", { - testthat::expect_null(plot(pattern_random, verbose = FALSE, ask = FALSE)) + expect_null(plot(pattern_random, verbose = FALSE, ask = FALSE)) + + expect_null(plot(pattern_random, what = "pp", verbose = FALSE)) - testthat::expect_null(plot(pattern_random, what = "pp", verbose = FALSE)) }) -testthat::test_that("plot returns error if observed is missing", { +test_that("plot returns error if observed is missing", { + + expect_error(plot(pattern_random_ni, verbose = FALSE), + regexp = "Input must include 'observed' pattern.") - testthat::expect_error(plot(pattern_random_ni, verbose = FALSE), - regexp = "Input must include 'observed' pattern.") }) -testthat::test_that("plot works for reconstructed marks", { +test_that("plot works for reconstructed marks", { + + expect_null(plot(marks_recon, verbose = FALSE)) + expect_null(plot(marks_recon, what = "pp", verbose = FALSE)) - testthat::expect_null(plot(marks_recon, verbose = FALSE)) - testthat::expect_null(plot(marks_recon, what = "pp", verbose = FALSE)) }) -testthat::test_that("plot returns error if what is wrong", { +test_that("plot returns error if what is wrong", { + + expect_error(plot(pattern_random, what = "wrong", verbose = FALSE), + regexp = "Please select either what = 'sf' or what = 'pp'.") - testthat::expect_error(plot(pattern_random, what = "wrong", verbose = FALSE), - regexp = "Please select either what = 'sf' or what = 'pp'.") }) diff --git a/tests/testthat/test-plot_rd_ras.R b/tests/testthat/test-plot_rd_ras.R index 97a6f92..b0fe5aa 100644 --- a/tests/testthat/test-plot_rd_ras.R +++ b/tests/testthat/test-plot_rd_ras.R @@ -1,4 +1,4 @@ -# testthat::context("test-plot_rd_ras") +# context("test-plot_rd_ras") landscape_classified <- classify_habitats(raster = terra::rast(landscape), n = 5, style = "fisher") @@ -15,30 +15,34 @@ raster_random_ni <- translate_raster(raster = landscape_classified, ################################################################################ -testthat::test_that("plot returns plot", { +test_that("plot returns plot", { + + expect_null(plot(raster_random, verbose = FALSE)) - testthat::expect_null(plot(raster_random, verbose = FALSE)) }) -testthat::test_that("plot returns plot if n vector is specified", { +test_that("plot returns plot if n vector is specified", { + + expect_null(plot(raster_random, n = c(1, 2, 5), verbose = FALSE)) - testthat::expect_null(plot(raster_random, n = c(1, 2, 5), verbose = FALSE)) + expect_null(plot(raster_random_large, verbose = FALSE)) - testthat::expect_null(plot(raster_random_large, verbose = FALSE)) + expect_null(plot(raster_random, n = 100, verbose = FALSE)) - testthat::expect_null(plot(raster_random, n = 100, verbose = FALSE)) + expect_null(plot(raster_random_large, n = 100, verbose = FALSE)) - testthat::expect_null(plot(raster_random_large, n = 100, verbose = FALSE)) }) -testthat::test_that("plot returns error if observed is missing", { +test_that("plot returns error if observed is missing", { + + expect_error(plot(raster_random_ni, verbose = FALSE), + regexp = "Input must include 'observed' raster.") - testthat::expect_error(plot(raster_random_ni, verbose = FALSE), - regexp = "Input must include 'observed' raster.") }) -testthat::test_that("plot returns error if wrong id are selected ", { +test_that("plot returns error if wrong id are selected ", { + + expect_error(plot(raster_random, n = c(100, 101, 102), verbose = FALSE), + regexp = "Please provide at least on valid ID for n.") - testthat::expect_error(plot(raster_random, n = c(100, 101, 102), verbose = FALSE), - regexp = "Please provide at least on valid ID for n.") }) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 38161ab..4bcf51e 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -1,4 +1,4 @@ -# testthat::context("test-print") +# context("test-print") pattern_reconstruction <- reconstruct_pattern(pattern = species_a, n_random = 3, max_runs = 1, verbose = FALSE) @@ -22,18 +22,21 @@ landscape_random <- translate_raster(raster = landscape_classified, ################################################################################ -testthat::test_that("print.rd_pat works", { +test_that("print.rd_pat works", { + + expect_output(print(pattern_reconstruction)) + expect_output(print(pattern_fitted)) - testthat::expect_output(print(pattern_reconstruction)) - testthat::expect_output(print(pattern_fitted)) }) -testthat::test_that("print.rd_mar works", { +test_that("print.rd_mar works", { + + expect_output(print(marks_reconstruction)) - testthat::expect_output(print(marks_reconstruction)) }) -testthat::test_that("print.rd_ras works", { +test_that("print.rd_ras works", { + + expect_output(print(landscape_random)) - testthat::expect_output(print(landscape_random)) }) diff --git a/tests/testthat/test-randomize_raster.R b/tests/testthat/test-randomize_raster.R index a4fd555..50991c7 100644 --- a/tests/testthat/test-randomize_raster.R +++ b/tests/testthat/test-randomize_raster.R @@ -1,4 +1,4 @@ -# testthat::context("test-randomize_raster") +# context("test-randomize_raster") landscape_classified <- classify_habitats(raster = terra::rast(landscape), n = 5, style = "fisher") @@ -19,59 +19,64 @@ landscape_wrong[1:50] <- NA ################################################################################ -testthat::test_that("Output is as long as n_random for randomize_raster", { +test_that("Output is as long as n_random for randomize_raster", { - testthat::expect_s3_class(landscape_random, class = "rd_ras") + expect_s3_class(landscape_random, class = "rd_ras") + + expect_length(landscape_random$randomized, n = 1) - testthat::expect_length(landscape_random$randomized, n = 1) }) -testthat::test_that("Output includes randomizations and original pattern for randomize_raster", { +test_that("Output includes randomizations and original pattern for randomize_raster", { + + expect_named(landscape_random$randomized, expected = "randomized_1") - testthat::expect_named(landscape_random$randomized, - expected = "randomized_1") + expect_equal(landscape_random$observed, expected = landscape_classified) - testthat::expect_equal(landscape_random$observed, - expected = landscape_classified) }) -testthat::test_that("Input raster can not be returned for randomize_raster", { +test_that("Input raster can not be returned for randomize_raster", { landscape_diff <- landscape_classified - raster_random_simple check <- all(terra::values(landscape_diff) == 0) - testthat::expect_false(check) + expect_false(check) + }) -testthat::test_that("simplify works for randomize_raster", { +test_that("simplify works for randomize_raster", { + + expect_s4_class(raster_random_simple, "SpatRaster") - testthat::expect_s4_class(raster_random_simple, "SpatRaster") }) -testthat::test_that("randomize_raster returns error of n_random < 1", { +test_that("randomize_raster returns error of n_random < 1", { + + expect_error(randomize_raster(raster = landscape_classified, n_random = 0, + verbose = FALSE), regexp = "n_random must be >= 1.") - testthat::expect_error(randomize_raster(raster = landscape_classified, n_random = 0, - verbose = FALSE), regexp = "n_random must be >= 1.") }) -testthat::test_that("randomize_raster returns all warnings", { +test_that("randomize_raster returns all warnings", { + + expect_warning(randomize_raster(raster = landscape_classified, n_random = 1, + simplify = TRUE, verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") - testthat::expect_warning(randomize_raster(raster = landscape_classified, n_random = 1, - simplify = TRUE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") + expect_warning(randomize_raster(raster = landscape_classified, n_random = 2, + simplify = TRUE, return_input = FALSE, verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") - testthat::expect_warning(randomize_raster(raster = landscape_classified, n_random = 2, - simplify = TRUE, return_input = FALSE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") + expect_warning(randomize_raster(raster = terra::rast(landscape), n_random = 1, + verbose = FALSE), + regexp = "The raster has more than 10 classes. Please make sure discrete classes are provided.") - testthat::expect_warning(randomize_raster(raster = terra::rast(landscape), n_random = 1, - verbose = FALSE), - regexp = "The raster has more than 10 classes. Please make sure discrete classes are provided.") }) -testthat::test_that("Warning if NA are present", { +test_that("Warning if NA are present", { + + expect_warning(randomize_raster(raster = landscape_wrong, n_random = 1, verbose = FALSE), + regexp = "NA values present. Please make sure the observation window of the point pattern reflects this.") - testthat::expect_warning(randomize_raster(raster = landscape_wrong, n_random = 1, verbose = FALSE), - regexp = "NA values present. Please make sure the observation window of the point pattern reflects this.") }) diff --git a/tests/testthat/test-reconstruct_pattern.R b/tests/testthat/test-reconstruct_pattern.R index 29bf38e..cbf7ab7 100644 --- a/tests/testthat/test-reconstruct_pattern.R +++ b/tests/testthat/test-reconstruct_pattern.R @@ -1,4 +1,4 @@ -# testthat::context("test-reconstruct_pattern") +# context("test-reconstruct_pattern") # normal reconstruction pattern_recon_homo <- reconstruct_pattern(pattern = species_a, n_random = 3, @@ -28,80 +28,80 @@ pattern_empty <- spatstat.geom::ppp() ################################################################################ -testthat::test_that("reconstruct_pattern returns correct class", { +test_that("reconstruct_pattern returns correct class", { - testthat::expect_s3_class(pattern_recon_homo, class = "rd_pat") + expect_s3_class(pattern_recon_homo, class = "rd_pat") - testthat::expect_s3_class(pattern_recon_cluster, class = "rd_pat") + expect_s3_class(pattern_recon_cluster, class = "rd_pat") - testthat::expect_s3_class(pattern_recon_hetero, class = "rd_pat") + expect_s3_class(pattern_recon_hetero, class = "rd_pat") }) -testthat::test_that("Output is a long as n_random for reconstruct_pattern", { +test_that("Output is a long as n_random for reconstruct_pattern", { - testthat::expect_type(pattern_recon_homo$randomized, type = "list") + expect_type(pattern_recon_homo$randomized, type = "list") + + expect_length(pattern_recon_homo$randomized, n = 3) - testthat::expect_length(pattern_recon_homo$randomized, n = 3) }) -testthat::test_that("Output includes randomizations and original pattern for reconstruct_pattern", { +test_that("Output includes randomizations and original pattern for reconstruct_pattern", { + + expect_named(pattern_recon_homo$randomized, expected = paste0("randomized_", c(1:3))) - testthat::expect_named(pattern_recon_homo$randomized, - expected = paste0("randomized_", c(1:3))) + expect_equal(pattern_recon_homo$observed, expected = spatstat.geom::unmark(species_a)) - testthat::expect_equal(pattern_recon_homo$observed, - expected = spatstat.geom::unmark(species_a)) }) -testthat::test_that("Reconstructed patterns have same number of points", { +test_that("Reconstructed patterns have same number of points", { + + expect_true(all(vapply(pattern_recon_homo$randomized, FUN.VALUE = logical(1), + function(x) x$n == species_a$n))) - testthat::expect_true(all(vapply(pattern_recon_homo$randomized, - FUN.VALUE = logical(1), - function(x) x$n == species_a$n))) }) -testthat::test_that("Input pattern can not be returned for reconstruct_pattern", { +test_that("Input pattern can not be returned for reconstruct_pattern", { + + expect_true(object = is.na(pattern_recon_ni$observed)) - testthat::expect_equal(object = pattern_recon_ni$observed, - expected = "NA") }) -testthat::test_that("Reconstruction stops if e_threshold is reached", { +test_that("Reconstruction stops if e_threshold is reached", { energy <- calculate_energy(pattern_recon_energy, verbose = FALSE) - testthat::expect_true(object = all(energy < 0.1)) + expect_true(object = all(energy < 0.1)) - testthat::expect_true(all(pattern_recon_energy$stop_criterion == "e_threshold")) + expect_true(all(pattern_recon_energy$stop_criterion == "e_threshold")) }) -testthat::test_that("simplify works for reconstruct_pattern", { +test_that("simplify works for reconstruct_pattern", { + + expect_s3_class(pattern_recon_simple, "ppp") - testthat::expect_s3_class(pattern_recon_simple, "ppp") }) -testthat::test_that("reconstruct_pattern returns errors", { +test_that("reconstruct_pattern returns errors", { - testthat::expect_error(reconstruct_pattern(pattern = species_a, n_random = -5, - verbose = FALSE), - regexp = "n_random must be >= 1.") + expect_error(reconstruct_pattern(pattern = species_a, n_random = -5, verbose = FALSE), + regexp = "n_random must be >= 1.") - testthat::expect_error(reconstruct_pattern(pattern = pattern_empty, n_random = 199), - regexp = "The observed pattern contains no points.") + expect_error(reconstruct_pattern(pattern = pattern_empty, n_random = 199), + regexp = "The observed pattern contains no points.") }) -testthat::test_that("reconstruct_pattern returns warnings", { +test_that("reconstruct_pattern returns warnings", { + + expect_warning(reconstruct_pattern(pattern = species_a, n_random = 2, max_runs = 1, + return_input = FALSE, simplify = TRUE, + verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") - testthat::expect_warning(reconstruct_pattern(pattern = species_a, n_random = 2, - max_runs = 1, return_input = FALSE, - simplify = TRUE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'n_random > 1'.") + expect_warning(reconstruct_pattern(pattern = species_a, n_random = 1, max_runs = 1, + simplify = TRUE, verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") - testthat::expect_warning(reconstruct_pattern(pattern = species_a, n_random = 1, - max_runs = 1, simplify = TRUE, - verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'.") }) diff --git a/tests/testthat/test-reconstruct_pattern_marks.R b/tests/testthat/test-reconstruct_pattern_marks.R index 7364913..35f4b30 100644 --- a/tests/testthat/test-reconstruct_pattern_marks.R +++ b/tests/testthat/test-reconstruct_pattern_marks.R @@ -1,4 +1,4 @@ -# testthat::context("test-reconstruct_pattern_marks") +# context("test-reconstruct_pattern_marks") pattern_recon <- reconstruct_pattern(species_a, n_random = 1, return_input = FALSE, simplify = TRUE, max_runs = 1, @@ -29,88 +29,82 @@ pattern_recon_empty <- pattern_recon[-c(1:pattern_recon$n)] ################################################################################ -testthat::test_that("Output is a long as n_random for reconstruct_pattern_marks", { +test_that("Output is a long as n_random for reconstruct_pattern_marks", { - testthat::expect_s3_class(marks_recon, class = "rd_mar") + expect_s3_class(marks_recon, class = "rd_mar") - testthat::expect_type(marks_recon$randomized, type = "list") + expect_type(marks_recon$randomized, type = "list") + + expect_length(marks_recon$randomized, n = 3) - testthat::expect_length(marks_recon$randomized, n = 3) }) -testthat::test_that("Output includes randomizations and original pattern for reconstruct_pattern_marks", { +test_that("Output includes randomizations and original pattern for reconstruct_pattern_marks", { + + expect_named(marks_recon$randomized, expected = paste0("randomized_", c(1:3))) - testthat::expect_named(marks_recon$randomized, - expected = paste0("randomized_", c(1:3))) + expect_equal(marks_recon$observed, expected = marks_sub) - testthat::expect_equal(marks_recon$observed, expected = marks_sub) }) -testthat::test_that("Input pattern can not be returned for reconstruct_pattern_marks", { +test_that("Input pattern can not be returned for reconstruct_pattern_marks", { + + expect_true(object = is.na(marks_recon_ni$observed)) - testthat::expect_equal(object = marks_recon_ni$observed, - expected = "NA") }) -testthat::test_that("Only pattern can be returned for simplify = TRUE", { +test_that("Only pattern can be returned for simplify = TRUE", { + + expect_s3_class(marks_recon_simple, "ppp") - testthat::expect_s3_class(marks_recon_simple, "ppp") }) -testthat::test_that("Reconstruction stops if e_threshold is reached", { +test_that("Reconstruction stops if e_threshold is reached", { energy <- calculate_energy(marks_recon_energy, verbose = FALSE) - testthat::expect_true(all(energy < 0.1 & energy > 0.01)) + expect_true(all(energy < 0.1 & energy > 0.01)) + + expect_true(all(marks_recon_energy$stop_criterion %in% c("e_threshold", "no_change"))) - testthat::expect_true(all(marks_recon_energy$stop_criterion %in% c("e_threshold", "no_change"))) }) -testthat::test_that("All errors are returned for reconstruct_pattern_marks", { - - testthat::expect_error(reconstruct_pattern_marks(pattern = pattern_recon, - marked_pattern = marks_sub, - n_random = -5, max_runs = 1, - verbose = FALSE), - regexp = "n_random must be >= 1.") - - testthat::expect_error(reconstruct_pattern_marks(pattern = pattern_recon, - marked_pattern = pattern_recon, - n_random = 3, max_runs = 1, - verbose = FALSE), - regexp = "'pattern' must be unmarked and 'marked_pattern' marked") - - testthat::expect_error(reconstruct_pattern_marks(pattern = marks_sub, - marked_pattern = marks_sub, - n_random = 3, max_runs = 1, - verbose = FALSE), - regexp = "'pattern' must be unmarked and 'marked_pattern' marked") - - testthat::expect_error(reconstruct_pattern_marks(pattern = pattern_recon, - marked_pattern = spatstat.geom::subset.ppp(species_a, - select = status), - n_random = 3, max_runs = 1), - regexp = "marks must be 'numeric'") - - testthat::expect_error(reconstruct_pattern_marks(pattern = pattern_recon_empty, - marked_pattern = marks_sub, - verbose = FALSE), - regexp = "At least one of the observed patterns contain no points.") +test_that("All errors are returned for reconstruct_pattern_marks", { + + expect_error(reconstruct_pattern_marks(pattern = pattern_recon, marked_pattern = marks_sub, + n_random = -5, max_runs = 1, verbose = FALSE), + regexp = "n_random must be >= 1.") + + expect_error(reconstruct_pattern_marks(pattern = pattern_recon, marked_pattern = pattern_recon, + n_random = 3, max_runs = 1, verbose = FALSE), + regexp = "'pattern' must be unmarked and 'marked_pattern' marked") + + expect_error(reconstruct_pattern_marks(pattern = marks_sub, marked_pattern = marks_sub, + n_random = 3, max_runs = 1, verbose = FALSE), + regexp = "'pattern' must be unmarked and 'marked_pattern' marked") + + expect_error(reconstruct_pattern_marks(pattern = pattern_recon, + marked_pattern = spatstat.geom::subset.ppp(species_a, + select = status), + n_random = 3, max_runs = 1), + regexp = "marks must be 'numeric'") + + expect_error(reconstruct_pattern_marks(pattern = pattern_recon_empty, marked_pattern = marks_sub, + verbose = FALSE), + regexp = "At least one of the observed patterns contain no points.") }) -testthat::test_that("All warnings are returned for reconstruct_pattern_marks", { +test_that("All warnings are returned for reconstruct_pattern_marks", { + + expect_warning(reconstruct_pattern_marks(pattern = pattern_recon, marked_pattern = marks_sub, + n_random = 2, max_runs = 1, return_input = FALSE, + simplify = TRUE, verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'n_random > 1'") - testthat::expect_warning(reconstruct_pattern_marks(pattern = pattern_recon, - marked_pattern = marks_sub, - n_random = 2, max_runs = 1, - return_input = FALSE, simplify = TRUE, - verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'n_random > 1'") + expect_warning(reconstruct_pattern_marks(pattern = pattern_recon, marked_pattern = marks_sub, + n_random = 1, max_runs = 1, simplify = TRUE, + verbose = FALSE), + regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'") - testthat::expect_warning(reconstruct_pattern_marks(pattern = pattern_recon, - marked_pattern = marks_sub, - n_random = 1, max_runs = 1, - simplify = TRUE, verbose = FALSE), - regexp = "'simplify = TRUE' not possible for 'return_input = TRUE'") }) diff --git a/tests/testthat/test-reconstruct_pattern_multi.R b/tests/testthat/test-reconstruct_pattern_multi.R index 7ec619b..5c740ff 100644 --- a/tests/testthat/test-reconstruct_pattern_multi.R +++ b/tests/testthat/test-reconstruct_pattern_multi.R @@ -1,4 +1,4 @@ -# testthat::context("test-reconstruct_pattern_multi") +# context("test-reconstruct_pattern_multi") # create random data xr <- 500 @@ -30,33 +30,37 @@ multi_recon_fun <- reconstruct_pattern_multi(marked_pattern, n_repetitions = 1, ################################################################################ -testthat::test_that("Output is a long as n_random for reconstruct_pattern_multi", { +test_that("Output is a long as n_random for reconstruct_pattern_multi", { - testthat::expect_type(multi_recon, type = "list") + expect_type(multi_recon, type = "list") + + expect_length(multi_recon, n = 3) - testthat::expect_length(multi_recon, n = 3) }) -testthat::test_that("Output includes randomizations and original pattern for reconstruct_pattern_multi", { +test_that("Output includes randomizations and original pattern for reconstruct_pattern_multi", { + + expect_true(all(sapply(multi_recon, function(i) i$reference == random))) - testthat::expect_true(all(sapply(multi_recon, function(i) i$reference == random))) + expect_true(all(sapply(multi_recon, function(i) nrow(i$reconstructed) == N))) - testthat::expect_true(all(sapply(multi_recon, function(i) nrow(i$reconstructed) == N))) }) -testthat::test_that("Only one pattern returned for n = 1", { +test_that("Only one pattern returned for n = 1", { + + expect_length(multi_recon_simple, n = 14) - testthat::expect_length(multi_recon_simple, n = 14) }) -testthat::test_that("Energy decresead for for reconstruct_pattern_multi", { +test_that("Energy decresead for for reconstruct_pattern_multi", { + + expect_lt(object = multi_recon_simple$energy_current, + expected = multi_recon_simple$energy_launch) - testthat::expect_lt(object = multi_recon_simple$energy_current, - expected = multi_recon_simple$energy_launch) }) -testthat::test_that("Test additional arguments of reconstruct_pattern_multi", { +test_that("Test additional arguments of reconstruct_pattern_multi", { expect_equal(object = multi_recon_fun$Parameter_setting$w_statistics, expected = c("Dk" = 1, "K" = 0.5, "Hs" = 0.5, "pcf" = 1)) diff --git a/tests/testthat/test-results_habitat_association.R b/tests/testthat/test-results_habitat_association.R index 580416c..2180b02 100644 --- a/tests/testthat/test-results_habitat_association.R +++ b/tests/testthat/test-results_habitat_association.R @@ -1,4 +1,4 @@ -# testthat::context("test-results_habitat_association") +# context("test-results_habitat_association") set.seed(42) @@ -44,21 +44,23 @@ pattern_wrong <- fit_point_process(pattern = pattern_wrong, n_random = 199, ################################################################################ -testthat::test_that("results_habitat_association returns one row for each habitat", { +test_that("results_habitat_association returns one row for each habitat", { - testthat::expect_equal(nrow(result_pattern), expected = 5) + expect_equal(nrow(result_pattern), expected = 5) + + expect_equal(nrow(result_raster), expected = 5) - testthat::expect_equal(nrow(result_raster), expected = 5) }) -testthat::test_that("results_habitat_association lo is < hi", { +test_that("results_habitat_association lo is < hi", { + + expect_true(all(result_pattern$lo <= result_pattern$hi)) - testthat::expect_true(all(result_pattern$lo <= result_pattern$hi)) + expect_true(all(result_raster$lo <= result_raster$hi)) - testthat::expect_true(all(result_raster$lo <= result_raster$hi)) }) -testthat::test_that("results_habitat_association returns correct association", { +test_that("results_habitat_association returns correct association", { result_ns <- dplyr::filter(result_pattern, significance == "n.s.") result_pos <- dplyr::filter(result_pattern, significance == "positive") @@ -68,77 +70,81 @@ testthat::test_that("results_habitat_association returns correct association", { pos_tf <- result_pos$count > result_pos$hi neg_tf <- result_neg$count < result_neg$lo - testthat::expect_true(all(c(ns_tf, pos_tf, neg_tf))) + expect_true(all(c(ns_tf, pos_tf, neg_tf))) + }) -testthat::test_that("results_habitat_association returns breaks", { +test_that("results_habitat_association returns breaks", { - testthat::expect_true(object = all(!is.na(result_breaks$breaks))) + expect_true(object = all(!is.na(result_breaks$breaks))) }) -testthat::test_that("results_habitat_association returns warning if significance_threshold is not meaningful", { +test_that("results_habitat_association returns warning if significance_threshold is not meaningful", { + + expect_warning(results_habitat_association(raster = landscape_classified$raster, + pattern = random_a, significance_level = 0.75, + verbose = FALSE), + regexp = "Make sure 'signifcance_level' is meaningful \\(e.g. 'significance_level = 0.05'\\).") - testthat::expect_warning(results_habitat_association(raster = landscape_classified$raster, - pattern = random_a, significance_level = 0.75, - verbose = FALSE), - regexp = "Make sure 'signifcance_level' is meaningful \\(e.g. 'significance_level = 0.05'\\).") }) -testthat::test_that("results_habitat_association returns warning if more than 25 classes are present", { +test_that("results_habitat_association returns warning if more than 25 classes are present", { - testthat::expect_warning(results_habitat_association(raster = terra::rast(landscape), pattern = random_a, - verbose = FALSE), - regexp = "The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.") + expect_warning(results_habitat_association(raster = terra::rast(landscape), pattern = random_a, + verbose = FALSE), + regexp = "The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.") + + expect_warning(results_habitat_association(raster = raster_random_cont, pattern = species_a, + verbose = FALSE), + regexp = "The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.") - testthat::expect_warning(results_habitat_association(raster = raster_random_cont, pattern = species_a, - verbose = FALSE), - regexp = "The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.") }) -testthat::test_that("results_habitat_association returns error if input is wrong", { +test_that("results_habitat_association returns error if input is wrong", { + + expect_error(results_habitat_association(raster = landscape_classified$raster, + pattern = species_a, verbose = FALSE), + regexp = "Class of 'pattern' or 'raster' must be either 'rd_pat' or 'rd_ras'.") - testthat::expect_error(results_habitat_association(raster = landscape_classified$raster, - pattern = species_a, verbose = FALSE), - regexp = "Class of 'pattern' or 'raster' must be either 'rd_pat' or 'rd_ras'.") + expect_error(results_habitat_association(raster = raster_random, + pattern = random_a, verbose = FALSE), + regexp = "Please provide only one randomized input.") - testthat::expect_error(results_habitat_association(raster = raster_random, - pattern = random_a, verbose = FALSE), - regexp = "Please provide only one randomized input.") + expect_error(results_habitat_association(raster = raster_random_ni, + pattern = species_a, verbose = FALSE), + regexp = "The observed raster needs to be included in the input 'raster'.") - testthat::expect_error(results_habitat_association(raster = raster_random_ni, - pattern = species_a, verbose = FALSE), - regexp = "The observed raster needs to be included in the input 'raster'.") +expect_error(results_habitat_association(raster = landscape_classified$raster, + pattern = random_a_ni, verbose = FALSE), + regexp = "The observed pattern needs to be included in the input 'pattern'.") -testthat::expect_error(results_habitat_association(raster = landscape_classified$raster, - pattern = random_a_ni, verbose = FALSE), - regexp = "The observed pattern needs to be included in the input 'pattern'.") +expect_error(results_habitat_association(raster = landscape_classified, + pattern = random_a, verbose = FALSE), + regexp = "Pleaster provide 'SpatRaster' as raster argument.") -testthat::expect_error(results_habitat_association(raster = landscape_classified, - pattern = random_a, verbose = FALSE), - regexp = "Pleaster provide 'SpatRaster' as raster argument.") +expect_error(results_habitat_association(raster = raster_random, + pattern = list(species_a), verbose = FALSE), + regexp = "Pleaster provide 'ppp' as pattern argument.") -testthat::expect_error(results_habitat_association(raster = raster_random, - pattern = list(species_a), verbose = FALSE), - regexp = "Pleaster provide 'ppp' as pattern argument.") }) -testthat::test_that("results_habitat_association returns error if extent is not identical", { +test_that("results_habitat_association returns error if extent is not identical", { - testthat::expect_warning(results_habitat_association(pattern = species_a, - raster = landscape_wrong_a, verbose = FALSE), - regexp = "Extent of 'pattern' and 'raster' are not identical.") + expect_warning(results_habitat_association(pattern = species_a, + raster = landscape_wrong_a, verbose = FALSE), + regexp = "Extent of 'pattern' and 'raster' are not identical.") - testthat::expect_warning(results_habitat_association(pattern = pattern_wrong, - raster = landscape_classified$raster, verbose = FALSE), - regexp = "Extent of 'pattern' and 'raster' are not identical.") + expect_warning(results_habitat_association(pattern = pattern_wrong, + raster = landscape_classified$raster, verbose = FALSE), + regexp = "Extent of 'pattern' and 'raster' are not identical.") }) -testthat::test_that("results_habitat_association returns warning if NA present", { +test_that("results_habitat_association returns warning if NA present", { + + expect_warning(results_habitat_association(pattern = random_a, raster = landscape_wrong_b, + verbose = FALSE), + regexp = "NA values present. Please make sure the observation window of the point pattern reflects this.") - testthat::expect_warning(results_habitat_association(pattern = random_a, - raster = landscape_wrong_b, - verbose = FALSE), - regexp = "NA values present. Please make sure the observation window of the point pattern reflects this.") }) diff --git a/tests/testthat/test-sample_randomized.R b/tests/testthat/test-sample_randomized.R index 523d212..1a900e4 100644 --- a/tests/testthat/test-sample_randomized.R +++ b/tests/testthat/test-sample_randomized.R @@ -1,4 +1,4 @@ -# testthat::context("test-plot_rd_pat") +# context("test-plot_rd_pat") pattern_random <- fit_point_process(species_a, n_random = 9, verbose = FALSE) @@ -7,7 +7,9 @@ pattern_random <- fit_point_process(species_a, n_random = 9, verbose = FALSE) test_that("sample_randomized returns n = 3 for no user input", { expect_length(object = sample_randomized(randomized = pattern_random$randomized, - verbose = FALSE), n = 3) + verbose = FALSE), + n = 3) + }) test_that("sample_randomized returns selected ids", { @@ -15,6 +17,7 @@ test_that("sample_randomized returns selected ids", { expect_named(object = sample_randomized(randomized = pattern_random$randomized, n = c(3, 6, 9), verbose = FALSE), expected = paste0("randomized_", c(3, 6, 9))) + }) test_that("sample_randomized returns warnings", { @@ -22,6 +25,7 @@ test_that("sample_randomized returns warnings", { expect_warning(object = sample_randomized(randomized = pattern_random$randomized, n = 199, verbose = TRUE), regexp = "n larger than number of randomize eleements. Setting n = 3") + }) test_that("sample_randomized returns warnings", { @@ -33,6 +37,7 @@ test_that("sample_randomized returns warnings", { expect_warning(object = sample_randomized(randomized = pattern_random$randomized, n = c(1, 199), verbose = TRUE), regexp = "Using only IDs that are present in randomized data.") + }) test_that("sample_randomized returns error", { @@ -40,4 +45,5 @@ test_that("sample_randomized returns error", { expect_error(object = sample_randomized(randomized = pattern_random$randomized, n = c(150, 199), verbose = TRUE), regexp = "Please provide at least on valid ID for n.") + }) diff --git a/tests/testthat/test-translate_raster.R b/tests/testthat/test-translate_raster.R index 1fc2393..db31542 100644 --- a/tests/testthat/test-translate_raster.R +++ b/tests/testthat/test-translate_raster.R @@ -1,4 +1,4 @@ -# testthat::context("test-translate_raster") +# context("test-translate_raster") # n_random <- (terra::nrow(terra::rast(landscape)) + 1) * # terra::ncol(terra::rast(landscape)) + 1) - 4 @@ -28,22 +28,21 @@ landscape_wrong[1:50] <- NA ################################################################################ -testthat::test_that("Output is a long as n_random for translate_raster", { +test_that("Output is a long as n_random for translate_raster", { + + expect_length(landscape_random$randomized, n = 2597) - testthat::expect_length(landscape_random$randomized, - n = 2597) }) -testthat::test_that("Output includes randomizations and original pattern for translate_raster", { +test_that("Output includes randomizations and original pattern for translate_raster", { + + expect_named(landscape_random$randomized, expected = paste0("randomized_", 1:2597)) - testthat::expect_named(landscape_random$randomized, - expected = paste0("randomized_", 1:2597)) + expect_equal(landscape_random$observed, expected = landscape_classified) - testthat::expect_equal(landscape_random$observed, - expected = landscape_classified) }) -testthat::test_that("Input raster can not be returned for translate_raster", { +test_that("Input raster can not be returned for translate_raster", { check <- vapply(X = landscape_random_steps$randomized, FUN = function(x) { @@ -52,30 +51,33 @@ testthat::test_that("Input raster can not be returned for translate_raster", { all(terra::values(landscape_diff) == 0) }, FUN.VALUE = logical(1)) - testthat::expect_false(all(check)) + expect_false(all(check)) + }) -testthat::test_that("Providing steps is working for translate_raster", { +test_that("Providing steps is working for translate_raster", { + + expect_length(landscape_random_steps$randomized, n = 9) - testthat::expect_length(landscape_random_steps$randomized, - n = 9) }) -testthat::test_that("simplify is working for translate_raster", { +test_that("simplify is working for translate_raster", { + + expect_s4_class(landscape_random_simple, class = "SpatRaster") - testthat::expect_s4_class(landscape_random_simple, class = "SpatRaster") }) -testthat::test_that("Warning if more than 10 classes are present for translate_raster", { +test_that("Warning if more than 10 classes are present for translate_raster", { + + expect_warning(translate_raster(raster = terra::rast(landscape), steps_x = 5, steps_y = 5, + verbose = FALSE), + regexp = "The raster has more than 10 classes. Please make sure discrete classes are provided.") - testthat::expect_warning(translate_raster(raster = terra::rast(landscape), steps_x = 5, steps_y = 5, - verbose = FALSE), - regexp = "The raster has more than 10 classes. Please make sure discrete classes are provided.") }) -testthat::test_that("Stop if NA are present", { +test_that("Stop if NA are present", { - testthat::expect_error(translate_raster(raster = landscape_wrong, steps_x = 5, steps_y = 5), - regexp = "NA values are not allowed for 'translate_raster\\()'.") -}) + expect_error(translate_raster(raster = landscape_wrong, steps_x = 5, steps_y = 5), + regexp = "NA values are not allowed for 'translate_raster\\()'.") +})