diff --git a/DESCRIPTION b/DESCRIPTION index 8a1a60f..0e2ad01 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: enmSdmX Type: Package Title: Species Distribution Modeling and Ecological Niche Modeling Version: 1.1.5 -Date: 2023-04-10 +Date: 2024-05-16 Authors@R: c( person( diff --git a/NEWS.md b/NEWS.md index b7db9ac..ea5e507 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ -# enmSdmX 1.1.5 2023-04-10 +# enmSdmX 1.1.5 2024-05-16 - Added function `trainESM()` for ensembles of small models. +- Added several UTM coordinate reference systems accessible through `getCRS()`. +- Fixed bug in `precidtEnmSdm()` for predicting kernel density models from the **ks** package. # enmSdmX 1.1.3 2023-03-06 - `trainGLM()`, `trainNS()`, and `predictEnmSdm()` now have options to automatically center and scale predictors. diff --git a/R/customCRS.r b/R/customCRS.r index 0feec71..8579ae1 100644 --- a/R/customCRS.r +++ b/R/customCRS.r @@ -124,52 +124,6 @@ customLambert <- function(x) { customVNS <- function(x, alt = 35800) { alt <- 1000 * alt - - cent <- .getCentroid(x) - long <- cent$long - lat <- cent$lat - - out <- paste0( - 'PROJCRS["World_Vertical_Perspective", - BASEGEOGCRS["WGS 84", - DATUM["World Geodetic System 1984", - ELLIPSOID["WGS 84",6378137,298.257223563, - LENGTHUNIT["metre",1]]], - PRIMEM["Greenwich",0, - ANGLEUNIT["Degree",0.0174532925199433]]], - CONVERSION["World_Vertical_Perspective", - METHOD["Vertical Perspective", - ID["EPSG",9838]], - PARAMETER["Latitude of topocentric origin",', lat, ', - ANGLEUNIT["Degree",0.0174532925199433], - ID["EPSG",8834]], - PARAMETER["Longitude of topocentric origin",', long, ', - ANGLEUNIT["Degree",0.0174532925199433], - ID["EPSG",8835]], - PARAMETER["Viewpoint height",', alt, ', - LENGTHUNIT["metre",1], - ID["EPSG",8840]]], - CS[Cartesian,2], - AXIS["(E)",east, - ORDER[1], - LENGTHUNIT["metre",1]], - AXIS["(N)",north, - ORDER[2], - LENGTHUNIT["metre",1]], - USAGE[ - SCOPE["Not known."], - AREA["World."], - BBOX[-90,-180,90,180]]]' - ) - - out - -} - -customVNS <- function(x, alt = 35800) { - - alt <- 1000 * alt - cent <- .getCentroid(x) long <- cent$long lat <- cent$lat @@ -211,7 +165,6 @@ customVNS <- function(x, alt = 35800) { } - ### get centroid of raster, vector, sf, etc. object ################################################### .getCentroid <- function(x) { @@ -236,6 +189,7 @@ customVNS <- function(x, alt = 35800) { lat <- cent[1L, 2L] } else if (inherits(x, c('matrix', 'data.frame'))) { + if (ncol(x) != 2L | nrow(x) != 1L) stop('Argument "x" must be a 2-column data frame/matrix with one row, a two-element numeric vector, or a spatial object.') long <- x[1L, 1L] lat <- x[1L, 2L] diff --git a/R/extentToVect.r b/R/extentToVect.r index becf97b..964ce37 100644 --- a/R/extentToVect.r +++ b/R/extentToVect.r @@ -14,6 +14,11 @@ #' plot(madExtent, border='blue', lty='dotted') #' plot(mad0[1], add=TRUE) #' +#' # NB This is the same as: +#' library(terra) +#' madExtent <- ext(mad0) +#' madExtent <- as.polygons(madExtent, crs = crs(mad0)) +#' #' @export extentToVect <- function(x, ...) { diff --git a/R/getCRS.r b/R/getCRS.r index 28fb07a..f375495 100644 --- a/R/getCRS.r +++ b/R/getCRS.r @@ -4,9 +4,9 @@ #' #' @param x This can be any of: #' \itemize{ -#' \item Name of CRS: Each CRS has one "long" name and at least one "short" name, which appear in the table returned by \code{getCRS()}. You can use the "long" name of the CRS, or either of the two "short" names. Spaces, case, and dashes are ignored, but to make the codes more memorable, they are shown as having them. -#' \item \code{NULL} (default): This returns a table of projections with their "long" and "short" names (nearly the same as \code{data(crss)}). -#' \item An object of class \code{SpatVector}, \code{SpatRaster}, or \code{sf}. If this is a "\code{Spat}" object, then a character vector with the CRS in WKT form is returned. If a \code{sf} is supplied, then a \code{crs} object is returned in WKT format. +#' \item Name of CRS: Each CRS has at least one "alias", which appears in the table returned by \code{getCRS()}. You can use any of the aliases to refer to a CRS. Within the function, spaces, case, and dashes in aliases are ignored, but to help make the aliases more memorable, the aliases include them. +#' \item \code{NULL} (default): This returns a table of projections with their aliases (nearly the same as \code{data(crss)}). +#' \item An object of class \code{SpatVector}, \code{SpatRaster}, or \code{sf}. If this is a "\code{Spat}" or "\code{G}" object, then a character vector with the CRS in WKT form is returned. If a \code{sf} is supplied, then a \code{crs} object is returned in WKT format. #' } #' #' @param nice If \code{TRUE}, then print the CRS in a formatted manner and return it invisibly. Default is \code{FALSE}. @@ -76,6 +76,7 @@ getCRS <- function( } else if (inherits(x, 'sf')) { out <- sf::st_crs(x) } else { + # return WKT2 x <- tolower(x) x <- gsub(x, pattern=' ', replacement='') diff --git a/R/predictEnmSdm.r b/R/predictEnmSdm.r index 24df08e..2d1ea17 100644 --- a/R/predictEnmSdm.r +++ b/R/predictEnmSdm.r @@ -136,19 +136,19 @@ predictEnmSdm <- function( # GLM } else if (inherits(model, c('glm'))) { - # center and scale... match names of newdata to pre-calculated centers/scales in GLM object saved by trainGLM() - if (scale && any(names(model) == 'scale')) { - - scaling <- TRUE - centers <- model$scale$mean - scales <- model$scale$sd - nms <- names(newdata) - centers <- centers[match(nms, names(centers))] - scales <- scales[match(nms, names(scales))] - - } else { - scaling <- FALSE - } + # center and scale... match names of newdata to pre-calculated centers/scales in GLM object saved by trainGLM() + if (scale && any(names(model) == 'scale')) { + + scaling <- TRUE + centers <- model$scale$mean + scales <- model$scale$sd + nms <- names(newdata) + centers <- centers[match(nms, names(centers))] + scales <- scales[match(nms, names(scales))] + + } else { + scaling <- FALSE + } if (inherits(newdata, c('SpatRaster'))) { if (scaling) newdata <- terra::scale(newdata, center = centers, scale = scales) @@ -188,7 +188,25 @@ predictEnmSdm <- function( # hack... not calling ks functions explicitly at least once in package generates warning if (FALSE) fhat <- ks::kde(stats::rnorm(100)) predictKde <- utils::getFromNamespace('predict.kde', 'ks') - out <- predictKde(model, x=as.matrix(newdata), ...) + newdataMatrix <- as.matrix(newdata) + n <- nrow(newdataMatrix) + notNas <- which(stats::complete.cases(newdataMatrix)) + newdataMatrix <- newdataMatrix[notNas, ] + preds <- predictKde(model, x = newdataMatrix, ...) + + if (inherits(newdata, "SpatRaster")) { + + out <- newdata[[1L]] + out[] <- NA_real_ + out <- setValueByCell(out, preds, cell=notNas, format='raster') + names(out) <- 'kde' + + } else { + + out <- rep(NA_real_, n) + out[notNas] <- preds + + } # Maxent } else if (inherits(model, c('MaxEnt', 'MaxEnt_model'))) { @@ -236,7 +254,6 @@ predictEnmSdm <- function( model$binary } - if (inherits(newdata, 'SpatRaster')) { nd <- as.data.frame(newdata, na.rm=FALSE) diff --git a/data/crss.rda b/data/crss.rda index dcefe0a..895b2af 100644 Binary files a/data/crss.rda and b/data/crss.rda differ diff --git a/man/customAlbers.Rd b/man/customAlbers.Rd index fe1054b..384e301 100644 --- a/man/customAlbers.Rd +++ b/man/customAlbers.Rd @@ -70,7 +70,7 @@ library(terra) # Get outline of Canada... # We wrap this in tryCatch() in case the server is down. can <- tryCatch( - gadm('CAN', level=0, path=tempdir()), + gadm('CAN', level=0, path=tempdir(), resolution=2), error=function(cond) FALSE ) @@ -94,6 +94,7 @@ if (!is.logical(can)) { par(oldPar) } + } } \seealso{ diff --git a/man/examples/customCRS_examples.r b/man/examples/customCRS_examples.r index f0045bd..bb86953 100644 --- a/man/examples/customCRS_examples.r +++ b/man/examples/customCRS_examples.r @@ -31,7 +31,7 @@ library(terra) # Get outline of Canada... # We wrap this in tryCatch() in case the server is down. can <- tryCatch( - gadm('CAN', level=0, path=tempdir()), + gadm('CAN', level=0, path=tempdir(), resolution=2), error=function(cond) FALSE ) @@ -55,4 +55,5 @@ if (!is.logical(can)) { par(oldPar) } + } diff --git a/man/extentToVect.Rd b/man/extentToVect.Rd index de4ceea..bf238ab 100644 --- a/man/extentToVect.Rd +++ b/man/extentToVect.Rd @@ -24,6 +24,11 @@ madExtent <- extentToVect(mad0) plot(madExtent, border='blue', lty='dotted') plot(mad0[1], add=TRUE) +# NB This is the same as: +library(terra) +madExtent <- ext(mad0) +madExtent <- as.polygons(madExtent, crs = crs(mad0)) + } \seealso{ \link{plotExtent} diff --git a/man/getCRS.Rd b/man/getCRS.Rd index 8d6360e..ef42e9c 100644 --- a/man/getCRS.Rd +++ b/man/getCRS.Rd @@ -9,9 +9,9 @@ getCRS(x = NULL, nice = FALSE, warn = TRUE) \arguments{ \item{x}{This can be any of: \itemize{ - \item Name of CRS: Each CRS has one "long" name and at least one "short" name, which appear in the table returned by \code{getCRS()}. You can use the "long" name of the CRS, or either of the two "short" names. Spaces, case, and dashes are ignored, but to make the codes more memorable, they are shown as having them. - \item \code{NULL} (default): This returns a table of projections with their "long" and "short" names (nearly the same as \code{data(crss)}). - \item An object of class \code{SpatVector}, \code{SpatRaster}, or \code{sf}. If this is a "\code{Spat}" object, then a character vector with the CRS in WKT form is returned. If a \code{sf} is supplied, then a \code{crs} object is returned in WKT format. + \item Name of CRS: Each CRS has at least one "alias", which appears in the table returned by \code{getCRS()}. You can use any of the aliases to refer to a CRS. Within the function, spaces, case, and dashes in aliases are ignored, but to help make the aliases more memorable, the aliases include them. + \item \code{NULL} (default): This returns a table of projections with their aliases (nearly the same as \code{data(crss)}). + \item An object of class \code{SpatVector}, \code{SpatRaster}, or \code{sf}. If this is a "\code{Spat}" or "\code{G}" object, then a character vector with the CRS in WKT form is returned. If a \code{sf} is supplied, then a \code{crs} object is returned in WKT format. }} \item{nice}{If \code{TRUE}, then print the CRS in a formatted manner and return it invisibly. Default is \code{FALSE}.}