simplifyFragmentData/simplifyArtifactData: refactor "all records miss…

…ing" volume for better efficiency

NEWS.md

@@ -12,7 +12,8 @@
    - `get_soilseries_from_NASIS()`: replace `areasymbol` column to use relationship-style name `"soilseries_typelocst"` (minor breaking change)
  - `fetchSDA_spatial()`: Add support for querying mapunit point (`"mupoint"`), mapunit line (`"muline"`), special feature point (`"featpoint"`), special feature line (`"featline"`) by `mukey` or `featkey`, geometry type selectable via `geom.src` argument
  - `SDA_spatialQuery()`: Add support for querying mapunit point (`"mupoint"`), mapunit line (`"muline"`), special feature point (`"featpoint"`), special feature line (`"featline"`) for a spatial extent, geometry type selectable via `what` argument
-
+ - `simplifyFragmentData()` / `simplifyArtifactData()` efficiency improvement when all records are missing data
+
 # soilDB 2.8.1 (2024-01-09)
 
  - `get_mapunit_from_NASIS()`, `get_lmuaoverlap_from_NASIS()` and `get_legend_from_NASIS()` gain `areatypename` argument used for filtering legends by `areatypename`. 

R/simplifyArtifactData.R

@@ -50,18 +50,15 @@ simplifyArtifactData <- function(art, id.var, vol.var = "huartvol", nullFragsAre
   # artifact size classes, using fragment breaks, are used in this function
   art.classes <- c('art_fgr', 'art_gr', 'art_cb', 'art_st', 'art_by', 'art_ch', 'art_fl', 'art_unspecified')
   result.columns <- c(id.var, art.classes, "total_art_pct", "huartvol_cohesive", "huartvol_penetrable", "huartvol_innocuous", "huartvol_persistent")
-
-  # warn the user and remove the NA records
 
-  # if all fragvol are NA then rf is an empty data.frame and we are done
+  # warn the user and remove the NA records
+  # if all huartvol are NA then result is a data frame with all ID values NA
   if (nrow(art[which(!is.na(art[[vol.var]])),]) == 0) {
     message('NOTE: all records are missing artifact volume')
-    dat <- as.data.frame(t(rep(NA, length(result.columns))))
-    for (i in 1:length(art[[id.var]])) {
-      dat[i, ] <- dat[1, ]
-      dat[i, which(result.columns == id.var)] <- art[[id.var]][i]
-    }
+    dat <- as.data.frame(t(rep(NA, length(result.columns))))[seq_len(length(art[[id.var]])),]
+    dat[[which(result.columns == id.var)]] <- art[[id.var]]
     colnames(dat) <- result.columns
+    rownames(dat) <- NULL
     return(dat)
   } else if (any(is.na(art[[vol.var]]))) {
     art <- art[which(!is.na(art[[vol.var]])), ]

R/simplifyFragmentData.R

@@ -166,16 +166,13 @@ simplifyFragmentData <- function(rf, id.var, vol.var = "fragvol", prefix = "frag
   result.columns <- c(id.var, frag.classes, "total_frags_pct", "total_frags_pct_nopf")
 
   # warn the user and remove the NA records
-
-  # if all fragvol are NA then rf is an empty data.frame and we are done
+  # if all fragvol are NA then result is a data frame with all ID values NA
   if (nrow(rf[which(!is.na(rf[[vol.var]])),]) == 0) {
     message(sprintf('NOTE: all records are missing %s', msg))
-    dat <- as.data.frame(t(rep(NA, length(result.columns))))
-    for (i in 1:length(rf[[id.var]])) {
-      dat[i,] <- dat[1,]
-      dat[i,which(result.columns == id.var)] <- rf[[id.var]][i]
-    }
+    dat <- as.data.frame(t(rep(NA, length(result.columns))))[seq_len(length(rf[[id.var]])),]
+    dat[[which(result.columns == id.var)]] <- rf[[id.var]]
     colnames(dat) <- result.columns
+    rownames(dat) <- NULL
     return(dat)
   } else if (any(is.na(rf[[vol.var]]))) {
     rf <- rf[which(!is.na(rf[[vol.var]])), ]