fetchVegdata: include_pedon add "assocuserpedonid" option

R/fetchVegdata.R

@@ -1,24 +1,27 @@
-# updated to NASIS 6.2
-
-# convenience function for loading most commonly used vegplot information from local NASIS database
 #' Get vegetation plot data from local NASIS database
-#' @aliases get_vegplot_from_NASIS_db
-#' get_vegplot_location_from_NASIS_db get_vegplot_species_from_NASIS_db
-#' get_vegplot_textnote_from_NASIS_db get_vegplot_transect_from_NASIS_db
-#' get_vegplot_transpecies_from_NASIS_db
-#' get_vegplot_tree_si_details_from_NASIS_db
-#' get_vegplot_tree_si_summary_from_NASIS_db get_vegplot_trhi_from_NASIS_db
 #'
-#' @param SS fetch data from the currently loaded selected set in NASIS or from the entire local database (default: `TRUE`)
-#' @param include_pedon Include pedon and transect data joined to site? (default: `TRUE`)
+#' Convenience function for loading most commonly used Vegetation Plot information from local NASIS
+#' database.
+#'
+#' @param SS fetch data from the currently loaded selected set in NASIS or from the entire local
+#'   database (default: `TRUE`)
+#' @param include_pedon Include pedon and transect data joined to site? (default: `TRUE`). If
+#'   `include_pedon` is set to `"assocuserpedonid"` only pedon records that are linked through the
+#'   Associated User Pedon ID column will have their peiid reported in the `vegplot` table.
 #' @param stringsAsFactors deprecated
-#' @param dsn Optional: path to local SQLite database containing NASIS
-#' table structure; default: `NULL`
+#' @param dsn Optional: path to local SQLite database containing NASIS table structure; default:
+#'   `NULL`
 #'
-#' @return A named list containing: "vegplot", "vegplotlocation", "vegplotrhi", "vegplotspecies", "vegtransect", "vegtransplantsum", 'vegsiteindexsum', "vegsiteindexdet", "vegbasalarea", and  "vegplottext" tables
+#' @return A named list containing: "vegplot", "vegplotlocation", "vegplotrhi", "vegplotspecies",
+#'   "vegtransect", "vegtransplantsum", 'vegsiteindexsum', "vegsiteindexdet", "vegbasalarea", and
+#'   "vegplottext" tables
 #'
+#' @aliases get_vegplot_from_NASIS_db get_vegplot_location_from_NASIS_db
+#'   get_vegplot_species_from_NASIS_db get_vegplot_textnote_from_NASIS_db
+#'   get_vegplot_transect_from_NASIS_db get_vegplot_transpecies_from_NASIS_db
+#'   get_vegplot_tree_si_details_from_NASIS_db get_vegplot_tree_si_summary_from_NASIS_db
+#'   get_vegplot_trhi_from_NASIS_db
 #' @export
-#'
 fetchVegdata <- function(SS = TRUE, include_pedon = TRUE, stringsAsFactors = NULL, dsn = NULL) {
 
   if (!missing(stringsAsFactors) && is.logical(stringsAsFactors)) {
@@ -31,7 +34,7 @@ fetchVegdata <- function(SS = TRUE, include_pedon = TRUE, stringsAsFactors = NUL
   .soilDB_test_NASIS_connection(dsn = dsn)
 
 	# 1. load data in pieces
-	site <- get_site_data_from_NASIS_db(SS = SS, include_pedon = include_pedon, dsn = dsn)
+  site <- get_site_data_from_NASIS_db(SS = SS, include_pedon = ifelse(include_pedon == "assocuserpedonid", TRUE, include_pedon), dsn = dsn)
   vegplot <- get_vegplot_from_NASIS_db(SS = SS, dsn =  dsn)
   vegplotlocation <- get_vegplot_location_from_NASIS_db(SS = SS,  dsn =  dsn)
   vegplotrhi <-  get_vegplot_trhi_from_NASIS_db(SS = SS, dsn =  dsn)
@@ -53,26 +56,34 @@ fetchVegdata <- function(SS = TRUE, include_pedon = TRUE, stringsAsFactors = NUL
 
   # add ecosite id, corrdate, selection method to vegplot
   es_cols <- c("siteiid", "ecositeid", "ecositecorrdate", "siteecositehistory.classifier", "es_selection_method")
-  if (include_pedon) {
-    es_cols <- c(es_cols, "peiid")
-  }
   vegplot <- merge(site[, es_cols], vegplot, by = "siteiid", all.x = TRUE, sort = FALSE)
+
+  # add peiid information to vegplot
+  if (is.character(include_pedon) && include_pedon == "assocuserpedonid") {
+    match.idx <- match(vegplot$pedon_id, site$pedon_id)  # TODO: remove alias for assocuserpedonid
+    vegplot$peiid <- site$peiid[match.idx]
+  } else if (isTRUE(include_pedon)) {
+    # any pedon linked to the same site is included (may cause duplication)
+    pe_cols <- c("siteiid", "peiid")
+    vegplot <- merge(site[, pe_cols], vegplot, by = "siteiid", all.x = TRUE, sort = FALSE)
+  }
 
-	# done
-	return(list(
-	    vegplot = vegplot,
-	    vegplotlocation = vegplotlocation,
-	    vegplotrhi = vegplotrhi,
-	    vegplotspecies = vegplotspecies,
-	    vegtransect = vegtransect,
-	    vegtransplantsum = vegtransplantsum,
-	    vegtranspoint = vegtranspoint,
-	    vegprodquadrat = vegprodquadrat,
-	    vegsiteindexsum = vegsiteindexsum,
-	    vegsiteindexdet = vegsiteindexdet,
-	    vegbasalarea = vegbasalarea,
-	    vegplottext = vegplottext,
-	    site = site
-	  ))
+  return(
+    list(
+      vegplot = vegplot,
+      vegplotlocation = vegplotlocation,
+      vegplotrhi = vegplotrhi,
+      vegplotspecies = vegplotspecies,
+      vegtransect = vegtransect,
+      vegtransplantsum = vegtransplantsum,
+      vegtranspoint = vegtranspoint,
+      vegprodquadrat = vegprodquadrat,
+      vegsiteindexsum = vegsiteindexsum,
+      vegsiteindexdet = vegsiteindexdet,
+      vegbasalarea = vegbasalarea,
+      vegplottext = vegplottext,
+      site = site
+    )
+  )
 }