update strata collapsing

R/check.pltcnt.R

@@ -145,7 +145,6 @@ check.pltcnt <- function(pltx, puniqueid=NULL, unitlut, unitvars=NULL,
   }
 
   if (showwarnings && any(pltcnt$errtyp == "warn")) {
-
     msg <- "## warnings/errors"
     message("\n################################### \n",
             msg, "\n###################################")

R/groupStrata.R

@@ -44,7 +44,8 @@ groupEstunit <- function(x, minplotnum) {
 
 #' @rdname internal_desc
 #' @export
-groupStrata <- function(x, minplotnum, nvar="n.strata") {
+groupStrata <- function(x, minplotnum, nvar = "n.strata", 
+                        strvar = NULL, stratalevels = NULL) {
   ## DESCRIPTION: Groups strata with total plots <= minplotnum.
   ## Strata that have less than minplotnum are combined with the strata
   ## next in order (numeric or alphabetical). If there are no strata
@@ -54,16 +55,34 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") {
 
   ## set global variables
   strat=stratnew <- NULL
-  # print(x) # commented out by Grayson... don't think this should be here
+   #print(x) # commented out by Grayson... don't think this should be here
+
+  ## make strata factor
+  getfactor <- FALSE
+  if (!is.null(strvar) && !is.factor(x[[strvar]])) {
+    getfactor <- TRUE
+    strvarclass <- class(x[[strvar]])
+    if (!is.null(stratalevels)) {
+      x[[strvar]] <- factor(x[[strvar]], levels=stratalevels)
+    } else (
+      x[[strvar]] <- factor(x[[strvar]])
+    )
+  }
 
   if (any(x[[nvar]] < minplotnum)) {
     strats <- x$strat
     agstrats <- {}
+
     for (stratum in strats) {
       if (!stratum %in% agstrats) {
-        agstrats <- c(stratum)
-        if (x[strat %in% stratum][[nvar]] >= minplotnum) {
-          x[strat %in% stratum][["stratnew"]] <- stratum
+        agstrats <- stratum
+        if (!is.null(strvar) && strvar %in% names(x)) {
+          newnm <- x[strat %in% stratum, get(strvar)]
+        } else {
+          newnm <- stratum
+        }
+        if (x[x$strat %in% stratum][[nvar]] >= minplotnum) {
+          x[x$strat %in% stratum][["stratnew"]] <- newnm
         } else {
           maxag <- sum(x[strat %in% stratum][[nvar]])
           while (maxag < minplotnum) {
@@ -76,7 +95,11 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") {
               stratag <- x[stratnew == as.character(stratnewcd)][["strat"]]
               agstrats <- c(stratag, agstrats)
             }
-            agstratsnm <- paste(agstrats, collapse="-")
+            if (!is.null(strvar)) {
+              agstratsnm <- paste(x[strat %in% agstrats, get(strvar)], collapse="-")
+            } else {
+              agstratsnm <- paste(agstrats, collapse="-")
+            }
             maxag <- sum(x[strat %in% agstrats][[nvar]])
             x[strat %in% agstrats][["stratnew"]] <- agstratsnm
           }
@@ -87,6 +110,14 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") {
   } else {
     x$stratnew <- as.character(x$strat)
   }
+
+  if (getfactor) {
+    if (strvarclass == "integer") {
+      x[[strvar]] <- as.integer(as.character(x[[strvar]]))
+    } else if (strvarclass == "character") {
+      x[[strvar]] <- as.character(x[[strvar]])
+    }
+  }
   return(x)
 }
 

R/query_functions.R

@@ -156,32 +156,37 @@ getcombineqry <- function(lut,
                           tab. = "") {
   ## DESCRIPTION: create classification query for combining strata
   classify.qry <- {}
-  for (to in 1:length(classcols)) {
-    tocol <- classcols[to]
-
+  for (col in 1:length(classcols)) {
+    tocol <- classcols[col]
+    fromcol <- fromcols[col]
+
     case.qry <- "\n(CASE"
     for (i in 1:(nrow(lut))) { 
 
       luti <- lut[i,]
+      tocolsi <- as.vector(t(luti[, tocols]))
       fromcolsi <- as.vector(t(luti[, fromcols]))
-      tocolsi <- as.vector(t(luti[, classcols]))
-
+
+      ## value to change
+      tocolval <- luti[[tocol]]
+      fromcolval <- luti[[fromcol]]
+
       ## Build when query
       when.qry <- paste0("\nWHEN (", tab., fromcols[1], " = '", fromcolsi[1], "'") 
       for (j in 2:length(fromcols)) {
         when.qry <- paste0(when.qry, " AND ", tab., fromcols[j], " = '", fromcolsi[j], "'")
       }
       when.qry <- paste0(when.qry, ")")
-      case.qry <- paste0(case.qry, when.qry, " THEN ", tocolsi)
+      case.qry <- paste0(case.qry, when.qry, " THEN ", tocolval)
 
     }
     case.qry <- paste0(case.qry, " END) AS \"", tocol, "\"")
     classify.qry <- paste0(classify.qry, case.qry)
-    if (to < length(classcols)) {
+    if (col < length(classcols)) {
       classify.qry <- paste0(classify.qry, ",")
     }
   }
 
-    return(classify.qry)
+  return(classify.qry)
 }
 

R/strat_collapse.R

@@ -2,7 +2,8 @@
 #' @export
 strat.collapse <- function(stratacnt, pltstratx, minplotnum.unit=10,
 	minplotnum.strat=2, unitarea, areavar, unitvar, unitvar2=NULL, strvar,
-	getwt=FALSE, stratcombine=TRUE, unitcombine=FALSE, vars2combine=NULL, ...) {
+	getwt=FALSE, stratcombine=TRUE, unitcombine=FALSE, stratalevels=NULL,
+	vars2combine=NULL, ...) {
   ## unitcombine - If TRUE, combine estimation units, If FALSE, only combine strata
 
   ## Set global variables
@@ -159,22 +160,18 @@ strat.collapse <- function(stratacnt, pltstratx, minplotnum.unit=10,
   #############################################################################
   ## If stratcombine=TRUE and number of total plots is less than minplotnum.strat
   #############################################################################
-  if ("n.strata" %in% names(unitgrpsum) &&
-		any(unique(unitgrpsum$n.strata) < minplotnum.strat)) {
-   #if ("n.strata" %in% names(unitgrpsum) &&
-	#	any(unique(unitgrpsum$n.strata) < 60)) {
-
+  if ("n.strata" %in% names(unitgrpsum) && any(unique(unitgrpsum$n.strata) < minplotnum.strat)) {
+
     tabprint <- TRUE
-
     unitgrpsum$strat <- unitgrpsum[[strvar]]
     if (!is.factor(unitgrpsum$strat)) {
       unitgrpsum$strat <- factor(unitgrpsum$strat)
     }
     unitgrpsum$strat <- as.numeric(unitgrpsum$strat)
     unitgrpsum$stratnew <- as.character(-1)
 
-    stratgrp <- unitgrpsum[, groupStrata(.SD, minplotnum.strat), by=unitvar]
-
+    stratgrp <- unitgrpsum[, groupStrata(.SD, minplotnum=minplotnum.strat, strvar=strvar, 
+                                         stratalevels=stratalevels), by=unitvar]
     strlut <- stratgrp[, lapply(.SD, sum, na.rm=TRUE),
 		      by=c(unitvar, "stratnew"), .SDcols=c(vars2combine, "n.strata")]
     strlut[, n.total := stratgrp[match(strlut[[unitvar]], stratgrp[[unitvar]]),