Skip to content

Commit

Permalink
Merge pull request #179 from r-spatialecology/master
Browse files Browse the repository at this point in the history 
Update v1.4.4
  • Loading branch information
@mhesselbarth
mhesselbarth authored May 14, 2020
2 parents 9dc024f + b236794 commit 8fe4b89
Show file tree
Hide file tree
Showing 29 changed files with 188 additions and 103 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
Type: Package
Package: landscapemetrics
Title: Landscape Metrics for Categorical Map Patterns
Version: 1.4.3
Version: 1.4.4
Authors@R: c(person("Maximillian H.K.", "Hesselbarth",
role = c("aut", "cre"),
email = "maximilian.hesselbarth@uni-goettingen.de",
email = "mhk.hesselbarth@gmail.com",
comment = c(ORCID = "0000-0003-1125-9918")),
person("Marco", "Sciaini",
role = "aut",
Expand Down Expand Up @@ -36,7 +36,7 @@ Authors@R: c(person("Maximillian H.K.", "Hesselbarth",
role = "ctb",
comment = "Bugfix in sample_metrics()")
)
Maintainer: Maximillian H.K. Hesselbarth <maximilian.hesselbarth@uni-goettingen.de>
Maintainer: Maximillian H.K. Hesselbarth <mhk.hesselbarth@gmail.com>
Description: Calculates landscape metrics for categorical landscape patterns in
a tidy workflow. 'landscapemetrics' reimplements the most common metrics from
'FRAGSTATS' (<https://www.umass.edu/landeco/research/fragstats/fragstats.html>)
Expand Down Expand Up @@ -77,6 +77,6 @@ ByteCompile: true
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.0.2
RoxygenNote: 7.1.0
SystemRequirements: C++11
VignetteBuilder: knitr
5 changes: 5 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
# landscapemetrics 1.4.4
* Improvements
* Set labels = FALSE as default for all plotting functions (messy for larger raster)
* Add argument to `sample_lsm()` that adds NA if class is not present in sample plot

# landscapemetrics 1.4.3
* Improvements
* Improved algorithm to calculate circumscribing circle. This refers to both speed and accuracy.
Expand Down
79 changes: 59 additions & 20 deletions R/sample_lsm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
#' @param shape String specifying plot shape. Either "circle" or "square"
#' @param size Approximated size of sample plot. Equals the radius for circles or half of
#' the side-length for squares in mapunits. For lines size equals the width of the buffer.
#' @param all_classes Logical if NA should be returned for classes not present in some sample plots.
#' @param return_raster Logical if the clipped raster of the sample plot should
#' be returned
#' @param verbose Print warning messages.
Expand Down Expand Up @@ -79,6 +80,7 @@ sample_lsm <- function(landscape,
y,
plot_id,
shape, size,
all_classes,
return_raster,
verbose,
progress,
Expand All @@ -90,6 +92,7 @@ sample_lsm.RasterLayer <- function(landscape,
y,
plot_id = NULL,
shape = "square", size,
all_classes = FALSE,
return_raster = FALSE,
verbose = TRUE,
progress = FALSE,
Expand All @@ -100,6 +103,7 @@ sample_lsm.RasterLayer <- function(landscape,
y = y,
plot_id = plot_id,
shape = shape, size = size,
all_classes = all_classes,
verbose = verbose,
progress = progress,
...)
Expand All @@ -124,6 +128,7 @@ sample_lsm.RasterStack <- function(landscape,
y,
plot_id = NULL,
shape = "square", size,
all_classes = FALSE,
return_raster = FALSE,
verbose = TRUE,
progress = FALSE,
Expand All @@ -143,6 +148,7 @@ sample_lsm.RasterStack <- function(landscape,
plot_id = plot_id,
shape = shape,
size = size,
all_classes = all_classes,
verbose = verbose,
progress = FALSE,
...)
Expand Down Expand Up @@ -170,6 +176,7 @@ sample_lsm.RasterBrick <- function(landscape,
y,
plot_id = NULL,
shape = "square", size,
all_classes = FALSE,
return_raster = FALSE,
verbose = TRUE,
progress = FALSE,
Expand All @@ -189,6 +196,7 @@ sample_lsm.RasterBrick <- function(landscape,
plot_id = plot_id,
shape = shape,
size = size,
all_classes = all_classes,
verbose = verbose,
progress = FALSE,
...)
Expand Down Expand Up @@ -216,6 +224,7 @@ sample_lsm.stars <- function(landscape,
y,
plot_id = NULL,
shape = "square", size,
all_classes = FALSE,
return_raster = FALSE,
verbose = TRUE,
progress = FALSE,
Expand All @@ -235,6 +244,7 @@ sample_lsm.stars <- function(landscape,
plot_id = plot_id,
shape = shape,
size = size,
all_classes = all_classes,
verbose = verbose,
progress = FALSE,
...)
Expand Down Expand Up @@ -262,6 +272,7 @@ sample_lsm.list <- function(landscape,
y,
plot_id = NULL,
shape = "square", size,
all_classes = FALSE,
return_raster = FALSE,
verbose = TRUE,
progress = FALSE,
Expand All @@ -279,6 +290,7 @@ sample_lsm.list <- function(landscape,
plot_id = plot_id,
shape = shape,
size = size,
all_classes = all_classes,
verbose = verbose,
progress = FALSE,
...)
Expand All @@ -304,12 +316,13 @@ sample_lsm_int <- function(landscape,
y,
plot_id,
shape, size,
all_classes,
verbose,
progress,
...) {

# use polygon
if (inherits(x = y, what = "sf") && all(sf::st_geometry_type(y) %in% c("POLYGON", "MULTIPOLYGON"))){
if (inherits(x = y, what = "sf") && all(sf::st_geometry_type(y) %in% c("POLYGON", "MULTIPOLYGON"))) {
y <- methods::as(y, "Spatial")
}

Expand Down Expand Up @@ -458,12 +471,12 @@ sample_lsm_int <- function(landscape,

number_plots <- length(maximum_area)


# create object for warning messages
warning_messages <- character(0)

# loop through each sample point and calculate metrics
result <- withCallingHandlers(expr = {do.call(rbind, lapply(X = seq_along(y), FUN = function(current_plot) {
result <- withCallingHandlers(expr = {do.call(rbind, lapply(X = seq_along(y),
FUN = function(current_plot) {

# print progess using the non-internal name
if (progress) {
Expand Down Expand Up @@ -499,7 +512,6 @@ sample_lsm_int <- function(landscape,
result_current_plot$plot_id <- plot_id[current_plot]
}


# all cells are NA
if (all(is.na(raster::values(landscape_mask)))) {

Expand Down Expand Up @@ -530,36 +542,63 @@ sample_lsm_int <- function(landscape,
cat("\n")
}

# add all_classes if class is present in tibble
if (all_classes && "class" %in% result$level) {

# get all present classes
all_classes <- unique(raster::values(landscape))

# only results on class level are needed
result_class <- result[result$level == "class", ]

# get all possible combination of all metrics and classes in each plot
all_combinations <- expand.grid(class = all_classes,
metric = unique(result_class$metric),
plot_id = unique(result_class$plot_id),
stringsAsFactors = FALSE)

# add NA values for classes not present in certain plots
all_combinations <- merge(x = all_combinations,
y = result_class[, c("class", "metric",
"value", "plot_id")],
by = c("class", "metric", "plot_id"),
all.x = TRUE)

# add information about unique study plots
all_combinations <- merge(x = all_combinations,
y = unique(result_class[, c("layer", "level", "id",
"plot_id",
"percentage_inside",
"raster_sample_plots")]),
by = "plot_id", all.x = TRUE)

# reorder cols
all_combinations <- all_combinations[, names(result)]

# remove all class level results
result <- result[!result$level == "class", ]

# exchange with all combinations
result <- tibble::as_tibble(rbind(result, all_combinations))
}

# return warning of only 3/4 of sample plot are in landscape
if (verbose) {
if (any(result$percentage_inside < 90)) {

warning("The 'perecentage_inside' is below 90% for at least one buffer.",
call. = FALSE)

}
}

# warnings present
if (length(warning_messages)) {
if (length(warning_messages) > 0) {

# only unique warnings
warning_messages <- unique(warning_messages)

# remove warning from creating raster
remove_id <- which(warning_messages %in% c("no non-missing arguments to min; returning Inf",
"no non-missing arguments to max; returning -Inf"))

if (length(remove_id)) {
warning_messages <- warning_messages[-remove_id]
}

# still warnings present
if (length(warning_messages)) {

# print warnings
lapply(warning_messages, function(x){ warning(x, call. = FALSE)})
}
# print warnings
lapply(warning_messages, function(x){ warning(x, call. = FALSE)})
}

return(result)
Expand Down
10 changes: 5 additions & 5 deletions R/show_cores.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ show_cores <- function(landscape,
show_cores.RasterLayer <- function(landscape,
directions = 8,
class = "all",
labels = TRUE,
labels = FALSE,
nrow = NULL,
ncol = NULL,
consider_boundary = FALSE,
Expand All @@ -69,7 +69,7 @@ show_cores.RasterLayer <- function(landscape,
show_cores.RasterStack <- function(landscape,
directions = 8,
class = "all",
labels = TRUE,
labels = FALSE,
nrow = NULL,
ncol = NULL,
consider_boundary = FALSE,
Expand All @@ -91,7 +91,7 @@ show_cores.RasterStack <- function(landscape,
show_cores.RasterBrick <- function(landscape,
directions = 8,
class = "all",
labels = TRUE,
labels = FALSE,
nrow = NULL,
ncol = NULL,
consider_boundary = FALSE,
Expand All @@ -113,7 +113,7 @@ show_cores.RasterBrick <- function(landscape,
show_cores.stars <- function(landscape,
directions = 8,
class = "all",
labels = TRUE,
labels = FALSE,
nrow = NULL,
ncol = NULL,
consider_boundary = FALSE,
Expand All @@ -137,7 +137,7 @@ show_cores.stars <- function(landscape,
show_cores.list <- function(landscape,
directions = 8,
class = "all",
labels = TRUE,
labels = FALSE,
nrow = NULL,
ncol = NULL,
consider_boundary = FALSE,
Expand Down
10 changes: 5 additions & 5 deletions R/show_lsm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ show_lsm.RasterLayer <- function(landscape,
directions = 8,
consider_boundary = FALSE,
edge_depth = 1,
labels = TRUE,
labels = FALSE,
label_lsm = FALSE,
nrow = NULL,
ncol = NULL) {
Expand All @@ -65,7 +65,7 @@ show_lsm.RasterStack <- function(landscape,
directions = 8,
consider_boundary = FALSE,
edge_depth = 1,
labels = TRUE,
labels = FALSE,
label_lsm = FALSE,
nrow = NULL,
ncol = NULL) {
Expand All @@ -91,7 +91,7 @@ show_lsm.RasterBrick <- function(landscape,
directions = 8,
consider_boundary = FALSE,
edge_depth = 1,
labels = TRUE,
labels = FALSE,
label_lsm = FALSE,
nrow = NULL,
ncol = NULL) {
Expand All @@ -117,7 +117,7 @@ show_lsm.stars <- function(landscape,
directions = 8,
consider_boundary = FALSE,
edge_depth = 1,
labels = TRUE,
labels = FALSE,
label_lsm = FALSE,
nrow = NULL,
ncol = NULL) {
Expand Down Expand Up @@ -145,7 +145,7 @@ show_lsm.list <- function(landscape,
directions = 8,
consider_boundary = FALSE,
edge_depth = 1,
labels = TRUE,
labels = FALSE,
label_lsm = FALSE,
nrow = NULL,
ncol = NULL) {
Expand Down
Loading

0 comments on commit 8fe4b89

Please sign in to comment.