Resolve merge conflicts

Merge branch 'master' into checkPlotCoord

# Conflicts:
#	R/checkPlotCoord.R
#	tests/testthat/test-checkCoordPlot.R

.github/workflows/test-coverage.yaml

@@ -0,0 +1,52 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage.yaml
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: BIOMASS
 Type: Package
 Title: Estimating Aboveground Biomass and Its Uncertainty in Tropical Forests
-Version: 2.1.13
+Version: 2.1.14
 Date: 2024-03-19
 Authors@R: c(
 	person("Maxime", "Réjou-Méchain", email = "[email protected]", role = c("aut", "dtc")),
@@ -13,7 +13,8 @@ Authors@R: c(
 	person("Jerome", "Chave", email = "[email protected]", role = c("dtc")),
 	person("Bruno", "Hérault", email = "[email protected]", role = c("aut")),
 	person("Ted", "Feldpausch", email = "[email protected]", role = c("dtc")),
-	person("Philippe", "Verley", email = "[email protected] ", role = c("ctb"))
+	person("Philippe", "Verley", email = "[email protected] ", role = c("ctb")),
+	person("Arthur", "Bailly", email = "[email protected] ", role = c("aut"))
   )
 Description: Contains functions to estimate aboveground biomass/carbon and its uncertainty in tropical forests. 
 	These functions allow to (1) retrieve and to correct taxonomy, (2) estimate wood density and its uncertainty, 
@@ -50,5 +51,6 @@ Suggests:
 	curl,
 	geodata,
 	httr2,
-	pkgdown
+	pkgdown,
+	dplyr
 RoxygenNote: 7.3.2

NAMESPACE

@@ -3,6 +3,7 @@
 export(AGBmonteCarlo)
 export(attributeTree)
 export(attributeTreeCoord)
+export(bilinear_interpolation)
 export(cacheManager)
 export(cachePath)
 export(checkPlotCoord)
@@ -13,6 +14,7 @@ export(correctCoordGPS)
 export(correctTaxo)
 export(createCache)
 export(cutPlot)
+export(divide_plot)
 export(getBioclimParam)
 export(getTaxonomy)
 export(getWoodDensity)
@@ -28,30 +30,38 @@ importFrom(data.table,":=")
 importFrom(data.table,as.data.table)
 importFrom(data.table,between)
 importFrom(data.table,chmatch)
-importFrom(data.table,copy)
 importFrom(data.table,data.table)
 importFrom(data.table,first)
 importFrom(data.table,fread)
 importFrom(data.table,fwrite)
+importFrom(data.table,is.data.table)
 importFrom(data.table,rbindlist)
 importFrom(data.table,setDF)
 importFrom(data.table,setDT)
+importFrom(data.table,setcolorder)
 importFrom(data.table,setkey)
 importFrom(data.table,setnames)
 importFrom(data.table,tstrsplit)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,arrow)
 importFrom(ggplot2,coord_equal)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,geom_polygon)
 importFrom(ggplot2,geom_segment)
+importFrom(ggplot2,geom_smooth)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggtitle)
+importFrom(ggplot2,labs)
 importFrom(ggplot2,scale_color_manual)
 importFrom(ggplot2,scale_shape_manual)
+importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,scale_y_continuous)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_minimal)
+importFrom(ggplot2,unit)
 importFrom(grDevices,terrain.colors)
 importFrom(graphics,axis)
 importFrom(graphics,grid)

NEWS

@@ -1,3 +1,9 @@
+* version 2.1.14
+- Fix an issue about the inversion of subplot locations in cutPlot
+- Change the automatic corner numbering from counter-clockwise to clockise direction in cutPlot
+- Fix an issue with summaryByPlot when a plot do not contains any tree
+- Replace the procrust analyses used to calculate sub-plot corners with a bilinear interpolation that takes the coordinates of the projected plot corners as references.
+
 * version 2.1.13
 - Activate pkgdown
 

R/bilinear_interpolation.R

@@ -0,0 +1,90 @@
+#' Generalized bilinear interpolation of coordinates
+#'
+#' @description Apply a generalized bilinear interpolation to convert any coordinates from one original coordinate system to another, using the plot's 4 corner coordinates of both system.
+#'
+#' @details
+#' The plot represented by the 4 coordinates in from_corner_coord must have 4 right angles, i.e. a rectangular (or square) plot.
+#' 
+#' @references C. -C. Wei and C. -H. Chen, "Generalized Bilinear Interpolation of Motion Vectors for Quad-Tree Mesh," 2008 International Conference on Intelligent Information Hiding and Multimedia Signal Processing, Harbin, China, 2008, pp. 635-638, doi: 10.1109/IIH-MSP.2008.283.
+#' 
+#'
+#' @param coord a matrix or data.frame : coordinates to be transformed, with X and Y corresponding to the first two columns
+#' @param from_corner_coord a matrix or data.frame : corner coordinates of the plot in the original coordinate system, with X and Y corresponding to the first two columns
+#' @param to_corner_coord a matrix or data.frame : corner coordinates of the plot in the coordinate system to be projected, with the same line order as from_corner_coord and , with X and Y corresponding to the first two columns
+#' @param ordered_corner a logical, indicating if from_corner_coord and to_corner_coord rows are sorted in correct order (clockwise or counter-clockwise)
+#'
+#' @return a data.frame containing the converted coordinates
+#' 
+#' @importFrom data.table is.data.table
+#' 
+#' @export
+#' 
+#' @keywords  generalized bilinear interpolation
+#'
+#' @author Arthur Bailly
+#'
+#' @examples 
+#' from_corner_coord <- expand.grid(X = c(0, 100), Y = c(0, 50))
+#' rot_mat <- matrix(c(cos(-pi/6),sin(-pi/6),-sin(-pi/6),cos(-pi/6)),nrow=2)
+#' to_corner_coord <- as.matrix(from_corner_coord) %*% rot_mat
+#' to_corner_coord <- sweep(to_corner_coord, 2, c(50,100), FUN = "+")
+#' coord <- expand.grid(X = seq(0,100,10), Y = seq(0,50,5))
+#' projCoord = bilinear_interpolation(coord = coord, from_corner_coord = from_corner_coord, to_corner_coord = to_corner_coord)
+#' # plot(coord, xlim=c(-10,150),ylim=c(-5,200), col="blue") ; points(from_corner_coord) ; points(projCoord , col="purple") ; points(to_corner_coord, col="red")
+
+
+bilinear_interpolation = function(coord, from_corner_coord, to_corner_coord, ordered_corner = F) {
+
+  # Parameters verification
+  if(nrow(from_corner_coord)!=4 | nrow(to_corner_coord)!=4 | nrow(from_corner_coord)!=nrow(from_corner_coord)) {
+    stop("from_corner_coord and to_corner_coord must have 4 rows representing the 4 corners of the plot")
+  }
+  if(!(is.data.frame(coord) | is.matrix(coord) | is.data.table(coord))){
+    stop("tree coordinates must be a data.frame, a matrix or a data.table")
+  }
+  if(is.data.table(coord)) coord <- data.frame(coord)
+  if(is.data.table(from_corner_coord) | is.data.table(to_corner_coord)) {
+    from_corner_coord <- data.frame(from_corner_coord)
+    to_corner_coord <- data.frame(to_corner_coord)
+  }
+
+  # to_corner_coord colnames attribution
+  if(is.null(colnames(to_corner_coord))) {
+    to_corner_coord <- to_corner_coord[,1:2]
+    colnames(to_corner_coord) <- c("x_interp","y_interp")
+  }
+
+  # Sorting rows if necessary
+  centroid <- colMeans(from_corner_coord[,1:2])
+  if(!ordered_corner) {
+    # Sort from_corner_coord and to_corner_coord rows in a counter-clockwise direction
+    angles <- atan2(from_corner_coord[, 2] - centroid[2], from_corner_coord[, 1] - centroid[1])
+    from_corner_coord <- from_corner_coord[order(angles), ]
+    to_corner_coord <- to_corner_coord[order(angles), ]
+  }
+
+  # Verification of a rectangular plot for from_corner_coord
+  if(!all(abs(dist(rbind(from_corner_coord[,1:2],centroid))[c(4,7,9,10)] - mean(dist(rbind(from_corner_coord[,1:2],centroid))[c(4,7,9,10)]))<0.1)) {
+    stop("The plot in the relative coordinate system is not a rectangle (or a square). You may consider using trustGPScorners = F")
+  }
+
+  x_A <- from_corner_coord[1,1] ; x_B <- from_corner_coord[2,1] ; x_C <- from_corner_coord[3,1]  ; x_D <- from_corner_coord[4,1]
+  y_A <- from_corner_coord[1,2] ; y_B <- from_corner_coord[2,2] ; y_C <- from_corner_coord[3,2] ; y_D <- from_corner_coord[4,2]
+  u_A <- to_corner_coord[1,1] ; u_B <- to_corner_coord[2,1];  u_C <- to_corner_coord[3,1];  u_D <- to_corner_coord[4,1] 
+  v_A <- to_corner_coord[1,2] ; v_B <- to_corner_coord[2,2] ; v_C <- to_corner_coord[3,2] ; v_D <- to_corner_coord[4,2] 
+
+  apply_bilinear_interpolation <- function(x,y,to_corner_coord_colnames) {
+    rate_A <- (1-(x-x_A)/(x_C-x_A)) * (1-(y-y_A)/(y_C-y_A))
+    rate_B <- (1-(x-x_B)/(x_D-x_B)) * (1-(y-y_B)/(y_D-y_B))
+    rate_C <- (1-(x-x_C)/(x_A-x_C)) * (1-(y-y_C)/(y_A-y_C))
+    rate_D <- (1-(x-x_D)/(x_B-x_D)) * (1-(y-y_D)/(y_B-y_D))
+    interp_df <- data.frame(
+      rate_A*u_A + rate_B*u_B + rate_C*u_C + rate_D*u_D,
+      rate_A*v_A + rate_B*v_B + rate_C*v_C + rate_D*v_D
+    )
+    setnames(interp_df, new = to_corner_coord_colnames)
+    interp_df
+  }
+
+  return(apply_bilinear_interpolation(x=coord[,1],y=coord[,2],to_corner_coord_colnames=colnames(to_corner_coord)[1:2]))
+}

R/checkPlotCoord.R

@@ -78,7 +78,6 @@
 #'
 checkPlotCoord <- function(projCoord = NULL, longlat = NULL, relCoord, trustGPScorners, cornerID=NULL, maxDist = 15, rmOutliers = TRUE,  drawPlot = TRUE, treeCoord = NULL) {
 
-
   warning("please, use check_plot_coord() instead of checkPlotCoord(). `checkPlotCoord' will be removed in the next version ")
 
   # Checking arguments -------------------------------------------------
@@ -146,7 +145,7 @@ checkPlotCoord <- function(projCoord = NULL, longlat = NULL, relCoord, trustGPSc
   }
 
   if(trustGPScorners == TRUE) {
-    
+
     if(nrow(projCoord)!= 4) { # if multiple measures of each corner, then do the mean of coordinates and search for outliers
 
       cornerCoord <- data.table(cbind(projCoord[,1:2], relCoord[,1:2],cornerID=cornerID))

R/correctTaxo.R

@@ -117,7 +117,7 @@ correctTaxo <- function(genus, species = NULL, score = 0.5, useCache = FALSE, ve
   # sub-function definition -------------------------------------------------
 
   # split x always returning count columns (padding with NA)
-  tstrsplit_NA <- function(x, pattern = " ", count = 2) {
+  tstrsplit_NA <- function(x, pattern = "\\s+", count = 2) {
     # NOTE extraneous columns ignored maybe better paste them together
     split <- utils::head(tstrsplit(x, pattern), count)
 
@@ -130,7 +130,13 @@ correctTaxo <- function(genus, species = NULL, score = 0.5, useCache = FALSE, ve
 
   # Data preparation --------------------------------------------------------
 
-  genus <- as.character(genus)
+  # remove spaces at beginning and end, and remove extra spacing
+  squish <- function(x) {
+    x <- gsub("(^\\s+)|(\\s+$)", "", x)
+    gsub("\\s+", " ", x)
+  }
+
+  genus <- squish(as.character(genus))
 
   if (is.null(species)) {
 
@@ -143,7 +149,7 @@ correctTaxo <- function(genus, species = NULL, score = 0.5, useCache = FALSE, ve
     # split genus (query)
     userTaxo[, c("genus", "species") := tstrsplit_NA(query)]
   } else {
-    species <- as.character(species)
+    species <- squish(as.character(species))
 
     # Create a dataframe with the original values
     userTaxo <- data.table(
@@ -156,10 +162,10 @@ correctTaxo <- function(genus, species = NULL, score = 0.5, useCache = FALSE, ve
   }
 
   # If there is an empty genus
-  userTaxo[genus == "", ":="(genus = NA_character_, species = NA_character_, query = NA_character_)]
+  userTaxo[is.na(genus) | (genus == ""), ":="(genus = NA_character_, species = NA_character_, query = NA_character_)]
 
   # If there is empty species
-  userTaxo[species == "", ":="(species = NA_character_, query = gsub(" ", "", query))]
+  userTaxo[is.na(species) | (species == ""), ":="(species = NA_character_, query = gsub(" ", "", query))]
 
   # get unique values
   qryTaxo <- unique(userTaxo[!is.na(query)])

R/cutPlot.R

@@ -4,10 +4,10 @@ if (getRversion() >= "2.15.1") {
   ))
 }
 
-#' Divides a plot in subplots
+#' Divides one ore more plots into subplots
 #'
 #' This function divides a plot (or several plots) in subplots and returns the coordinates of the grid.
-#' This function uses a procrust analysis to fit the rectangle you gave to the plot you have.
+#' These coordinates are calculated by a bilinear interpolation with the projected corner coordinates as references.  
 #'
 #' @param projCoord A data frame containing the projected coordinates of plot corners, with X and Y on the first and second column respectively
 #' @param plot A vector indicating the plot codes
@@ -98,9 +98,9 @@ cutPlot <- function(projCoord, plot, cornerNum, gridsize = 100, dimX = 200, dimY
     ))
 
     # Transformation of relative grid coordinates into absolute coordinates
-    absCoord <- bilinearInterpolation(relCoord = gridMat , cornerCoord = data[,.(X,Y,cornerNum)] ,dimX = plotDimX, dimY = plotDimY )
+    absCoord <- bilinear_interpolation(coord = gridMat , from_corner_coord = relCoordMat , to_corner_coord = absCoordMat )
 
-    return(data.table(XRel = gridMat[, 1], YRel = gridMat[, 2], absCoord[, 1], absCoord[, 2]))
+    return(data.table(XRel = gridMat[, 1], YRel = gridMat[, 2], XAbs=absCoord[, 1], YAbs=absCoord[, 2]))
   }
 
   # Apply gridFunction to all plots