get_mapunit_from_NASIS_db: Add dominant MLRA area references

- #272
ncss-tech · Feb 12, 2024 · 1ea2390 · 1ea2390
1 parent d28901b
commit 1ea2390
Showing 1 changed file with 9 additions and 6 deletions.
diff --git a/R/get_mapunit_from_NASIS.R b/R/get_mapunit_from_NASIS.R
@@ -61,9 +61,12 @@ get_mapunit_from_NASIS <- function(SS = TRUE,
                      ORDER BY areasymbol, musym
                      ;")
 
+  q.dommlra <- "SELECT lmapunitiid, area.areasymbol AS lmapunit_mlra FROM area LEFT JOIN lmapunit_View_1 ON area.areaiid = lmapunit_View_1.mlraareaiidref"
+
   # toggle selected set vs. local DB
   if (SS == FALSE) {
     q.mapunit <- gsub(pattern = '_View_1', replacement = '', x = q.mapunit, fixed = TRUE)
+    q.dommlra <- gsub(pattern = '_View_1', replacement = '', x = q.dommlra, fixed = TRUE)
   }
 
   channel <- dbConnectNASIS(dsn)
@@ -72,7 +75,8 @@ get_mapunit_from_NASIS <- function(SS = TRUE,
     return(data.frame())
 
   # exec query
-  d.mapunit <- dbQueryNASIS(channel, q.mapunit)
+  d.mapunit <- dbQueryNASIS(channel, q.mapunit, close = FALSE)
+  d.dommlra <- dbQueryNASIS(channel, q.dommlra)
 
   # recode metadata domains
   d.mapunit <- uncode(d.mapunit, droplevels = droplevels, dsn = dsn)
@@ -96,8 +100,7 @@ get_mapunit_from_NASIS <- function(SS = TRUE,
     d.mapunit$farmlndcl = droplevels(d.mapunit$farmlndcl)
   }
 
-  # cache original column names
-  orig_names <- names(d.mapunit)
+  d.mapunit <- merge(d.mapunit, d.dommlra, by = "lmapunitiid", all.x = TRUE, sort = FALSE)
 
   # done
   return(d.mapunit)
@@ -122,7 +125,7 @@ get_legend_from_NASIS <- function(SS = TRUE,
                      areasymbol, areaname, areatypename, CAST(areaacres AS INTEGER) AS areaacres, ssastatus,
                      CAST(projectscale AS INTEGER) projectscale, cordate,
                      CAST(liid AS INTEGER) liid, COUNT(lmu.lmapunitiid) n_lmapunitiid, legendsuituse
-
+                     
                      FROM
                      area     a                                  INNER JOIN
                      legend_View_1   l      ON l.areaiidref = a.areaiid INNER JOIN
@@ -140,7 +143,7 @@ get_legend_from_NASIS <- function(SS = TRUE,
                      ;")
 
   # toggle selected set vs. local DB
-  if(SS == FALSE) {
+  if (SS == FALSE) {
     q.legend <- gsub(pattern = '_View_1', replacement = '', x = q.legend, fixed = TRUE)
   }
 
@@ -150,7 +153,7 @@ get_legend_from_NASIS <- function(SS = TRUE,
     return(data.frame())
 
   # exec query
-  d.legend <- dbQueryNASIS(channel, q.legend)
+  d.legend <- dbQueryNASIS(channel, q.legend, close = FALSE)
 
   # recode metadata domains
   d.legend <- uncode(d.legend, droplevels = droplevels, dsn = dsn)