From 006b2e3e8e45e43766f564016cfd5d315264e501 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Sat, 18 Dec 2021 18:27:05 -0700 Subject: [PATCH 1/9] Added 'terra' package to Imports in DESCRIPTION. --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 786c4ed..61e83d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,8 @@ Imports: tibble, fasterize, sf, - Rcpp + Rcpp, + terra URL: https://ropensci.github.io/NLMR/ BugReports: https://github.com/ropensci/NLMR/issues/ Suggests: From 407a1a85c9e8aaa5d076fffb9c0345da7086fa44 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Sun, 19 Dec 2021 21:01:23 -0700 Subject: [PATCH 2/9] Revised nlm_percolation to return a SpatRaster object. The only major difference is the need to specify a crs by default. --- R/nlm_percolation.R | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/R/nlm_percolation.R b/R/nlm_percolation.R index 25f27b5..79a180c 100755 --- a/R/nlm_percolation.R +++ b/R/nlm_percolation.R @@ -10,6 +10,8 @@ #' Resolution of the raster. #' @param prob [\code{numerical(1)}]\cr #' Probability value for setting a cell to 1. +#' @param crs [\code{character(1)}]\cr +#' Coordinate reference system for new raster. If blank, defaults to WGS 84. #' #' @details #' The simulation of a random percolation map is accomplished in two steps: @@ -22,7 +24,7 @@ #' TRUE - if it is higher the cell is set to FALSE.} #' } #' -#' @return RasterLayer +#' @return SpatRaster #' #' @examples #' # simulate percolation model @@ -49,7 +51,8 @@ nlm_percolation <- function(ncol, nrow, resolution = 1, - prob = 0.5) { + prob = 0.5, + crs = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs") { # Check function arguments ---- checkmate::assert_count(ncol, positive = TRUE) @@ -57,27 +60,15 @@ nlm_percolation <- function(ncol, checkmate::assert_numeric(resolution) checkmate::assert_true(prob <= 1, na.ok = FALSE) checkmate::assert_true(prob >= 0, na.ok = FALSE) - - percolation_matrix <- matrix(NA, nrow = nrow, ncol = ncol) - - percolation_matrix[] <- vapply( - percolation_matrix, - function(x) { - ifelse(stats::runif(1, 0, 1) < prob, TRUE, FALSE) - }, - logical(1) - ) - - percolation_raster <- - raster::raster(percolation_matrix) - - # specify resolution ---- - raster::extent(percolation_raster) <- c( - 0, - ncol(percolation_raster) * resolution, - 0, - nrow(percolation_raster) * resolution - ) + + percolation_raster = terra::rast(nrows = nrow, ncols = ncol, nlyrs=1, + resolution = resolution, + extent = c(0, ncol * resolution, + 0, nrow * resolution), + vals = sample(c(0,1), + size = ncol * nrow, + replace = T, + prob = c(1-prob, prob))) return(percolation_raster) } From 2d68ac12d34859ed74317f7764b47617431ea83b Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Sun, 19 Dec 2021 21:49:40 -0700 Subject: [PATCH 3/9] Basic working function modified to use terra. Still need to add rescaling functionality, and a new arg for the crs. --- R/nlm_randomcluster.R | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/R/nlm_randomcluster.R b/R/nlm_randomcluster.R index a1ce515..1a8955a 100644 --- a/R/nlm_randomcluster.R +++ b/R/nlm_randomcluster.R @@ -68,23 +68,26 @@ nlm_randomcluster <- function(ncol, nrow, ranclumap <- nlm_percolation(ncol, nrow, p, resolution = resolution) # Step B - Cluster identification (clustering of adjoining pixels) - ranclumap <- raster::clump(ranclumap, direction = neighbourhood, gaps = FALSE) - + ranclumap <- terra::patches(x = ranclumap, directions = neighbourhood, zeroAsNA = T) + #terra::values(ranclumap)[is.na(terra::values(ranclumap))] <- 0 + # Step C - Cluster type assignation # number of different cluster - numclu <- max(raster::values(ranclumap), na.rm = TRUE) + numclu <- length(unique(ranclumap[][!is.na(ranclumap[])])) # assign to each cluster nr a new category given by Ai clutyp <- sample(seq_along(ai), numclu, replace = TRUE, prob = ai) # write back new category nr - raster::values(ranclumap) <- clutyp[raster::values(ranclumap)] + class_df <- data.frame('is' = unique(ranclumap[][!is.na(ranclumap[])]), + 'becomes' = clutyp) + ranclumap <- classify(ranclumap, rcl = class_df, include.lowest=T) # Step D - Filling the map # helperfuction to choose values fillit <- function(cid) { # get neighbour cells - nbrs <- raster::adjacent(ranclumap, cid, directions = 8, pairs = FALSE) + nbrs <- terra::adjacent(ranclumap, cid, directions = 8, pairs = FALSE) # count neighbour values (exclude NA see Saura 2000 paper) - vals <- table(raster::values(ranclumap)[nbrs]) + vals <- table(terra::values(ranclumap)[nbrs]) # check if everything is NA if (!length(vals)) { # be a rebel get your own value @@ -103,24 +106,24 @@ nlm_randomcluster <- function(ncol, nrow, # identify unfilled cells gaps <- dplyr::rowwise(tibble::tibble( - ctf = (1:(ncol * nrow))[is.na(raster::values(ranclumap))] + ctf = (1:(ncol * nrow))[is.na(terra::values(ranclumap))] )) # get values for the gaps gaps <- dplyr::mutate(gaps, val = fillit(ctf)) # feed it back in the map - raster::values(ranclumap)[gaps$ctf] <- gaps$val + terra::values(ranclumap)[gaps$ctf] <- gaps$val # specify resolution ---- - raster::extent(ranclumap) <- c( - 0, - ncol(ranclumap) * resolution, - 0, - nrow(ranclumap) * resolution - ) + # raster::extent(ranclumap) <- c( + # 0, + # ncol(ranclumap) * resolution, + # 0, + # nrow(ranclumap) * resolution + # ) # Rescale values to 0-1 ---- if (rescale == TRUE) { - ranclumap <- util_rescale(ranclumap) + ranclumap <- ranclumap } return(ranclumap) From aba9a44725d2b2264828d56387d90f5185dcee00 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Mon, 20 Dec 2021 11:19:58 -0700 Subject: [PATCH 4/9] Updated arguments, implemented a simple rescale function. --- R/nlm_randomcluster.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/nlm_randomcluster.R b/R/nlm_randomcluster.R index 1a8955a..3e4b333 100644 --- a/R/nlm_randomcluster.R +++ b/R/nlm_randomcluster.R @@ -18,8 +18,10 @@ #' This directly controls the number of types via the given length. #' @param rescale [\code{logical(1)}]\cr #' If \code{TRUE} (default), the values are rescaled between 0-1. +#' @param crs [\code{character(1)}]\cr +#' The crs for the new raster. If blank, defaults to WGS 84. #' -#' @return Raster with random values ranging from 0-1. +#' @return SpatRaster with random values ranging from 0-1. #' #' @details #' This is a direct implementation of steps A - D of the modified random clusters algorithm @@ -52,7 +54,8 @@ nlm_randomcluster <- function(ncol, nrow, p, ai = c(0.5, 0.5), neighbourhood = 4, - rescale = TRUE) { + rescale = TRUE, + crs = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs") { # Check function arguments ---- checkmate::assert_count(ncol, positive = TRUE) @@ -65,7 +68,7 @@ nlm_randomcluster <- function(ncol, nrow, checkmate::assert_logical(rescale) # Step A - Create percolation map - ranclumap <- nlm_percolation(ncol, nrow, p, resolution = resolution) + ranclumap <- nlm_percolation(ncol, nrow, p, resolution = resolution, crs = crs) # Step B - Cluster identification (clustering of adjoining pixels) ranclumap <- terra::patches(x = ranclumap, directions = neighbourhood, zeroAsNA = T) @@ -123,7 +126,7 @@ nlm_randomcluster <- function(ncol, nrow, # Rescale values to 0-1 ---- if (rescale == TRUE) { - ranclumap <- ranclumap + ranclumap <- ranclumap / max(ranclumap[]) } return(ranclumap) From 1d4a916c39a14b16fc682ed1c24e3740b1a73354 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Tue, 21 Dec 2021 13:47:18 -0700 Subject: [PATCH 5/9] Added terra:: to classify for compatability with larger workflows. --- R/nlm_randomcluster.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/nlm_randomcluster.R b/R/nlm_randomcluster.R index 3e4b333..73d7f9e 100644 --- a/R/nlm_randomcluster.R +++ b/R/nlm_randomcluster.R @@ -82,7 +82,7 @@ nlm_randomcluster <- function(ncol, nrow, # write back new category nr class_df <- data.frame('is' = unique(ranclumap[][!is.na(ranclumap[])]), 'becomes' = clutyp) - ranclumap <- classify(ranclumap, rcl = class_df, include.lowest=T) + ranclumap <- terra::classify(ranclumap, rcl = class_df, include.lowest=T) # Step D - Filling the map # helperfuction to choose values From 74e855c2f86bf8989a5875c0d17ad7e14a2ab1e4 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Tue, 21 Dec 2021 15:30:17 -0700 Subject: [PATCH 6/9] Added crs argument to terra::rast call in percolation_raster --- R/nlm_percolation.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/nlm_percolation.R b/R/nlm_percolation.R index 79a180c..294f551 100755 --- a/R/nlm_percolation.R +++ b/R/nlm_percolation.R @@ -65,6 +65,7 @@ nlm_percolation <- function(ncol, resolution = resolution, extent = c(0, ncol * resolution, 0, nrow * resolution), + crs = crs, vals = sample(c(0,1), size = ncol * nrow, replace = T, From a5a76f068ba07757ed99fbcc176f901a68982b7a Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Thu, 23 Dec 2021 10:28:44 -0700 Subject: [PATCH 7/9] merge from upstream --- tests/testthat.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat.R b/tests/testthat.R index 3c66efe..d561581 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ -library(testthat) -library(NLMR) - -test_check("NLMR") +library(testthat) +library(NLMR) + +test_check("NLMR") From f3d85cf0f509c78dc8c22bc106fc691f2bcdeec3 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Thu, 23 Dec 2021 10:33:24 -0700 Subject: [PATCH 8/9] Revised percolation test to work with terra. --- tests/testthat/test_percolation.R | 44 +++++++++++++++---------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/tests/testthat/test_percolation.R b/tests/testthat/test_percolation.R index 0c245bd..94901af 100644 --- a/tests/testthat/test_percolation.R +++ b/tests/testthat/test_percolation.R @@ -1,22 +1,22 @@ -# nolint start -context("nlm_percolation") - -percolation <- nlm_percolation(ncol = 9, nrow = 12, prob = 0.5) - -test_that("nlm_percolation behaves like it should", { - expect_that(percolation , is_a("RasterLayer")) -}) - -test_that("nlm_percolation produces the right number of rows", { - expect_equal(percolation@nrows, 12) -}) - -test_that("nlm_percolation produces the right number of columns", { - expect_equal(percolation@ncols, 9) -}) - -test_that("nlm_percolation produces the right number of columns", { - expect_equal(length(unique(percolation@data@values)), 2) -}) - -# nolint end +# nolint start +context("nlm_percolation") + +percolation <- nlm_percolation(ncol = 9, nrow = 12, prob = 0.5) + +test_that("nlm_percolation behaves like it should", { + expect_that(percolation , is_a("SpatRaster")) +}) + +test_that("nlm_percolation produces the right number of rows", { + expect_equal(terra::nrow(percolation), 12) +}) + +test_that("nlm_percolation produces the right number of columns", { + expect_equal(terra::ncol(percolation), 9) +}) + +test_that("nlm_percolation produces the right number of columns", { + expect_equal(length(unique(terra::values(percolation))), 2) +}) + +# nolint end From f75a390a10d8d806bc78ed1631e13ba8cfacf5b2 Mon Sep 17 00:00:00 2001 From: chrismallon <15743083+chrismallon@users.noreply.github.com> Date: Thu, 23 Dec 2021 10:46:20 -0700 Subject: [PATCH 9/9] Added terra tests for test_randomcluster.R --- tests/testthat/test_randomcluster.R | 57 +++++++++++++++++++---------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/tests/testthat/test_randomcluster.R b/tests/testthat/test_randomcluster.R index cc2dcba..5f932bd 100644 --- a/tests/testthat/test_randomcluster.R +++ b/tests/testthat/test_randomcluster.R @@ -1,19 +1,38 @@ -# nolint start -context("nlm_randomcluster") - -suppressWarnings(random_cluster <- nlm_randomcluster(ncol = 40, nrow = 30, - neighbourhood = 4, p = 0.4)) - -test_that("nlm_randomcluster behaves like it should", { - expect_that(random_cluster , is_a("RasterLayer")) -}) - -test_that("nlm_randomcluster produces the right number of rows", { - expect_equal(random_cluster@nrows, 30) -}) - -test_that("nlm_randomcluster produces the right number of columns", { - expect_equal(random_cluster@ncols, 40) -}) - -# nolint end +# nolint start +context("nlm_randomcluster") + +suppressWarnings(random_cluster <- nlm_randomcluster(ncol = 300, nrow = 250, + neighbourhood = 4, p = 0.4, ai = c(0.1, 0.3, 0.6), + rescale = F)) + +test_that("nlm_randomcluster behaves like it should", { + expect_that(random_cluster , is_a("SpatRaster")) +}) + +test_that("nlm_randomcluster produces the right number of rows", { + expect_equal(terra::nrow(random_cluster), 250) +}) + +test_that("nlm_randomcluster produces the right number of columns", { + expect_equal(terra::ncol(random_cluster), 300) +}) + +test_that("nlm_randomcluster produces expected values", { + expect_equal(length(unique(terra::values(random_cluster))), 3) +}) + +test_that("nlm_randomcluster produces proportions within 0.05 of expected", { + expect_equal(terra::freq(random_cluster)[,3][1] / length(terra::values(random_cluster)), + 0.1, tolerance = 0.05) +}) + +test_that("nlm_randomcluster produces proportions within 0.05 of expected", { + expect_equal(terra::freq(random_cluster)[,3][2] / length(terra::values(random_cluster)), + 0.3, tolerance = 0.05) +}) + +test_that("nlm_randomcluster produces proportions within 0.05 of expected", { + expect_equal(terra::freq(random_cluster)[,3][3] / length(terra::values(random_cluster)), + 0.6, tolerance = 0.05) +}) +# nolint end