Nothing
#' translate_raster
#'
#' @description Torus translation
#'
#' @param raster RasterLayer with discrete habitat classes.
#' @param steps_x,steps_y Integer with number of steps (cells) the raster is translated
#' into the corresponding direction. If both are null, all possible combinations are used
#' resulting in n = ((50 + 1) * (50 + 1)) - 4 rasters.
#' @param return_input Logical if the original input data is returned.
#' @param simplify Logical if only the raster will be returned if \code{n_random = 1}
#' and \code{return_input = FALSE}.
#' @param verbose Logical if progress report is printed.
#'
#' @details
#' Torus translation test as described in Harms et al. (2001). The raster is shifted
#' in all four cardinal directions by steps equal to the raster resolution. If a cell
#' exits the extent on one side, it enters the extent on the opposite side.
#'
#' The method does not allow any NA values to be present in the RasterLayer.
#'
#' @seealso
#' \code{\link{randomize_raster}}
#'
#' @return rd_ras
#'
#' @examples
#' \dontrun{
#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
#'
#' landscape_random <- translate_raster(landscape_classified)
#' landscape_random_sub <- translate_raster(landscape_classified,
#' steps_x = 1:10, steps_y = 1:5)
#' }
#'
#' @aliases translate_raster
#' @rdname translate_raster
#'
#' @references
#' Harms, K.E., Condit, R., Hubbell, S.P., Foster, R.B., 2001. Habitat associations
#' of trees and shrubs in a 50-ha neotropical forest plot. Journal of Ecology 89, 947–959.
#' <https://doi.org/10.1111/j.1365-2745.2001.00615.x>
#'
#' @export
translate_raster <- function(raster, steps_x = NULL, steps_y = NULL,
return_input = TRUE, simplify = FALSE,
verbose = TRUE) {
# stop if NA are present
if (anyNA(raster@data@values)) {
stop("NA values are not allowed for 'translate_raster()'.", call. = FALSE)
}
habitats <- sort(table(raster@data@values, useNA = "no")) # get table of habitats
# print warning if more than 10 classes are present
if (verbose) {
if (length(habitats) > 10) {
warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
call. = FALSE)
}
}
# use all possible combinations
if (is.null(steps_x) & is.null(steps_y)) {
steps_x <- seq(from = 0, to = raster::ncol(raster), by = 1) # all steps in x-direction
steps_y <- seq(from = 0, to = raster::nrow(raster), by = 1) # all steps in y-direction
steps_xy <- expand.grid(x = steps_x, y = steps_y) # grid with all possible x-y combinations
# remove combinations identical to original raster
steps_xy <- steps_xy[-c(1, length(steps_x), max(steps_x) * length(steps_y) + 1, length(steps_x) * length(steps_y)),]
} else {
if (is.null(steps_x)) {steps_x <- 0}
if (is.null(steps_y)) {steps_y <- 0}
steps_xy <- expand.grid(x = steps_x, y = steps_y) # grid with all possible x-y combinations
# remove combinations identical to original raster
remove_id <- c(which(steps_xy[, 1] + steps_xy[, 2] == 0),
which(steps_xy[, 1] + steps_xy[, 2] == raster::ncol(raster) + raster::nrow(raster)),
which(steps_xy[, 1] == 0 & steps_xy[, 2] == raster::ncol(raster)),
which(steps_xy[, 2] == 0 & steps_xy[, 1] == raster::nrow(raster)))
if (length(remove_id) > 0) {
steps_xy <- steps_xy[-remove_id, ]
}
}
matrix_raster <- raster::as.matrix(raster) # convert to matrix
# loop through all possible steps
result_list <- lapply(seq_len(nrow(steps_xy)), function(current_row) {
x_shift <- steps_xy[current_row, 1] - (ncol(matrix_raster) *
(steps_xy[current_row, 1] %/% ncol(matrix_raster)))
y_shift <- steps_xy[current_row, 2] - (nrow(matrix_raster) *
(steps_xy[current_row, 2] %/% nrow(matrix_raster)))
if (x_shift == 0) {matrix_shifted <- matrix_raster}
else {matrix_shifted <- cbind(matrix_raster[, (x_shift + 1):dim(matrix_raster)[2]],
matrix_raster[, seq_len(x_shift)])}
if (y_shift == 0) {matrix_shifted <- matrix_shifted}
else{matrix_shifted <- rbind(matrix_shifted[(y_shift + 1):dim(matrix_shifted)[1], ],
matrix_shifted[seq_len(y_shift), ])}
# convert back to raster
raster_shifted <- raster::raster(matrix_shifted,
xmn = raster::xmin(raster), xmx = raster::xmax(raster),
ymn = raster::ymin(raster), ymx = raster::ymax(raster))
# print progress
if (verbose) {
message("\r> Progress: n_random: ", current_row, "/", nrow(steps_xy), "\t\t",
appendLF = FALSE)
}
return(raster_shifted)
})
n_random <- length(result_list)
# set names of randomization randomized_1 ... randomized_n
names(result_list) <- paste0("randomized_", seq_along(result_list))
# combine to one list
randomization <- list(randomized = result_list, observed = raster,
method = "translate_raster()")
# set class of result
class(randomization) <- "rd_ras"
# remove input if return_input = FALSE
if (!return_input) {
# set observed to NA
randomization$observed <- "NA"
# check if output should be simplified
if (simplify) {
# not possible if more than one raster is present
if (n_random > 1 && verbose) {
warning("'simplify = TRUE' not possible for 'n_random > 1'.",
call. = FALSE)
# only one random raster is present that should be returend
} else if (n_random == 1) {
randomization <- randomization$randomized[[1]]
}
}
}
# return input if return_input = TRUE
else {
# return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
if (simplify && verbose) {
warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
}
}
# write result in new line if progress was printed
if (verbose) {
message("\r")
}
return(randomization)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.