.metrics_filter_chk_args <- function(){
messages <- NULL
what <- NULL
if(!is.list(conditions)){
messages <- append(messages,
"- argument 'conditions' must be a list.")
what <- append(what, 2)
} else {
if(all(unlist(lapply(conditions, is.null)))){
messages <- append(messages,
"- no conditions were defined. Nothing to do.")
what <- append(what, 2)
} else {
if(length(conditions) > 0){
for(i in 1:length(conditions)){
if(!is.list(conditions[[i]])){
messages <- append(messages,
paste0("- condition number ", i, " is not a list. Each condition must
be a list. See ?metrics_filter"))
what <- append(what, 2)
} else {
if(length(conditions[[i]]) != 6){
messages <- append(messages,
paste0("- condition number ", i, " must be a list with six elements:
c(rasterlayer, class, radius, metric, min. value, max. value).
More details in ?metrics_filter"))
what <- append(what, 2)
} else {
# Rasterlayer
if(!is.na(conditions[[i]][[1]][1])){
foo <- rbind(x@rast_names$lsm, x@rast_names$ext)
if(nrow(x@rast_names$ext) > 0){
foo[(nrow(x@rast_names$lsm)+1):nrow(foo), "rasterlayer"] <-
paste0("ext", foo[(nrow(x@rast_names$lsm)+1):nrow(foo), "rasterlayer"])
}
for(r in 1:length(conditions[[i]][[1]])){
if(!is.numberinchar(conditions[[i]][[1]][r])){
if(substr(conditions[[i]][[1]][r], 1, 3) != "ext"){
if(conditions[[i]][[1]][r] %in% foo$name){
conditions[[i]][[1]][r] <- foo[foo$name == conditions[[i]][[1]][r], "rasterlayer"]
} else {
conditions[[i]][[1]][r] <- NA
}
}
}
}
if(!any(conditions[[i]][[1]] %in% unique(x@data$rasterlayer))){
messages <- append(messages,
paste0("- rasterlayers (1st element) from condition ", i, "
were not found as defined layers in 'x'. Mispelled?"))
what <- append(what, 2)
}
} else {
conditions[[i]][[1]] <- unique(x@data$rasterlayer)
message(paste0("- condition ", i, ": raster layers included in the filtering process: ",
paste0(conditions[[i]][[1]], collapse = " ")))
}
# Class
if(!2 %in% what){
if(!is.null(conditions[[i]][[2]])){
if(!is.na(conditions[[i]][[2]][1])){
for(j in 1:length(conditions[[i]][[2]])){
for(r in 1:length(conditions[[i]][[1]])){
if(!grepl("ext", conditions[[i]][[1]][r])){
foo <- x@classes[x@classes$rasterlayer == conditions[[i]][[1]][r], ]
if(!is.na(suppressWarnings(as.numeric(conditions[[i]][[2]][j])))){
if(!conditions[[i]][[2]][j] %in% foo$class){
messages <- append(messages,
paste0("- class ", conditions[[i]][[2]][j],
" from condition ", i, " was not found as a defined
class of rasterlayer ", conditions[[i]][[1]][r],
" in 'x'. Mispelled?"))
what <- append(what, 2)
}
} else {
if(is.character(conditions[[i]][[2]][j])){
if(!conditions[[i]][[2]][j] %in% foo$classname){
messages <- append(messages,
paste0("- class '", conditions[[i]][[2]][j],
"' from condition ", i, " was not found as a defined
class of rasterlayer ", conditions[[i]][[1]][r],
" in 'x'. Mispelled?"))
what <- append(what, 2)
} else {
conditions[[i]][[2]][j] <- foo[foo$classname == conditions[[i]][[2]][j], "class"]
}
}
}
}
}
}
conditions[[i]][[2]] <- suppressWarnings(as.numeric(conditions[[i]][[2]]))
} else {
conditions[[i]][[2]] <- na.exclude(unique(x@data$class))
message(paste0("- condition ", i,
": all classes from all requested raster layers were included in the filtering process."))
}
}
}
# Radius
if(!is.na(conditions[[i]][[3]][1])){
if(!conditions[[i]][[3]] %in% x@radii){
messages <- append(messages,
paste0("- radius (2nd element) ", conditions[[i]][[3]],
" from condition ", i, " was not found as a defined radius in
'x'. Mispelled?"))
what <- append(what, 2)
}
} else {
conditions[[i]][[3]] <- x@radii
message(paste0("- condition ", i, ": radii included in the filtering process: ",
paste0(conditions[[i]][[3]], collapse = " ")))
}
# Metric
if(length(conditions[[i]][[4]]) > 1){
messages <- append(messages,
"- only one metric can be defined per condition.")
what <- append(what, 2)
} else {
if(!conditions[[i]][[4]] %in% unique(x@data$metric)){
messages <- append(messages,
paste0("- metric (3rd element) \"", conditions[[i]][[4]],
"\" from condition ", i, " was not found as a defined metric in
'x'. Mispelled?"))
what <- append(what, 2)
} else {
if(!"fun" %in% unlist(strsplit(as.character(conditions[[i]][[4]]), "_"))){
if(is.null(conditions[[i]][[2]])){
if(!"landscape" %in% x@metrics[x@metrics$metric == conditions[[i]][[4]], "level"]){
messages <- append(messages,
paste0("- metric (3rd element) \"", conditions[[i]][[4]],
"\" assumed of landscape-level (2nd element = NULL) from
condition ", i, " was not found as a defined metric in 'x'.
Mispelled?"))
what <- append(what, 2)
}
} else {
if(!"class" %in% x@metrics[x@metrics$metric == conditions[[i]][[4]], "level"]){
messages <- append(messages,
paste0("- metric (3rd element) \"", conditions[[i]][[4]],
"\" assumed of class-level (2nd element != NULL) from
condition ", i, " was not found as a defined metric in
'x'. Mispelled?"))
what <- append(what, 2)
}
}
}
}
}
# Min. value
if(is.na(suppressWarnings(as.numeric(conditions[[i]][[5]][1])))){
messages <- append(messages,
paste0("- min. value (5th element) from condition ", i,
" must be numeric."))
what <- append(what, 2)
}
# Max. value
if(is.na(suppressWarnings(as.numeric(conditions[[i]][[6]][1])))){
messages <- append(messages,
paste0("- max. value (6th element) from condition ", i,
" must be numeric."))
what <- append(what, 2)
}
}
}
}
} else {
messages <- append(messages,
"- no conditions were defined. Nothing to do.")
what <- append(what, 2)
}
}
}
if(!output %in% c("MLM", "spatial", "data", "coords")){
messages <- append(messages,
"- argument output must be \"MLM\", \"spatial\", \"data\" or \"coords\". Default
\"MLM\" was taken. See ?metrics_filter")
what <- append(what, 1)
output <- "MLM"
}
warnings <- messages[which(what == 1)]
errors <- messages[which(what == 2)]
out <- list(warnings = warnings,
errors = errors,
conditions = conditions,
output = output)
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.