tests run conditionally; use of resubmitted geodata; prepare CRAN sub…

…mission

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: CAST
 Type: Package
 Title: 'caret' Applications for Spatial-Temporal Models
-Version: 1.0.1
+Version: 1.0.2
 Authors@R: c(person("Hanna", "Meyer", email = "hanna.meyer@uni-muenster.de", role = c("cre", "aut")),
              person("Carles", "Milà", role = c("aut")),
              person("Marvin", "Ludwig", role = c("aut")),
@@ -20,13 +20,13 @@ URL: https://github.com/HannaMeyer/CAST,
 Encoding: UTF-8
 LazyData: false
 Depends: R (>= 4.1.0)
-Imports: caret, stats, utils, ggplot2, graphics, FNN, plyr, zoo, methods, grDevices, data.table, sf, forcats
+Imports: caret, stats, utils, ggplot2, graphics, FNN, plyr, zoo, methods, grDevices, data.table, sf, forcats, twosamples, terra
 Suggests: 
     doParallel,
-    randomForest,
     lubridate,
-    sp,
+    randomForest,
     knitr,
+    geodata,
     mapview,
     rmarkdown,
     scales,
@@ -35,10 +35,8 @@ Suggests:
     viridis,
     stars,
     scam,
-    terra,
     rnaturalearth,
     MASS,
-    twosamples,
     RColorBrewer,
     tmap,
     PCAmixdata, 

NEWS.md

@@ -1,3 +1,7 @@
+# `CAST` 1.0.2
+* bug fix: tests run conditionally
+* modifications: dependence on sp replaced by sf
+
 # `CAST` 1.0.1
 * bug fix: fix failed tests in global_validation
 

R/geodist.R

@@ -216,7 +216,7 @@ geodist <- function(x,
   ## Sample prediction location from the study area if preddata not available:
   if(is.null(preddata)){
     modeldomain <- sampleFromArea(modeldomain, samplesize, type,variables,sampling, catVars)
-    } else{
+  } else{
     modeldomain <- preddata
   }
 
@@ -358,7 +358,7 @@ sample2prediction = function(x, modeldomain, type, samplesize,variables,time_uni
       modeldomain_num <- modeldomain[,-which(names(modeldomain)%in%catVars),drop=FALSE]
       modeldomain_cat <- modeldomain[,catVars,drop=FALSE]
       modeldomain_num <- data.frame(scale(modeldomain_num,center=scaleparam$`scaled:center`,
-                                      scale=scaleparam$`scaled:scale`))
+                                          scale=scaleparam$`scaled:scale`))
 
       x <- as.data.frame(cbind(x_num, lapply(x_cat, as.factor)))
       x_clean <- x[complete.cases(x),]
@@ -440,7 +440,7 @@ sample2test <- function(x, testdata, type,variables,time_unit,timevar, catVars){
       testdata_num <- testdata[,-which(names(testdata)%in%catVars),drop=FALSE]
       testdata_cat <- testdata[,catVars,drop=FALSE]
       testdata_num <- data.frame(scale(testdata_num,center=scaleparam$`scaled:center`,
-                                          scale=scaleparam$`scaled:scale`))
+                                       scale=scaleparam$`scaled:scale`))
 
       x <- as.data.frame(cbind(x_num, lapply(x_cat, as.factor)))
       x_clean <- x[complete.cases(x),]
@@ -452,7 +452,7 @@ sample2test <- function(x, testdata, type,variables,time_unit,timevar, catVars){
       x_clean <- x[complete.cases(x),]
 
       testdata <- data.frame(scale(testdata,center=scaleparam$`scaled:center`,
-                                      scale=scaleparam$`scaled:scale`))
+                                   scale=scaleparam$`scaled:scale`))
     }
 
 
@@ -640,14 +640,19 @@ sampleFromArea <- function(modeldomain, samplesize, type,variables,sampling, cat
   sf::st_as_sf(modeldomainextent) |>
     sf::st_transform(4326) -> bb
 
-  methods::as(bb, "Spatial") |>
-    sp::spsample(n = samplesize, type = sampling)  |>
-    sf::st_as_sfc() |>
-    sf::st_set_crs(4326) -> predictionloc
+  #methods::as(bb, "Spatial") |>
+  # sp::spsample(n = samplesize, type = sampling)  |>
+  # sf::st_as_sfc() |>
+  # sf::st_set_crs(4326) -> predictionloc
+  # predictionloc <- sf::st_as_sf(predictionloc)
 
+  predictionloc <- sf::st_sample(sf::st_make_valid(bb),size=samplesize,type=sampling)
+  sf::st_crs(predictionloc) <- 4326
   predictionloc <- sf::st_as_sf(predictionloc)
 
 
+
+
   if(type == "feature"){
 
     if(is.null(catVars)) {

R/global_validation.R

@@ -9,13 +9,15 @@
 #' @author Hanna Meyer
 #' @seealso \code{\link{CreateSpacetimeFolds}}
 #' @examples
+#' \dontrun{
 #' library(caret)
 #' data(cookfarm)
 #' dat <- cookfarm[sample(1:nrow(cookfarm),500),]
 #' indices <- CreateSpacetimeFolds(dat,"SOURCEID","Date")
 #' ctrl <- caret::trainControl(method="cv",index = indices$index,savePredictions="final")
 #' model <- caret::train(dat[,c("DEM","TWI","BLD")],dat$VW, method="rf", trControl=ctrl, ntree=10)
 #' global_validation(model)
+#' }
 #' @export global_validation
 #' @aliases global_validation
 

tests/testthat/test-aoa.R

@@ -13,9 +13,10 @@ loaddata <- function() {
   # train a model:
   set.seed(100)
   variables <- c("DEM","NDRE.Sd","TWI")
-  model <- train(trainDat[,which(names(trainDat)%in%variables)],
+  ctrl <- caret::trainControl(method="cv",number=5,savePredictions=T)
+  model <- caret::train(trainDat[,which(names(trainDat)%in%variables)],
                  trainDat$VW, method="rf", importance=TRUE, tuneLength=1,
-                 trControl=trainControl(method="cv",number=5,savePredictions=T))
+                 trControl=ctrl)
 
 
   data <- list(
@@ -30,6 +31,7 @@ loaddata <- function() {
 
 
 test_that("AOA works in default: used with raster data and a trained model", {
+  skip_if_not_installed("randomForest")
   dat <- loaddata()
   # calculate the AOA of the trained model for the study area:
   AOA <- aoa(dat$studyArea, dat$model, verbose = F)
@@ -54,6 +56,7 @@ test_that("AOA works in default: used with raster data and a trained model", {
 
 
 test_that("AOA works without a trained model", {
+  skip_if_not_installed("randomForest")
   dat <- loaddata()
   AOA <- aoa(dat$studyArea,train=dat$trainDat,variables=dat$variables, verbose = F)
 
@@ -93,6 +96,7 @@ test_that("AOA (including LPD) works with raster data and a trained model", {
 
 
 test_that("AOA (inluding LPD) works without a trained model", {
+  skip_if_not_installed("randomForest")
   dat <- loaddata()
   AOA <- aoa(dat$studyArea,train=dat$trainDat,variables=dat$variables, LPD = TRUE, maxLPD = 1, verbose = F)
 

tests/testthat/test-errorProfiles.R

@@ -2,6 +2,8 @@
 test_that("errorProfiles works in default settings", {
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
+  skip_if_not_installed("scam")
   data(splotdata)
   splotdata <- sf::st_drop_geometry(splotdata)
   predictors <- terra::rast(system.file("extdata","predictors_chile.tif", package="CAST"))
@@ -23,7 +25,7 @@ test_that("errorProfiles works in default settings", {
   expect_equal(round(as.numeric(summary(errormodel_DI$fitted.values)),2),
                c(14.25, 14.34, 15.21, 17.23, 18.70, 27.46))
   # test model predictions
-  expect_equal(as.vector( summary(terra::values(expected_error_DI))),
+  expect_equal(as.vector(summary(terra::values(expected_error_DI))),
                c("Min.   :14.26  ", "1st Qu.:27.46  ", "Median :27.46  ",
                  "Mean   :26.81  ", "3rd Qu.:27.46  ","Max.   :27.47  ",
                  "NA's   :17678  "))
@@ -33,6 +35,8 @@ test_that("errorProfiles works in default settings", {
 test_that("errorProfiles works in with LPD", {
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
+  skip_if_not_installed("scam")
   data(splotdata)
   splotdata <- sf::st_drop_geometry(splotdata)
   predictors <- terra::rast(system.file("extdata","predictors_chile.tif", package="CAST"))
@@ -62,6 +66,8 @@ test_that("errorProfiles works in with LPD", {
 test_that("errorProfiles works for multiCV", {
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
+  skip_if_not_installed("scam")
   data(splotdata)
   splotdata <- sf::st_drop_geometry(splotdata)
   predictors <- terra::rast(system.file("extdata","predictors_chile.tif", package="CAST"))

tests/testthat/test-fss.R

@@ -2,6 +2,7 @@
 test_that("ffs works with default arguments and the splotopen dataset (numerical only)",{
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
   data("splotdata")
   splotdata = splotdata |> sf::st_drop_geometry()
   set.seed(1)
@@ -25,6 +26,7 @@ test_that("ffs works with default arguments and the splotopen dataset (numerical
 test_that("ffs works with default arguments and the splotopen dataset (include categorial)",{
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
   data("splotdata")
   splotdata = splotdata |> sf::st_drop_geometry()
   set.seed(1)
@@ -44,6 +46,7 @@ test_that("ffs works with default arguments and the splotopen dataset (include c
 test_that("ffs works for classification with default arguments",{
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
   data("splotdata")
   splotdata = splotdata |> sf::st_drop_geometry()
   splotdata$Biome = droplevels(splotdata$Biome)
@@ -66,6 +69,7 @@ test_that("ffs works for classification with default arguments",{
 test_that("ffs works for withinSE = TRUE",{
   skip_on_cran()
   skip_on_os("mac", arch = "aarch64")
+  skip_if_not_installed("randomForest")
   data("splotdata")
   splotdata = splotdata |> sf::st_drop_geometry()
   splotdata$Biome = droplevels(splotdata$Biome)
@@ -97,6 +101,7 @@ test_that("ffs works for withinSE = TRUE",{
 
 
   test_that("ffs works with default arguments and the iris dataset",{
+    skip_if_not_installed("randomForest")
     data(iris)
     set.seed(1)
     selection = ffs(predictors = iris[,1:4],
@@ -113,6 +118,7 @@ test_that("ffs works for withinSE = TRUE",{
 
   test_that("ffs works with globalVal = TRUE", {
     skip_on_cran()
+    skip_if_not_installed("randomForest")
     data(iris)
     set.seed(1)
     selection = ffs(predictors = iris[,1:4],
@@ -127,6 +133,7 @@ test_that("ffs works for withinSE = TRUE",{
 
   test_that("ffs works with withinSE = TRUE", {
     skip_on_cran()
+    skip_if_not_installed("randomForest")
     data(iris)
     set.seed(1)
     selection = ffs(predictors = iris[,1:4],
@@ -143,6 +150,7 @@ test_that("ffs works for withinSE = TRUE",{
 
   test_that("ffs fails with minvar set to maximum", {
     skip_on_cran()
+    skip_if_not_installed("randomForest")
     data(iris)
     set.seed(1)
     expect_error(ffs(predictors = iris[,1:4],