m

.Rbuildignore

@@ -1,4 +1,5 @@
 .gitignore
+^\.github$
 LICENSE
 README.md
 TODO

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

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){ 

R/response.R

@@ -4,31 +4,55 @@
 
 .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 {
 		NULL
 	}
 }
 
+.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
+	}
 }
 
 

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. 

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{

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}}
 }