Merge pull request #56 from rvalavi/v3.2

V3.2 update

Author: rvalavi

.github/workflows/R-CMD-check.yml

@@ -1,25 +1,32 @@
-on:
-  push:
-    branches: [ master ]
-  pull_request:
-    branches: [ master ]
-
-name: R-CMD-check
-
-jobs:
-  R-CMD-check:
-    runs-on: macOS-latest
-    steps:
-      - uses: actions/checkout@v3
-      - uses: r-lib/actions/setup-r@v2
-      - name: Setting up pandoc for Rmd docs
-        uses: r-lib/actions/setup-pandoc@v2
-      - uses: r-lib/actions/setup-tinytex@v2
-      - name: Install dependencies
-        run: |
-          install.packages(c("remotes", "rcmdcheck"))
-          remotes::install_deps(dependencies = TRUE)
-        shell: Rscript {0}
-      - name: Check
-        run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error")
-        shell: Rscript {0}
+on:
+  push:
+    branches: [ master ]
+  pull_request:
+    branches: [ master ]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - uses: r-lib/actions/setup-r@v2
+      - name: Setting up pandoc for Rmd docs
+        uses: r-lib/actions/setup-pandoc@v2
+      - uses: r-lib/actions/setup-tinytex@v2
+      - name: Install dependencies
+        run: |
+          install.packages(c("remotes", "rcmdcheck", "covr"))
+          remotes::install_deps(dependencies = TRUE)
+        shell: Rscript {0}
+
+      - name: Check
+        run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error")
+        shell: Rscript {0}
+
+      - name: Test coverage
+        run: covr::codecov()
+        shell: Rscript {0}
+        env:
+          CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}

.gitignore

@@ -10,3 +10,5 @@ vignettes/tutorial_1.R
 vignettes/tutorial_1.html
 vignettes/tutorial_2.R
 vignettes/tutorial_2.html
+/doc/
+/Meta/

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: blockCV
 Type: Package
 Title: Spatial and Environmental Blocking for K-Fold and LOO Cross-Validation
-Version: 3.1-7
-Date: 2025-08-01
+Version: 3.2-0
+Date: 2025-08-15
 Authors@R: c(person("Roozbeh", "Valavi", role = c("aut", "cre"),
                     email = "valavi.r@gmail.com", comment = c(ORCID = "0000-0003-2495-5277")),
              person("Jane", "Elith", role = "aut",

NEWS.md

@@ -1,12 +1,17 @@
+# version 3.2.0
+* Added two new methods, L1 and L2 distances, to the `cv_similarity` function
+* Fixed a warning in `cv_similarity` for colour aesthetics with ggplot
+* Fixed the summary method and plotting for `cv_spatial_autocor`
+
 # version 3.1.7
-* Temporarily added `sp` package dependency to avoid CRAN check as required by `automap` package [#55].
+* Temporarily added `sp` package dependency to avoid CRAN error as required by `automap` package [#55].
 
 # version 3.1.6
 * Resolved unclear error messages; issue [#52](https://github.com/rvalavi/blockCV/issues/52) by A. Márcia Barbosa
 * Resolved ggplot testing failure; issue [#54](https://github.com/rvalavi/blockCV/issues/54) by Teun van den Brand
 
 # version 3.1.5
-* Resolved background pattern artifacts in raster plotting; issue [#50](https://github.com/rvalavi/blockCV/issues/50) by Camila Neder.
+* Resolved background pattern artefacts in raster plotting; issue [#50](https://github.com/rvalavi/blockCV/issues/50) by Camila Neder.
 
 # version 3.1.4
 * Just the `biomod2` example is updated in vignettes; and the link in help file
@@ -40,7 +45,7 @@
 * Massive performance improvement in the C++ code of `cv_nndm` function for large datasets
 
 # version 3.0
-* Dependency to rgdal and rgeos are removed, and overall less dependency
+* Dependency to `rgdal` and `rgeos` are removed, and overall less dependency
 * Function names have been changed, with all functions now starting with `cv_`
 * The old functions (v2.x) still work to allow appropriate time for adapting the new code
 * The CV blocking functions are now: `cv_spatial`, `cv_cluster`, `cv_buffer`, and `cv_nndm`

R/RcppExports.R

@@ -5,3 +5,7 @@ nndm_cpp <- function(X, Gij, phi, min_train) {
     .Call(`_blockCV_nndm_cpp`, X, Gij, phi, min_train)
 }
 
+similarity_cpp <- function(train_mat, test_mat, rand_mat, L1 = TRUE) {
+    .Call(`_blockCV_similarity_cpp`, train_mat, test_mat, rand_mat, L1)
+}
+

R/checks.R

@@ -1,8 +1,14 @@
 # Author: Roozbeh Valavi
 # contact: valavi.r@gmail.com
 # Date : May 2023
-# Version 0.2
-# Licence GPL v3
+# Version 0.3
+
+# check the object is a blockCV object
+.check_cv <- function(x) {
+    is_cv <- inherits(x, c("cv_spatial", "cv_cluster", "cv_buffer", "cv_nndm"))
+    if (!is_cv) stop("'cv' must be a blockCV cv_* object.")
+}
+
 
 # check points fall within the raster layer
 .check_within <- function(x, r) {

R/cv_block_size.R

@@ -108,8 +108,7 @@ cv_block_size <- function(
     if(!is.null(x)){
         geom_x <- ggplot2::geom_sf(
             data = x,
-            switch(!is.null(column), ggplot2::aes(colour = {{ column }}), NULL),
-            # ggplot2::aes(colour = {{ switch(!is.null(column), column, NULL) }}),
+            switch(!is.null(column), ggplot2::aes(colour = {{ column }})),
             inherit.aes = FALSE,
             alpha = 0.5
         )
@@ -158,7 +157,7 @@ cv_block_size <- function(
                                  fill = "orangered4",
                                  alpha = 0.04,
                                  size = 0.2) +
-                switch(!is.null(x), geom_x, NULL) +
+                switch(!is.null(x), geom_x) +
                 ggplot2::ggtitle("Spatial blocks",
                                  subtitle=paste("Using",
                                                 input$num,

R/cv_buffer.R

@@ -117,7 +117,7 @@ cv_buffer <- function(
     add_bg <- (presence_bg && add_bg)
 
     if(progress) pb <- utils::txtProgressBar(min = 0, max = n, style = 3)
-    fold_list <- lapply(x_1s, function(i, pbag = add_bg){
+    fold_list <- lapply(x_1s, function(i, pbag = add_bg) {
         if(pbag){
             test_ids <- which(dmatrix[i, ] <= size)
             inside <- x[test_ids, column, drop = TRUE]
@@ -127,14 +127,13 @@ cv_buffer <- function(
             test_set <- i
         }
         if(progress) utils::setTxtProgressBar(pb, i)
-        list(as.numeric(which(dmatrix[i, ] > size)),
-             as.numeric(test_set))
-    }
-    )
+
+        list(as.numeric(which(dmatrix[i, ] > size)), as.numeric(test_set))
+    })
 
     # calculate train test table summary
     if(report){
-        train_test_table <- .ttt(fold_list, x, column, n)
+        train_test_table <- .table_summary(fold_list, x, column, n)
         print(summary(train_test_table)[c(1,4,6), ])
     }
 
@@ -172,32 +171,3 @@ summary.cv_buffer <- function(object, ...){
     }
 }
 
-
-# count the train and test records
-.ttt <- function(fold_list, x, column, n){
-    if(is.null(column)){
-        tt_count <- base::data.frame(train = rep(0, n), test = 0)
-        for(i in seq_len(n)){
-            train_set <- fold_list[[i]][[1]]
-            test_set <- fold_list[[i]][[2]]
-            tt_count$train[i] <- length(train_set)
-            tt_count$test[i] <- length(test_set)
-        }
-    } else{
-        cl <- sort(unique(x[, column, drop = TRUE]))
-        clen <- length(cl)
-        .check_classes(clen, column) # column should be binary or categorical
-        tt_count <- as.data.frame(matrix(0, nrow = n, ncol = clen * 2))
-        names(tt_count) <- c(paste("train", cl, sep = "_"), paste("test", cl, sep = "_"))
-        for(i in seq_len(n)){
-            train_set <- fold_list[[i]][[1]]
-            test_set <- fold_list[[i]][[2]]
-            countrain <- table(x[train_set, column, drop = TRUE])
-            countest <- table(x[test_set, column, drop = TRUE])
-            tt_count[i, which(cl %in% names(countrain))] <- countrain
-            tt_count[i, clen + which(cl %in% names(countest))] <- countest
-        }
-    }
-
-    return(tt_count)
-}

R/cv_cluster.R

@@ -205,7 +205,7 @@ cv_cluster <- function(
     final_objs <- list(
         folds_list = fold_list,
         folds_ids = fold_ids,
-        biomod_table = switch(biomod2, as.matrix(biomod_table), NULL),
+        biomod_table = switch(biomod2, as.matrix(biomod_table)),
         k = k,
         column = column,
         type = ifelse(is.null(r), "Spatial Cluster", "Environmental Cluster"),

R/cv_nndm.R

@@ -186,7 +186,7 @@ cv_nndm <- function(
     )
     # calculate train test table summary
     if(report){
-        train_test_table <- .ttt(fold_list, x, column, n)
+        train_test_table <- .table_summary(fold_list, x, column, n)
         print(summary(train_test_table)[c(1,4,6), ])
     }