From a5bd543961f4beb60f094e90f21f7de530c640e3 Mon Sep 17 00:00:00 2001 From: rhijmans Date: Wed, 11 Dec 2024 18:06:15 -0800 Subject: [PATCH] m --- .Rbuildignore | 1 + DESCRIPTION | 4 ++-- R/divpol.R | 4 ++-- R/response.R | 44 +++++++++++++++++++++++++++++++++++++------- man/maxent.Rd | 2 -- man/mess.Rd | 2 +- man/varImportance.Rd | 7 ++++--- 7 files changed, 47 insertions(+), 17 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 2c7eb2a..865f42b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,4 +1,5 @@ .gitignore +^\.github$ LICENSE README.md TODO diff --git a/DESCRIPTION b/DESCRIPTION index bd522a0..d1a8688 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: predicts Type: Package Title: Spatial Prediction Tools Description: Methods for spatial predictive modeling, especially for spatial distribution models. This includes algorithms for model fitting and prediction, as well as methods for model evaluation. -Version: 0.1-15 -Date: 2024-10-02 +Version: 0.1-17 +Date: 2024-11-23 Depends: R (>= 3.5.0), methods, terra Encoding: UTF-8 Suggests: disdat, rJava diff --git a/R/divpol.R b/R/divpol.R index b0dab1d..2421580 100644 --- a/R/divpol.R +++ b/R/divpol.R @@ -54,7 +54,7 @@ stripper <- function(x, f=c(1/3, 2/3), vertical=TRUE){ target_function <- function(xm){ expanse(crop(x, ext(ex$xmin, xm, ex$ymin, ex$ymax))) - target } - stats::uniroot(target_function, lower=e$xmin, upper=e$xmax)$root + stats::uniroot(target_function, lower=e$xmin+0.0000001, upper=e$xmax)$root }) bnds <- matrix(c(ex$xmin, rep(edges,rep(2,length(edges))), ex$xmax), ncol=2, byrow=TRUE) a <- apply(bnds, 1, function(edges){ @@ -67,7 +67,7 @@ stripper <- function(x, f=c(1/3, 2/3), vertical=TRUE){ target_function <- function(ym){ expanse(crop(x, ext(ex$xmin, ex$xmax, ex$ymin, ym))) - target } - stats::uniroot(target_function, lower=e$ymin, upper=e$ymax)$root + stats::uniroot(target_function, lower=e$ymin+0.0000001, upper=e$ymax)$root }) bnds <- matrix(c(ex$ymin, rep(edges,rep(2,length(edges))), ex$ymax), ncol=2, byrow=TRUE) a <- apply(bnds, 1, function(edges){ diff --git a/R/response.R b/R/response.R index 600b77a..77220c1 100644 --- a/R/response.R +++ b/R/response.R @@ -4,7 +4,9 @@ .get_model_data <- function(m) { if (inherits(m, "lm") || inherits(m, "glm")) { - m$model + rvar <- as.character(attributes(m$terms)$variables[[2]]) + m <- m$model + m[, !(names(m) %in% rvar), drop=FALSE] } else if (inherits(m, "SDM")) { rbind(m@presence, m@absence) } else { @@ -12,23 +14,45 @@ } } +.get_response_data <- function(m) { + if (inherits(m, "lm") || inherits(m, "glm")) { + rvar <- as.character(attributes(m$terms)$variables[[2]]) + m$model[,rvar] + } else if (inherits(m, "SDM")) { + c(rep(1, nrow(m@presence)), rep(0, nrow(m@absence))) + } else { + NULL + } +} -varImportance <- function(model, y, x, n=10, stat, ...) { + +varImportance <- function(model, y, x, n=10, stat, value="relative", ...) { # vars <- vars[vars %in% colnames(x)] # if (length(vars) < 1) { # stop("no valid names in vars") # } - vars <- colnames(x) - eva <- matrix(nrow=n, ncol=length(vars)) - colnames(eva) <- vars - + + value <- match.arg(tolower(value), c("absolute", "relative", "difference")) + if (missing(x)) { x <- .get_model_data(model) if (is.null(x)) { stop("data argument cannot be missing when using this model type") } } + vars <- colnames(x) + eva <- matrix(nrow=n, ncol=length(vars)) + colnames(eva) <- vars + + + if (missing(y)) { + y <- .get_response_data(model) + if (is.null(y)) { + message("computing response (y) from x") + y <- predict(model, x, ...) + } + } P <- predict(model, x, ...) if (is.factor(P)) { @@ -67,7 +91,13 @@ varImportance <- function(model, y, x, n=10, stat, ...) { eva[j,i] <- efun(y, p) } } - colMeans(eva) - base + if (value == "relative") { + (colMeans(eva) - base) / base + } else if (value == "absolute") { + colMeans(eva) + } else { #"difference" + colMeans(eva) - base + } } diff --git a/man/maxent.Rd b/man/maxent.Rd index 7704c6b..f9c63ee 100644 --- a/man/maxent.Rd +++ b/man/maxent.Rd @@ -70,8 +70,6 @@ If the function is run without any arguments a boolean value is returned (\code{ \references{ -\url{https://biodiversityinformatics.amnh.org/open_source/maxent/} - Steven J. Phillips, Miroslav Dudik, Robert E. Schapire, 2004. A maximum entropy approach to species distribution modeling. Proceedings of the Twenty-First International Conference on Machine Learning. p. 655-662. Steven J. Phillips, Robert P. Anderson, Robert E. Schapire, 2006. Maximum entropy modeling of species geographic distributions. Ecological Modelling 190:231-259. diff --git a/man/mess.Rd b/man/mess.Rd index 2fae4b4..fb77b96 100644 --- a/man/mess.Rd +++ b/man/mess.Rd @@ -19,7 +19,7 @@ \item{v}{matrix or data.frame containing the reference values; each column should correspond to one layer of the SpatRaster object. If \code{x} is a SpatRaster, it can also be a SpatVector with reference locations (points)} \item{full}{logical. If \code{FALSE} a SpatRaster with the MESS values is returned. If \code{TRUE}, a SpatRaster is returned with \code{n} layers corresponding to the layers of the input SpatRaster and an additional layer with the MESS values} \item{filename}{character. Output filename (optional)} - \item{...}{additional arguments as for \code{\link{writeRaster}}} + \item{...}{additional arguments as for \code{\link[terra]{writeRaster}}} } \details{ diff --git a/man/varImportance.Rd b/man/varImportance.Rd index 5d4ec72..e5a4857 100644 --- a/man/varImportance.Rd +++ b/man/varImportance.Rd @@ -12,15 +12,16 @@ Get variable importance. The importance is expressed as the deterioration of the \usage{ -varImportance(model, y, x, n=10, stat, ...) +varImportance(model, y, x, n=10, stat, value="relative", ...) } \arguments{ \item{model}{a model object} - \item{y}{the response variable used to fit the \code{model}} - \item{x}{data.frame with the predictor variables used to fit the \code{model}} + \item{y}{the response variable used to fit the \code{model}. If missing, it is attempted to extract it from \code{model}. If that fails, it is computed from \code{x}. In the latter case the model would be assumed to have no error} + \item{x}{data.frame with the predictor variables used to fit the \code{model}. If missing, it is attemted to extract it from \code{model}} \item{n}{positive integer. Number of simulations} \item{stat}{character. For models with a continuous response variable this can be one of "RMSE" (the default), "AUC", or "cor". See \code{\link{RMSE}} or \code{\link{pa_evaluate}}. For models with a categorical response variable this can be one of "overall" (overall accuracy, the default) or "kappa", see \code{\link{cm_evaluate}}} + \item{value}{character specifying how to express the output. One of , "relative" (), "difference" (), "absolute" (no adjustments)} \item{...}{model specific additional arguments passed to \code{predict}} }