From 88548445e7228c5f7d82b4b96d583d38c7fb3223 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandre=20G=C3=A9nin?= Date: Sun, 2 Jul 2023 16:57:08 +0200 Subject: [PATCH 1/5] Add neighbor mask specification --- NEWS | 4 ++ R/indicator_psdtype.R | 21 ++++++---- R/label.R | 86 +++++++++++++++++++++++++++++----------- R/null_model_helpers.R | 1 + R/task_patch_indic.R | 23 +++++++---- man/indicator_psdtype.Rd | 9 ++++- man/label.Rd | 21 ++++------ man/patchdistr_sews.Rd | 9 ++++- man/patchsizes.Rd | 25 ++++++------ 9 files changed, 132 insertions(+), 67 deletions(-) diff --git a/NEWS b/NEWS index d03babe5..f640e187 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,10 @@ New indicators: * Indicators based on the LSW distribution (Siteur et al. 2023) +Bug fixes: + + * Documentation improvements and minor fixes + spatialwarnings v3.0.3 (Release date: 2022-03-21) ================================================= diff --git a/R/indicator_psdtype.R b/R/indicator_psdtype.R index ba1fe960..12b83cd5 100644 --- a/R/indicator_psdtype.R +++ b/R/indicator_psdtype.R @@ -32,6 +32,12 @@ #' @param wrap Determines whether patches are considered to wrap around the #' matrix when reaching the side #' +#' @param nbmask Either "moore" for 8-way neighborhood, "von_neumann" for four-way +#' neighborhood (default), or a square matrix with an odd number of lines and columns +#' that describes which neighbors are to be considered around a cell. Default +#' is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +#' above, below, on the right and on the left of the target cell). +#' #' @return A data.frame (or a list of these if x is a list) with the #' following columns: #' \itemize{ @@ -110,11 +116,12 @@ indicator_psdtype <- function(x, fit_lnorm = FALSE, xmin_bounds = NULL, best_by = "AIC", - wrap = FALSE) { + wrap = FALSE, + nbmask = "von_neumann") { if ( !merge && is.list(x) ) { return( lapply(x, indicator_psdtype, xmin, merge, fit_lnorm, xmin_bounds, - best_by, wrap) ) + best_by, wrap, nbmask) ) } # Here we do not test if x is not a matrix. This happens when merge = TRUE, @@ -134,19 +141,19 @@ indicator_psdtype <- function(x, } # Compute psd - psd <- patchsizes(x, merge = merge, wrap = wrap) + psd <- patchsizes(x, merge = merge, wrap = wrap, nbmask = nbmask) # Compute percolation point. If the user requested a merge of all # patch size distributions, then we return the proportion of matrices # with percolation. if ( is.list(x) ) { - percol <- lapply(x, percolation) + percol <- lapply(x, percolation, nbmask = nbmask) percol <- mean(unlist(percol)) - percol_empty <- lapply(x, function(x) percolation(!x)) + percol_empty <- lapply(x, function(x) percolation(!x, nbmask = nbmask)) percol_empty <- mean(unlist(percol_empty)) } else { - percol <- percolation(x) - percol_empty <- percolation(!x) + percol <- percolation(x, nbmask = nbmask) + percol_empty <- percolation(!x, nbmask = nbmask) } psdtype_result <- psdtype(psd, xmin, best_by, fit_lnorm) diff --git a/R/label.R b/R/label.R index eb06f5f3..c9897ea2 100644 --- a/R/label.R +++ b/R/label.R @@ -4,9 +4,11 @@ #' #' @param mat A binary matrix #' -#' @param nbmask a "neighboring mask": a matrix with odd dimensions describing -#' which cells are to be considered as neighbors around a cell -#' (see examples). +#' @param nbmask Either "moore" for 8-way neighborhood, "von_neumann" for four-way +#' neighborhood, or a square matrix with an odd number of lines and columns that +#' describes which neighbors are to be considered around a cell. Default +#' is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +#' above, below, on the right and on the left of the target cell). #' #' @param wrap Whether to wrap around lattice boundaries (`TRUE`/`FALSE`), #' effectively using periodic boundaries. @@ -32,21 +34,18 @@ #' display_matrix(label(rmat)) #' #' # With 8-way neighborhood mask and no wrapping around borders -#' nbmask8 <- matrix(c(1,1,1, -#' 1,0,1, -#' 1,1,1), ncol=3) -#' display_matrix(label(rmat, nbmask8, wrap = FALSE)) +#' display_matrix(label(rmat, "moore", wrap = FALSE)) #' #' # On real data: #' display_matrix(label(forestgap[[5]], nbmask8, wrap = FALSE)) #' #' @export label <- function(mat, - nbmask = matrix(c(0,1,0, - 1,0,1, - 0,1,0), ncol=3), # 4way NB + nbmask = "von_neumann", wrap = FALSE) { + nbmask <- parse_neighbor_spec(nbmask) + if ( ! is.logical(mat) ) { stop('Labelling of patches requirese a logical matrix', '(TRUE/FALSE values): please convert your data first.') @@ -105,9 +104,8 @@ label <- function(mat, #' matrix) #' #' @export -percolation <- function(mat, nbmask = matrix(c(0,1,0, - 1,0,1, - 0,1,0), ncol=3)) { +percolation <- function(mat, nbmask = "von_neumann") { + # We never wrap for percolation, by definition. patches <- label(mat, nbmask, wrap = FALSE) return(attr(patches, "percolation")) @@ -123,9 +121,10 @@ percolation <- function(mat, nbmask = matrix(c(0,1,0, #' @param merge Controls whether the obtained patch size distributions are to #' be pooled together if \code{mat} is a list of matrices. #' -#' @param nbmask a square matrix with an odd number of lines and columns that +#' @param nbmask Either "moore" for 8-way neighborhood, "von_neumann" for four-way +#' neighborhood, or a square matrix with an odd number of lines and columns that #' describes which neighbors are to be considered around a cell. Default -#' is 4-way neighborhood (the neighborhood of a cell comprises the cell +#' is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell #' above, below, on the right and on the left of the target cell). #' #' @param wrap Whether to wrap around lattice boundaries (`TRUE`/`FALSE`), @@ -147,22 +146,23 @@ percolation <- function(mat, nbmask = matrix(c(0,1,0, #' print( sapply(list_patches, mean)) # print the average patch size #' #' # Example with 8-way neighborhood -#' nbmask8 <- matrix(c(1,1,1, -#' 1,0,1, -#' 1,1,1), ncol = 3) -#' patchsizes(forestgap[[5]], nbmask = nbmask8) +#' patchsizes(forestgap[[5]], nbmask = "moore") +#' +#' # Same neighborhood as above, but specified in matrix form +#' moore_nb <- matrix(c(1, 1, 1, +#' 1, 0, 1, +#' 1, 1, 1), +#' nrow = 3, ncol = 3, byrow = TRUE) +#' patchsizes(forestgap[[5]], nbmask = moore_nb) #' -#' #' @export patchsizes <- function(mat, merge = FALSE, - nbmask = matrix(c(0,1,0, - 1,0,1, - 0,1,0), ncol = 3), # 4way neighborhood + nbmask = "von_neumann", wrap = FALSE) { if ( is.list(mat)) { - result <- lapply(mat, patchsizes) + result <- lapply(mat, patchsizes, merge, nbmask, wrap) if (merge) { # This always works even if there is only one element result <- do.call(c, result) @@ -181,3 +181,41 @@ patchsizes <- function(mat, return(attr(map, "psd")) } + + +parse_neighbor_spec <- function(spec) { + + moore_nb <- matrix(c(1, 1, 1, + 1, 0, 1, + 1, 1, 1), + nrow = 3, ncol = 3, byrow = TRUE) + von_neumann <- matrix(c(0, 1, 0, + 1, 0, 1, + 0, 1, 0), + nrow = 3, ncol = 3, byrow = TRUE) + + if ( is.matrix(spec) ) { + + if( nrow(spec) == 3 && ncol(spec) == 3 ) { + return(spec) + } + } + + if ( is.numeric(spec) && spec == 4 ) { + spec <- "von_neumann" + } + + if ( is.numeric(spec) && spec == 8 ) { + spec <- "moore" + } + + if ( is.character(spec) && spec == "moore" ) { + return(moore_nb) + } + + if ( is.character(spec) && spec == "von_neumann" ) { + return(von_neumann) + } + + stop("Unknown neighborhood specification") +} diff --git a/R/null_model_helpers.R b/R/null_model_helpers.R index 6709d217..a2af71fd 100644 --- a/R/null_model_helpers.R +++ b/R/null_model_helpers.R @@ -154,6 +154,7 @@ generate_nulls <- function(input, indicf, nulln, null_method, # mat_tab <- mat_tab[sub, ] null_mod <- mgcv::gam(value ~ s(row, col, bs = "tp"), data = mat_tab, +# control = mgcv::gam.control(trace = TRUE), family = null_control[["family"]]) get_nullmat <- create_nullmat_generator(input, null_mod, diff --git a/R/task_patch_indic.R b/R/task_patch_indic.R index 01d31044..d6ab2592 100644 --- a/R/task_patch_indic.R +++ b/R/task_patch_indic.R @@ -27,6 +27,12 @@ #' @param wrap Determines whether patches are considered to wrap around the #' matrix when reaching the side #' +#' @param nbmask Either "moore" for 8-way neighborhood, "von_neumann" for four-way +#' neighborhood (default), or a square matrix with an odd number of lines and columns +#' that describes which neighbors are to be considered around a cell. Default +#' is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +#' above, below, on the right and on the left of the target cell). +#' #' @return A list object of class 'psdfit' containing among other things #' - the observed patch size distribution data #' - the model outputs for the candidate distribution fits @@ -138,13 +144,14 @@ patchdistr_sews <- function(mat, best_by = "BIC", xmin = 1, # a number, or "estimate" option xmin_bounds = NULL, - wrap = FALSE) { + wrap = FALSE, + nbmask = "von_neumann") { # If input is a list -> apply on each element - if ( !merge & is.list(mat)) { + if ( ( ! merge ) && is.list(mat)) { results <- future_lapply_seed(mat, patchdistr_sews, merge, fit_lnorm, best_by, xmin, - xmin_bounds, wrap) + xmin_bounds, wrap, nbmask) class(results) <- c('patchdistr_sews_list', 'sews_result_list') return(results) } @@ -159,7 +166,7 @@ patchdistr_sews <- function(mat, } # Get patch size distribution - psd <- patchsizes(mat, merge = merge, wrap = wrap) + psd <- patchsizes(mat, merge = merge, wrap = wrap, nbmask = nbmask) # Set bounds to search for xmin if ( length(psd) > 0 && is.null(xmin_bounds) ) { @@ -175,13 +182,13 @@ patchdistr_sews <- function(mat, # Compute percolation if ( is.list(mat) ) { - percol <- lapply(mat, percolation) + percol <- lapply(mat, percolation, nbmask = nbmask) percol <- mean(unlist(percol)) - percol_empty <- lapply(mat, function(mat) percolation(!mat)) + percol_empty <- lapply(mat, function(mat) percolation(!mat, nbmask = nbmask)) percol_empty <- mean(unlist(percol_empty)) } else { - percol <- percolation(mat) - percol_empty <- percolation(!mat) + percol <- percolation(mat, nbmask = nbmask) + percol_empty <- percolation(!mat, nbmask = nbmask) } # Compute the mean cover diff --git a/man/indicator_psdtype.Rd b/man/indicator_psdtype.Rd index 6137815c..a8de8e6d 100755 --- a/man/indicator_psdtype.Rd +++ b/man/indicator_psdtype.Rd @@ -11,7 +11,8 @@ indicator_psdtype( fit_lnorm = FALSE, xmin_bounds = NULL, best_by = "AIC", - wrap = FALSE + wrap = FALSE, + nbmask = "von_neumann" ) } \arguments{ @@ -34,6 +35,12 @@ the whole range of observed patch sizes)} \item{wrap}{Determines whether patches are considered to wrap around the matrix when reaching the side} + +\item{nbmask}{Either "moore" for 8-way neighborhood, "von_neumann" for four-way +neighborhood (default), or a square matrix with an odd number of lines and columns +that describes which neighbors are to be considered around a cell. Default +is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +above, below, on the right and on the left of the target cell).} } \value{ A data.frame (or a list of these if x is a list) with the diff --git a/man/label.Rd b/man/label.Rd index 60f9e5bc..91a41d1f 100755 --- a/man/label.Rd +++ b/man/label.Rd @@ -5,20 +5,18 @@ \alias{percolation} \title{Labelling of unique patches and detection of percolation.} \usage{ -label( - mat, - nbmask = matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), ncol = 3), - wrap = FALSE -) +label(mat, nbmask = "von_neumann", wrap = FALSE) -percolation(mat, nbmask = matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), ncol = 3)) +percolation(mat, nbmask = "von_neumann") } \arguments{ \item{mat}{A binary matrix} -\item{nbmask}{a "neighboring mask": a matrix with odd dimensions describing -which cells are to be considered as neighbors around a cell -(see examples).} +\item{nbmask}{Either "moore" for 8-way neighborhood, "von_neumann" for four-way +neighborhood, or a square matrix with an odd number of lines and columns that +describes which neighbors are to be considered around a cell. Default +is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +above, below, on the right and on the left of the target cell).} \item{wrap}{Whether to wrap around lattice boundaries (`TRUE`/`FALSE`), effectively using periodic boundaries.} @@ -51,10 +49,7 @@ rmat <- matrix(rnorm(100) > .1, ncol = 10) display_matrix(label(rmat)) # With 8-way neighborhood mask and no wrapping around borders -nbmask8 <- matrix(c(1,1,1, - 1,0,1, - 1,1,1), ncol=3) -display_matrix(label(rmat, nbmask8, wrap = FALSE)) +display_matrix(label(rmat, "moore", wrap = FALSE)) # On real data: display_matrix(label(forestgap[[5]], nbmask8, wrap = FALSE)) diff --git a/man/patchdistr_sews.Rd b/man/patchdistr_sews.Rd index e00e94ea..4f48298c 100755 --- a/man/patchdistr_sews.Rd +++ b/man/patchdistr_sews.Rd @@ -11,7 +11,8 @@ patchdistr_sews( best_by = "BIC", xmin = 1, xmin_bounds = NULL, - wrap = FALSE + wrap = FALSE, + nbmask = "von_neumann" ) } \arguments{ @@ -38,6 +39,12 @@ distributions} \item{wrap}{Determines whether patches are considered to wrap around the matrix when reaching the side} + +\item{nbmask}{Either "moore" for 8-way neighborhood, "von_neumann" for four-way +neighborhood (default), or a square matrix with an odd number of lines and columns +that describes which neighbors are to be considered around a cell. Default +is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell +above, below, on the right and on the left of the target cell).} } \value{ A list object of class 'psdfit' containing among other things diff --git a/man/patchsizes.Rd b/man/patchsizes.Rd index 08ee749e..a9e293a4 100755 --- a/man/patchsizes.Rd +++ b/man/patchsizes.Rd @@ -4,12 +4,7 @@ \alias{patchsizes} \title{Get patch sizes.} \usage{ -patchsizes( - mat, - merge = FALSE, - nbmask = matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), ncol = 3), - wrap = FALSE -) +patchsizes(mat, merge = FALSE, nbmask = "von_neumann", wrap = FALSE) } \arguments{ \item{mat}{A logical matrix or a list of such matrices.} @@ -17,9 +12,10 @@ patchsizes( \item{merge}{Controls whether the obtained patch size distributions are to be pooled together if \code{mat} is a list of matrices.} -\item{nbmask}{a square matrix with an odd number of lines and columns that +\item{nbmask}{Either "moore" for 8-way neighborhood, "von_neumann" for four-way +neighborhood, or a square matrix with an odd number of lines and columns that describes which neighbors are to be considered around a cell. Default -is 4-way neighborhood (the neighborhood of a cell comprises the cell +is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell above, below, on the right and on the left of the target cell).} \item{wrap}{Whether to wrap around lattice boundaries (`TRUE`/`FALSE`), @@ -43,11 +39,14 @@ list_patches <- patchsizes(forestgap) # get the patch size for each matrix print( sapply(list_patches, mean)) # print the average patch size # Example with 8-way neighborhood -nbmask8 <- matrix(c(1,1,1, - 1,0,1, - 1,1,1), ncol = 3) -patchsizes(forestgap[[5]], nbmask = nbmask8) - +patchsizes(forestgap[[5]], nbmask = "moore") + +# Same neighborhood as above, but specified in matrix form +moore_nb <- matrix(c(1, 1, 1, + 1, 0, 1, + 1, 1, 1), + nrow = 3, ncol = 3, byrow = TRUE) +patchsizes(forestgap[[5]], nbmask = moore_nb) } \seealso{ From 0e7f152b5b6be520d6a133d343e76beabdd8b8a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandre=20G=C3=A9nin?= Date: Sun, 2 Jul 2023 16:59:22 +0200 Subject: [PATCH 2/5] Add missing test + minor improvementi in doc --- R/task_patch_indic.R | 5 ++--- man/patchdistr_sews.Rd | 5 ++--- tests/testthat/test-patches.R | 29 +++++++++++++++++++++++++++++ 3 files changed, 33 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/test-patches.R diff --git a/R/task_patch_indic.R b/R/task_patch_indic.R index d6ab2592..36d21670 100644 --- a/R/task_patch_indic.R +++ b/R/task_patch_indic.R @@ -29,9 +29,8 @@ #' #' @param nbmask Either "moore" for 8-way neighborhood, "von_neumann" for four-way #' neighborhood (default), or a square matrix with an odd number of lines and columns -#' that describes which neighbors are to be considered around a cell. Default -#' is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell -#' above, below, on the right and on the left of the target cell). +#' that describes which neighbors are to be considered around a cell. See +#' \code{\link{patchsizes}} for details on how to specify more advanced neighborhoods. #' #' @return A list object of class 'psdfit' containing among other things #' - the observed patch size distribution data diff --git a/man/patchdistr_sews.Rd b/man/patchdistr_sews.Rd index 4f48298c..2503b9d9 100755 --- a/man/patchdistr_sews.Rd +++ b/man/patchdistr_sews.Rd @@ -42,9 +42,8 @@ matrix when reaching the side} \item{nbmask}{Either "moore" for 8-way neighborhood, "von_neumann" for four-way neighborhood (default), or a square matrix with an odd number of lines and columns -that describes which neighbors are to be considered around a cell. Default -is 4-way or Von Neumann neighborhood (the neighborhood of a cell comprises the cell -above, below, on the right and on the left of the target cell).} +that describes which neighbors are to be considered around a cell. See +\code{\link{patchsizes}} for details on how to specify more advanced neighborhoods.} } \value{ A list object of class 'psdfit' containing among other things diff --git a/tests/testthat/test-patches.R b/tests/testthat/test-patches.R new file mode 100644 index 00000000..46afca92 --- /dev/null +++ b/tests/testthat/test-patches.R @@ -0,0 +1,29 @@ +# +# Misc tests with working with patch sizes +# + +test_that("Labelling functions & friends work correctly", { + + n <- 512 + m <- matrix(rnorm(n*n) > 0.3, nrow = n, ncol = n) + + # Make sure args are dispatched correctly + X <- patchsizes(list(m, m), nbmask = "moore", wrap = TRUE) + expect_true({ + all(X[[1]] == X[[2]]) + }) + + # Make sure the type of neighborhood is passed even when using high-level + # functions + options(spatialwarnings.constants.maxit = 1e9L) + x1 <- patchdistr_sews(m) + x2 <- patchdistr_sews(m, nbmask = "moore") + expect_true({ + x1[["npatches"]] > x2[["npatches"]] + }) + + options(spatialwarnings.constants.maxit = NULL) + + + +}) From 5755648a1c9242a0f331c9e2ae1ebe29f88bb3c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandre=20G=C3=A9nin?= Date: Sun, 2 Jul 2023 17:05:23 +0200 Subject: [PATCH 3/5] Improve testing --- tests/testthat/test-patches.R | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-patches.R b/tests/testthat/test-patches.R index 46afca92..c19d4d04 100644 --- a/tests/testthat/test-patches.R +++ b/tests/testthat/test-patches.R @@ -13,6 +13,7 @@ test_that("Labelling functions & friends work correctly", { all(X[[1]] == X[[2]]) }) + # Make sure the type of neighborhood is passed even when using high-level # functions options(spatialwarnings.constants.maxit = 1e9L) @@ -21,9 +22,31 @@ test_that("Labelling functions & friends work correctly", { expect_true({ x1[["npatches"]] > x2[["npatches"]] }) - options(spatialwarnings.constants.maxit = NULL) + m <- matrix(c(1, 0, 0, + 0, 1, 1, + 0, 0, 0) > 0, + ncol = 3, nrow = 3, byrow = TRUE) + + expect_true({ + length(patchsizes(m)) == 2 && all(patchsizes(m) == c(1, 2)) + }) + + expect_true({ + length(patchsizes(m, nbmask = "moore")) == 1 && patchsizes(m, nbmask = "moore") == 3 + }) + + m <- matrix(c(1, 0, 0, + 0, 0, 1, + 0, 0, 0) > 0, + ncol = 3, nrow = 3, byrow = TRUE) + + expect_true({ + a <- patchdistr_sews(m, nbmask = "moore", wrap = TRUE) + a[["npatches"]] == 1 + }) + }) From 3ff6685ab7dd09bb5c7a40c2c972ce65680ca8bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandre=20G=C3=A9nin?= Date: Sun, 2 Jul 2023 17:22:30 +0200 Subject: [PATCH 4/5] Small improvements + improve NEWS --- NEWS | 5 +++++ src/norm_constants.cpp | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index f640e187..361d7135 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,11 @@ spatialwarnings v3.1.0 (Release date: unknown) This release has received external contributions from K. Siteur +Improvements: + + * The type of neighborhood can now be specified in all patch-related functions, + including high-level functions (e.g. patchdistr_sews) + New indicators: * Clustering of pairs (e.g. Schneider et al. 2016) diff --git a/src/norm_constants.cpp b/src/norm_constants.cpp index 57d7a72f..6733af32 100755 --- a/src/norm_constants.cpp +++ b/src/norm_constants.cpp @@ -62,7 +62,7 @@ double tplinfsum(double expo, // Emit warning if we hit k_stop if ( k == k_stop ) { Rcpp::Function warning("warning"); - warning("Maximum number of iterations reached in tplinfsum, increase with options(spatialwarnings.constants.maxit = "); + warning("Maximum number of iterations reached in tplinfsum, increase above default (1e8) with options(spatialwarnings.constants.maxit = "); } return(total); From 607523388e544e2b3993be447c808b116e2c191d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandre=20G=C3=A9nin?= Date: Mon, 3 Jul 2023 12:32:56 +0200 Subject: [PATCH 5/5] Fix example --- R/label.R | 2 +- man/label.Rd | 2 +- tests/testthat/test-patches.R | 5 +++++ 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/label.R b/R/label.R index c9897ea2..265db140 100644 --- a/R/label.R +++ b/R/label.R @@ -37,7 +37,7 @@ #' display_matrix(label(rmat, "moore", wrap = FALSE)) #' #' # On real data: -#' display_matrix(label(forestgap[[5]], nbmask8, wrap = FALSE)) +#' display_matrix(label(forestgap[[5]], "moore", wrap = FALSE)) #' #' @export label <- function(mat, diff --git a/man/label.Rd b/man/label.Rd index 91a41d1f..0c5ab4a4 100755 --- a/man/label.Rd +++ b/man/label.Rd @@ -52,7 +52,7 @@ display_matrix(label(rmat)) display_matrix(label(rmat, "moore", wrap = FALSE)) # On real data: -display_matrix(label(forestgap[[5]], nbmask8, wrap = FALSE)) +display_matrix(label(forestgap[[5]], "moore", wrap = FALSE)) } \seealso{ diff --git a/tests/testthat/test-patches.R b/tests/testthat/test-patches.R index c19d4d04..99a75814 100644 --- a/tests/testthat/test-patches.R +++ b/tests/testthat/test-patches.R @@ -42,6 +42,11 @@ test_that("Labelling functions & friends work correctly", { 0, 0, 0) > 0, ncol = 3, nrow = 3, byrow = TRUE) + expect_true({ + a <- patchdistr_sews(m, nbmask = "von_neumann", wrap = TRUE) + a[["npatches"]] == 2 + }) + expect_true({ a <- patchdistr_sews(m, nbmask = "moore", wrap = TRUE) a[["npatches"]] == 1